diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-06-15 21:08:52 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-06-19 12:26:01 -0400 |
| commit | fc8ad5f35a8ec314c801b226a9165b5354363a72 (patch) | |
| tree | 5585c79dabfde83d87e47a2887d3ff24e6405253 | |
| parent | 1c79ddc8c566a23cf1a77a6a68c65e508fe8ee4d (diff) | |
| download | haskell-fc8ad5f35a8ec314c801b226a9165b5354363a72.tar.gz | |
Fix type and strictness signature of fork#
When working eta-expansion and reduction, I found that fork# had a
weaker strictness signature than it should have (#19992). In
particular, it didn't record that it applies its argument exactly
once. To this I needed to give it a proper type (its first argument is
always a function, which in turn entailed a small change to the call
in GHC.Conc.Sync
This patch fixes it.
| -rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 5 | ||||
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 2 |
2 files changed, 5 insertions, 2 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 77869cab20..672b831ac7 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -2774,10 +2774,13 @@ primtype ThreadId# other operations can be omitted.)} primop ForkOp "fork#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) + (State# RealWorld -> (# State# RealWorld, a #)) + -> State# RealWorld -> (# State# RealWorld, ThreadId# #) with has_side_effects = True out_of_line = True + strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd + , topDmd ] topDiv } primop ForkOnOp "forkOn#" GenPrimOp Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index e27b40dbbd..3a9f2bb533 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -263,7 +263,7 @@ exception handler. -} forkIO :: IO () -> IO ThreadId forkIO action = IO $ \ s -> - case (fork# action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #) + case (fork# (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 |