fix: bug???
This commit is contained in:
parent
fc10c858f8
commit
3b567f9cf6
@ -50,8 +50,8 @@ data RwLock a = RwLock
|
||||
makeReadGuard :: forall a. AVar ReaderId -> AVar (Set ReaderId) -> AVar a -> a -> Aff (ReadGuard a)
|
||||
makeReadGuard nextReaderIdCell readersCell stateCell state = do
|
||||
nextReaderId <- AVar.take nextReaderIdCell
|
||||
ids <- AVar.take readersCell
|
||||
AVar.put (nextReaderId + ReaderId 1) nextReaderIdCell
|
||||
ids <- AVar.take readersCell
|
||||
AVar.put (Set.insert nextReaderId ids) readersCell
|
||||
AVar.put state stateCell
|
||||
pure $ ReadGuard nextReaderId state
|
||||
@ -59,8 +59,8 @@ makeReadGuard nextReaderIdCell readersCell stateCell state = do
|
||||
mayWrite :: AVar (Array (Effect Unit)) -> Aff Unit
|
||||
mayWrite writerQCell = do
|
||||
writerQueue <- AVar.take writerQCell
|
||||
liftEffect $ for_ (Array.head writerQueue) identity
|
||||
AVar.put (fromMaybe [] $ Array.tail writerQueue) writerQCell
|
||||
liftEffect $ fromMaybe (pure unit) $ Array.head writerQueue
|
||||
|
||||
instance AsyncState RwLock WriteGuard ReadGuard where
|
||||
boxed a = liftAff do
|
||||
@ -74,13 +74,14 @@ instance AsyncStateWritable RwLock WriteGuard where
|
||||
write _ (WriteGuard stateCell) s = do
|
||||
void $ liftAff $ liftMaybe (error "WriteGuard used after `unlock` invoked!") =<< AVar.tryTake stateCell
|
||||
liftAff $ void $ whileJust $ void <$> AVar.tryTake stateCell
|
||||
liftAff $ AVar.put s stateCell
|
||||
wasPut <- liftAff $ AVar.tryPut s stateCell
|
||||
if not wasPut then
|
||||
liftAff $ throwError $ error "WriteGuard has multiple pending writes - why?"
|
||||
else
|
||||
pure unit
|
||||
|
||||
instance AsyncStateReadable RwLock WriteGuard where
|
||||
read _ (WriteGuard stateCell) =
|
||||
liftAff
|
||||
$ liftMaybe (error "WriteGuard used after `unlock` invoked!")
|
||||
=<< AVar.tryRead stateCell
|
||||
read _ (WriteGuard stateCell) = liftAff $ liftMaybe (error "WriteGuard used after `unlock` invoked!") =<< AVar.tryRead stateCell
|
||||
|
||||
instance AsyncStateReadable RwLock ReadGuard where
|
||||
read (RwLock { readers: readersCell }) (ReadGuard id a) = liftAff do
|
||||
@ -103,6 +104,7 @@ instance AsyncStateLock RwLock ReadGuard where
|
||||
instance AsyncStateLock RwLock WriteGuard where
|
||||
unlock (RwLock { writerQueue: writerQCell, state: rwLockStateCell }) (WriteGuard localStateCell) = liftAff do
|
||||
state <- AVar.take localStateCell
|
||||
void $ AVar.tryTake rwLockStateCell
|
||||
AVar.put state rwLockStateCell
|
||||
mayWrite writerQCell
|
||||
tryLock (RwLock { readers: readersCell, state: stateCell }) = liftAff do
|
||||
@ -133,4 +135,4 @@ instance AsyncStateLock RwLock WriteGuard where
|
||||
else do
|
||||
AVar.put readers readersCell
|
||||
blockOnWritable
|
||||
lock rw
|
||||
onWritable
|
||||
|
Loading…
Reference in New Issue
Block a user