Skip to content

Commit

Permalink
fix bug #33
Browse files Browse the repository at this point in the history
  • Loading branch information
mitchellwrosen committed Jul 15, 2024
1 parent ea61f66 commit 1044179
Show file tree
Hide file tree
Showing 2 changed files with 15 additions and 26 deletions.
6 changes: 1 addition & 5 deletions ki/src/Ki/Internal/Propagating.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
module Ki.Internal.Propagating
( pattern PropagatingFrom,
Tid,
( Tid,
peelOffPropagating,
propagate,
)
Expand All @@ -22,9 +21,6 @@ instance Exception Propagating where
instance Show Propagating where
show _ = "<<internal ki exception: propagating>>"

pattern PropagatingFrom :: Tid -> SomeException
pattern PropagatingFrom childId <- (fromException -> Just Propagating {childId})

pattern PropagatingThe :: SomeException -> SomeException
pattern PropagatingThe exception <- (fromException -> Just Propagating {exception})

Expand Down
35 changes: 14 additions & 21 deletions ki/src/Ki/Internal/Scope.hs
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,7 @@ import Ki.Internal.IO
uninterruptiblyMasked,
)
import Ki.Internal.NonblockingSTM
import Ki.Internal.Propagating (Tid, peelOffPropagating, propagate, pattern PropagatingFrom)
import Ki.Internal.Propagating (Tid, peelOffPropagating, propagate)
import Ki.Internal.Thread (Thread, makeThread)
import Ki.Internal.ThreadAffinity (forkWithAffinity)
import Ki.Internal.ThreadOptions (ThreadOptions (..), defaultThreadOptions)
Expand Down Expand Up @@ -151,26 +151,19 @@ scoped action = do
result <- try (restore (action scope))

!runningChildren <- do
runningChildren <-
atomically do
-- Block until we haven't committed to starting any threads. Without this, we may create a thread concurrently
-- with closing its scope, and not grab its thread id to throw an exception to.
starting <- readTVar statusVar
assertM (starting >= 0)
guard (starting == 0)
-- Indicate that this scope is closing, so attempts to create a new thread within it will throw ScopeClosing
-- (as if the calling thread was a parent of this scope, which it should be, and we threw it a ScopeClosing
-- ourselves).
writeTVar statusVar Closing
-- Return the list of currently-running children to kill. Some of them may have *just* started (e.g. if we
-- initially retried in `guard (n == 0)` above). That's fine - kill them all!
readTVar childrenVar

-- If one of our children propagated an exception to us, then we know it's about to terminate, so we don't bother
-- throwing an exception to it.
pure case result of
Left (PropagatingFrom childId) -> IntMap.Lazy.delete childId runningChildren
_ -> runningChildren
atomically do
-- Block until we haven't committed to starting any threads. Without this, we may create a thread concurrently
-- with closing its scope, and not grab its thread id to throw an exception to.
starting <- readTVar statusVar
assertM (starting >= 0)
guard (starting == 0)
-- Indicate that this scope is closing, so attempts to create a new thread within it will throw ScopeClosing
-- (as if the calling thread was a parent of this scope, which it should be, and we threw it a ScopeClosing
-- ourselves).
writeTVar statusVar Closing
-- Return the list of currently-running children to kill. Some of them may have *just* started (e.g. if we
-- initially retried in `guard (n == 0)` above). That's fine - kill them all!
readTVar childrenVar

-- Deliver a ScopeClosing exception to every running child.
--
Expand Down

0 comments on commit 1044179

Please sign in to comment.