Skip to content

[hls-graph] Optimise waitConcurrently #2805

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Mar 29, 2022
Merged

[hls-graph] Optimise waitConcurrently #2805

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
d58f281
work on the sync computations first
pepeiborra Mar 22, 2022
4c03661
Merge branch 'master' into hls-graph-sync-async
mergify[bot] Mar 29, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 9 additions & 5 deletions hls-graph/src/Development/IDE/Graph/Internal/Database.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -329,10 +329,14 @@ waitConcurrently_ [] = pure ()
waitConcurrently_ [one] = liftIO $ justWait one
waitConcurrently_ many = do
ref <- AIO ask
-- mask to make sure we keep track of all the asyncs
waits <- liftIO $ uninterruptibleMask $ \unmask -> do
-- spawn the async computations.
-- mask to make sure we keep track of all the asyncs.
(asyncs, syncs) <- liftIO $ uninterruptibleMask $ \unmask -> do
waits <- liftIO $ traverse (waitOrSpawn . fmapWait unmask) many
let asyncs = rights waits
let (syncs, asyncs) = partitionEithers waits
liftIO $ atomicModifyIORef'_ ref (asyncs ++)
return waits
liftIO $ traverse_ (either id wait) waits
return (asyncs, syncs)
-- work on the sync computations
liftIO $ sequence_ syncs
-- wait for the async computations before returning
liftIO $ traverse_ wait asyncs