diff options
| author | Ryan Scott <rscott@galois.com> | 2021-06-22 11:50:33 -0400 |
|---|---|---|
| committer | Ryan Scott <rscott@galois.com> | 2021-06-22 11:50:35 -0400 |
| commit | 115f2928d7d2c4cc97568f2f3380aaedf24a0cf7 (patch) | |
| tree | cc68b5ca82167b05b1ed97be3dc0e63da96a0479 | |
| parent | 62d720db4f6a53014400a608baf5c56555258eee (diff) | |
| download | haskell-wip/T19992-forkOn.tar.gz | |
Fix type and strictness signature of forkOn#wip/T19992-forkOn
This is a follow-up to #19992, which fixes the type and strictness signature
for `fork#`. The `forkOn#` primop also needs analogous changes, which this
patch accomplishes.
| -rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 6 | ||||
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 2 |
2 files changed, 6 insertions, 2 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 672b831ac7..2512612b5b 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -2783,10 +2783,14 @@ primop ForkOp "fork#" GenPrimOp , topDmd ] topDiv } primop ForkOnOp "forkOn#" GenPrimOp - Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) + Int# -> (State# RealWorld -> (# State# RealWorld, a #)) + -> State# RealWorld -> (# State# RealWorld, ThreadId# #) with has_side_effects = True out_of_line = True + strictness = { \ _arity -> mkClosedDmdSig [ topDmd + , lazyApply1Dmd + , topDmd ] topDiv } primop KillThreadOp "killThread#" GenPrimOp ThreadId# -> a -> State# RealWorld -> State# RealWorld diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 3a9f2bb533..ecae88cfc5 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -313,7 +313,7 @@ is recommended). -} forkOn :: Int -> IO () -> IO ThreadId forkOn (I# cpu) action = IO $ \ s -> - case (forkOn# cpu action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #) + case (forkOn# cpu (unIO action_plus) s) of (# s1, tid #) -> (# s1, ThreadId tid #) where -- We must use 'catch' rather than 'catchException' because the action -- could be bottom. #13330 |