diff options
Diffstat (limited to 'compiler/prelude/primops.txt.pp')
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 68 |
1 files changed, 55 insertions, 13 deletions
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 162063e447..9b107f2053 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1919,16 +1919,43 @@ primop CasMutVarOp "casMutVar#" GenPrimOp section "Exceptions" ------------------------------------------------------------------------ +{- Note [Strictness for mask/unmask/catch] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this example, which comes from GHC.IO.Handle.Internals: + wantReadableHandle3 f ma b st + = case ... of + DEFAULT -> case ma of MVar a -> ... + 0# -> maskAsynchExceptions# (\st -> case ma of MVar a -> ...) +The outer case just decides whether to mask exceptions, but we don't want +thereby to hide the strictness in 'ma'! Hence the use of strictApply1Dmd. + +For catch, we know that the first branch will be evaluated, but not +necessarily the second. Hence strictApply1Dmd and lazyApply1Dmd + +Howver, consider + catch# (\st -> case x of ...) (..handler..) st +We'll see that the entire thing is strict in 'x', so 'x' may be evaluated +before the catch#. So fi evaluting 'x' causes a divide-by-zero exception, +it won't be caught. This seems acceptable: + - x might be evaluated somewhere else outside the catch# anyway + - It's an imprecise eception anyway. Synchronous exceptions (in the + IO monad) will never move in this way. +There was originally a comment + "Catch is actually strict in its first argument + but we don't want to tell the strictness + analyser about that, so that exceptions stay inside it." +but tracing it back through the commit logs did not give any +rationale. And making catch# lazy has performance costs for everyone. +-} + primop CatchOp "catch#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a #) ) -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) -> State# RealWorld -> (# State# RealWorld, a #) with - -- Catch is actually strict in its first argument - -- but we don't want to tell the strictness - -- analyser about that, so that exceptions stay inside it. - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,lazyApply2Dmd,topDmd] topRes } + -- See Note [Strictness for mask/unmask/catch] out_of_line = True has_side_effects = True @@ -1965,7 +1992,8 @@ primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes } + -- See Note [Strictness for mask/unmask/catch] out_of_line = True has_side_effects = True @@ -1973,7 +2001,7 @@ primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes } out_of_line = True has_side_effects = True @@ -1981,7 +2009,8 @@ primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes } + -- See Note [Strictness for mask/unmask/catch] out_of_line = True has_side_effects = True @@ -2001,7 +2030,8 @@ primop AtomicallyOp "atomically#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a #) ) -> State# RealWorld -> (# State# RealWorld, a #) with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes } + -- See Note [Strictness for mask/unmask/catch] out_of_line = True has_side_effects = True @@ -2027,7 +2057,8 @@ primop CatchRetryOp "catchRetry#" GenPrimOp -> (State# RealWorld -> (# State# RealWorld, a #) ) -> (State# RealWorld -> (# State# RealWorld, a #) ) with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply1Dmd,topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,lazyApply1Dmd,topDmd] topRes } + -- See Note [Strictness for mask/unmask/catch] out_of_line = True has_side_effects = True @@ -2036,7 +2067,8 @@ primop CatchSTMOp "catchSTM#" GenPrimOp -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) -> (State# RealWorld -> (# State# RealWorld, a #) ) with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,lazyApply2Dmd,topDmd] topRes } + -- See Note [Strictness for mask/unmask/catch] out_of_line = True has_side_effects = True @@ -2439,25 +2471,35 @@ primop TagToEnumOp "tagToEnum#" GenPrimOp ------------------------------------------------------------------------ section "Bytecode operations" - {Support for the bytecode interpreter and linker.} + {Support for manipulating bytecode objects used by the interpreter and + linker. + + Bytecode objects are heap objects which represent top-level bindings and + contain a list of instructions and data needed by these instructions.} ------------------------------------------------------------------------ primtype BCO# - {Primitive bytecode type.} + { Primitive bytecode type. } primop AddrToAnyOp "addrToAny#" GenPrimOp Addr# -> (# a #) - {Convert an {\tt Addr\#} to a followable Any type.} + { Convert an {\tt Addr\#} to a followable Any type. } with code_size = 0 primop MkApUpd0_Op "mkApUpd0#" GenPrimOp BCO# -> (# a #) + { Wrap a BCO in a {\tt AP_UPD} thunk which will be updated with the value of + the BCO when evaluated. } with out_of_line = True primop NewBCOOp "newBCO#" GenPrimOp ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO# #) + { {\tt newBCO\# instrs lits ptrs arity bitmap} creates a new bytecode object. The + resulting object encodes a function of the given arity with the instructions + encoded in {\tt instrs}, and a static reference table usage bitmap given by + {\tt bitmap}. } with has_side_effects = True out_of_line = True |