diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Builtin/Names.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/Types/Prim.hs | 19 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 186 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/Parser.y | 9 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 3 |
5 files changed, 214 insertions, 7 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index f97103a90f..e714036cd4 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -1849,7 +1849,8 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey, typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey, funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey, eqReprPrimTyConKey, eqPhantPrimTyConKey, - compactPrimTyConKey, stackSnapshotPrimTyConKey :: Unique + compactPrimTyConKey, stackSnapshotPrimTyConKey, + promptTagPrimTyConKey :: Unique statePrimTyConKey = mkPreludeTyConUnique 50 stableNamePrimTyConKey = mkPreludeTyConUnique 51 stableNameTyConKey = mkPreludeTyConUnique 52 @@ -1878,6 +1879,7 @@ funPtrTyConKey = mkPreludeTyConUnique 78 tVarPrimTyConKey = mkPreludeTyConUnique 79 compactPrimTyConKey = mkPreludeTyConUnique 80 stackSnapshotPrimTyConKey = mkPreludeTyConUnique 81 +promptTagPrimTyConKey = mkPreludeTyConUnique 82 eitherTyConKey :: Unique eitherTyConKey = mkPreludeTyConUnique 84 diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs index 2eec67613d..83d36af673 100644 --- a/compiler/GHC/Builtin/Types/Prim.hs +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -80,6 +80,7 @@ module GHC.Builtin.Types.Prim( weakPrimTyCon, mkWeakPrimTy, threadIdPrimTyCon, threadIdPrimTy, stackSnapshotPrimTyCon, stackSnapshotPrimTy, + promptTagPrimTyCon, mkPromptTagPrimTy, int8PrimTyCon, int8PrimTy, int8PrimTyConName, word8PrimTyCon, word8PrimTy, word8PrimTyConName, @@ -198,6 +199,7 @@ exposedPrimTyCons , word32PrimTyCon , word64PrimTyCon , stackSnapshotPrimTyCon + , promptTagPrimTyCon , tYPETyCon , funTyCon @@ -231,7 +233,7 @@ charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int3 stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, - stackSnapshotPrimTyConName :: Name + stackSnapshotPrimTyConName, promptTagPrimTyConName :: Name charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon intPrimTyConName = mkPrimTc (fsLit "Int#") intPrimTyConKey intPrimTyCon int8PrimTyConName = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon @@ -269,6 +271,7 @@ stackSnapshotPrimTyConName = mkPrimTc (fsLit "StackSnapshot#") stackSnapshotP bcoPrimTyConName = mkPrimTc (fsLit "BCO") bcoPrimTyConKey bcoPrimTyCon weakPrimTyConName = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon threadIdPrimTyConName = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon +promptTagPrimTyConName = mkPrimTc (fsLit "PromptTag#") promptTagPrimTyConKey promptTagPrimTyCon {- ************************************************************************ @@ -1171,6 +1174,20 @@ threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName unliftedRepTy {- ************************************************************************ * * + The ``prompt tag'' type +* * +************************************************************************ +-} + +promptTagPrimTyCon :: TyCon +promptTagPrimTyCon = pcPrimTyCon promptTagPrimTyConName [Representational] unliftedRepTy + +mkPromptTagPrimTy :: Type -> Type +mkPromptTagPrimTy v = TyConApp promptTagPrimTyCon [v] + +{- +************************************************************************ +* * \subsection{SIMD vector types} * * ************************************************************************ diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index d46e5401fb..acd84c0926 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -2633,6 +2633,192 @@ primop MaskStatus "getMaskingState#" GenPrimOp has_side_effects = True ------------------------------------------------------------------------ +section "Continuations" + { These operations provide access to first-class delimited continuations, + which allow a computation to access and manipulate portions of its + /current continuation/. Operationally, they are implemented by direct + manipulation of the RTS call stack, which may provide significant + performance gains relative to manual continuation-passing style (CPS) for + some programs. + + Intuitively, the delimited control operators 'prompt#' and + 'control0#' can be understood by analogy to 'catch#' and 'raiseIO#', + respectively: + + * Like 'catch#', 'prompt#' does not do anything on its own, it + just /delimits/ a subcomputation (the source of the name "delimited + continuations"). + + * Like 'raiseIO#', 'control0#' aborts to the nearest enclosing + 'prompt#' before resuming execution. + + However, /unlike/ 'raiseIO#', 'control0#' does /not/ discard + the aborted computation: instead, it /captures/ it in a form that allows + it to be resumed later. In other words, 'control0#' does not + irreversibly abort the local computation before returning to the enclosing + 'prompt#', it merely suspends it. All local context of the suspended + computation is packaged up and returned as an ordinary function that can be + invoked at a later point in time to /continue/ execution, which is why + the suspended computation is known as a /first-class continuation/. + + In GHC, every continuation prompt is associated with exactly one + 'PromptTag#'. Prompt tags are unique, opaque values created by + 'newPromptTag#' that may only be compared for equality. Both 'prompt#' + and 'control0#' accept a 'PromptTag#' argument, and 'control0#' + captures the continuation up to the nearest enclosing use of 'prompt#' + /with the same tag/. This allows a program to control exactly which + prompt it will abort to by using different tags, similar to how a program + can control which 'catch' it will abort to by throwing different types + of exceptions. Additionally, 'PromptTag#' accepts a single type parameter, + which is used to relate the expected result type at the point of the + 'prompt#' to the type of the continuation produced by 'control0#'. + + == The gory details + + The high-level explanation provided above should hopefully provide some + intuition for what these operations do, but it is not very precise; this + section provides a more thorough explanation. + + The 'prompt#' operation morally has the following type: + +@ +'prompt#' :: 'PromptTag#' a -> IO a -> IO a +@ + + If a computation @/m/@ never calls 'control0#', then + @'prompt#' /tag/ /m/@ is equivalent to just @/m/@, i.e. the 'prompt#' is + a no-op. This implies the following law: + + \[ + \mathtt{prompt\#}\ \mathit{tag}\ (\mathtt{pure}\ x) \equiv \mathtt{pure}\ x + \] + + The 'control0#' operation morally has the following type: + +@ +'control0#' :: 'PromptTag#' a -> ((IO b -> IO a) -> IO a) -> IO b +@ + + @'control0#' /tag/ /f/@ captures the current continuation up to the nearest + enclosing @'prompt#' /tag/@ and resumes execution from the point of the call + to 'prompt#', passing the captured continuation to @/f/@. To make that + somewhat more precise, we can say 'control0#' obeys the following law: + + \[ + \mathtt{prompt\#}\ \mathit{tag}\ (\mathtt{control0\#}\ tag\ f \mathbin{\mathtt{>>=}} k) + \equiv f\ (\lambda\ m \rightarrow m \mathbin{\mathtt{>>=}} k) + \] + + However, this law does not fully describe the behavior of 'control0#', + as it does not account for situations where 'control0#' does not appear + immediately inside 'prompt#'. Capturing the semantics more precisely + requires some additional notational machinery; a common approach is to + use [reduction semantics](https://en.wikipedia.org/wiki/Operational_semantics#Reduction_semantics). + Assuming an appropriate definition of evaluation contexts \(E\), the + semantics of 'prompt#' and 'control0#' can be given as follows: + + \[ + \begin{aligned} + E[\mathtt{prompt\#}\ \mathit{tag}\ (\mathtt{pure}\ v)] + &\longrightarrow E[\mathtt{pure}\ v] \\[8pt] + E_1[\mathtt{prompt\#}\ \mathit{tag}\ E_2[\mathtt{control0\#}\ tag\ f]] + &\longrightarrow E_1[f\ (\lambda\ m \rightarrow E_2[m])] \\[-2pt] + \mathrm{where}\;\: \mathtt{prompt\#}\ \mathit{tag} &\not\in E_2 + \end{aligned} + \] + + A full treatment of the semantics and metatheory of delimited control is + well outside the scope of this documentation, but a good, thorough + overview (in Haskell) is provided in [A Monadic Framework for Delimited + Continuations](https://legacy.cs.indiana.edu/~dyb/pubs/monadicDC.pdf) by + Dybvig et al. + + == Safety and invariants + + Correct uses of 'control0#' must obey the following restrictions: + + 1. The behavior of 'control0#' is only well-defined within a /strict + 'State#' thread/, such as those associated with @IO@ and strict @ST@ + computations. + + 2. Furthermore, 'control0#' may only be called within the dynamic extent + of a 'prompt#' with a matching tag somewhere in the /current/ strict + 'State#' thread. Effectively, this means that a matching prompt must + exist somewhere, and the captured continuation must /not/ contain any + uses of @unsafePerformIO@, @runST@, @unsafeInterleaveIO@, etc. For + example, the following program is ill-defined: + + @ + 'prompt#' /tag/ $ + evaluate (unsafePerformIO $ 'control0#' /tag/ /f/) + @ + + In this example, the use of 'prompt#' appears in a different 'State#' + thread from the use of 'control0#', so there is no valid prompt in + scope to capture up to. + + 3. Finally, 'control0#' may not be used within 'State#' threads associated + with an STM transaction (i.e. those introduced by 'atomically#'). + + If the runtime is able to detect that any of these invariants have been + violated in a way that would compromise internal invariants of the runtime, + 'control0#' will fail by raising an exception. However, such violations + are only detected on a best-effort basis, as the bookkeeping necessary for + detecting /all/ illegal uses of 'control0#' would have significant overhead. + Therefore, although the operations are “safe” from the runtime’s point of + view (e.g. they will not compromise memory safety or clobber internal runtime + state), it is still ultimately the programmer’s responsibility to ensure + these invariants hold to guarantee predictable program behavior. + + In a similar vein, since each captured continuation includes the full local + context of the suspended computation, it can safely be resumed arbitrarily + many times without violating any invariants of the runtime system. However, + use of these operations in an arbitrary 'IO' computation may be unsafe for + other reasons, as most 'IO' code is not written with reentrancy in mind. For + example, a computation suspended in the middle of reading a file will likely + finish reading it when it is resumed; further attempts to resume from the + same place would then fail because the file handle was already closed. + + In other words, although the RTS ensures that a computation’s control state + and local variables are properly restored for each distinct resumption of + a continuation, it makes no attempt to duplicate any local state the + computation may have been using (and could not possibly do so in general). + Furthermore, it provides no mechanism for an arbitrary computation to + protect itself against unwanted reentrancy (i.e. there is no analogue to + Scheme’s @dynamic-wind@). For those reasons, manipulating the continuation + is only safe if the caller can be certain that doing so will not violate any + expectations or invariants of the enclosing computation. } +------------------------------------------------------------------------ + +primtype PromptTag# a + +primop NewPromptTagOp "newPromptTag#" GenPrimOp + State# RealWorld -> (# State# RealWorld, PromptTag# a #) + with + out_of_line = True + has_side_effects = True + +primop PromptOp "prompt#" GenPrimOp + PromptTag# a + -> (State# RealWorld -> (# State# RealWorld, a #)) + -> State# RealWorld -> (# State# RealWorld, a #) + with + strictness = { \ _arity -> mkClosedDmdSig [topDmd, strictOnceApply1Dmd, topDmd] topDiv } + out_of_line = True + has_side_effects = True + +primop Control0Op "control0#" GenPrimOp + PromptTag# a + -> (((State# RealWorld -> (# State# RealWorld, p #)) + -> State# RealWorld -> (# State# RealWorld, a #)) + -> State# RealWorld -> (# State# RealWorld, a #)) + -> State# RealWorld -> (# State# RealWorld, p #) + with + strictness = { \ _arity -> mkClosedDmdSig [topDmd, lazyApply2Dmd, topDmd] topDiv } + out_of_line = True + has_side_effects = True + +------------------------------------------------------------------------ section "STM-accessible Mutable Variables" ------------------------------------------------------------------------ diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y index 67ce361a02..ed47fa7a7f 100644 --- a/compiler/GHC/Cmm/Parser.y +++ b/compiler/GHC/Cmm/Parser.y @@ -492,15 +492,14 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) } , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing }, []) } - | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')' - -- ptrs, nptrs, closure type, description, type, fun type + | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ',' INT ')' + -- ptrs, nptrs, closure type, description, type, arity, fun type {% do home_unit_id <- getHomeUnitId liftP $ pure $ do profile <- getProfile let prof = profilingInfo profile $11 $13 - ty = Fun 0 (ArgSpec (fromIntegral $15)) - -- Arity zero, arg_type $15 + ty = Fun (fromIntegral $15) (ArgSpec (fromIntegral $17)) rep = mkRTSRep (fromIntegral $9) $ mkHeapRep profile False (fromIntegral $5) (fromIntegral $7) ty @@ -510,7 +509,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) } , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing }, []) } -- we leave most of the fields zero here. This is only used - -- to generate the BCO info table in the RTS at the moment. + -- to generate the BCO and CONTINUATION info tables in the RTS at the moment. | 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')' -- ptrs, nptrs, tag, closure type, description, type diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index 1d482b0143..eb26b4a503 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -1568,6 +1568,9 @@ emitPrimOp cfg primop = MaskUninterruptibleOp -> alwaysExternal UnmaskAsyncExceptionsOp -> alwaysExternal MaskStatus -> alwaysExternal + NewPromptTagOp -> alwaysExternal + PromptOp -> alwaysExternal + Control0Op -> alwaysExternal AtomicallyOp -> alwaysExternal RetryOp -> alwaysExternal CatchRetryOp -> alwaysExternal |