<div dir="ltr"><div dir="ltr">On Sun, 2 Feb 2020 at 04:26, Alexis King <<a href="mailto:lexi.lambda@gmail.com">lexi.lambda@gmail.com</a>> wrote:<br></div><div class="gmail_quote"><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">I took a stab at implementing this today, using the “continuation is a<br>
stack” implementation strategy I described in my previous email. I<br>
haven’t tried very hard to break it yet, but this tiny test program<br>
works:<br>
<br>
    {-# LANGUAGE BangPatterns, BlockArguments, MagicHash,<br>
                 ScopedTypeVariables, UnboxedTuples #-}<br>
<br>
    import GHC.Prim<br>
    import GHC.Types<br>
<br>
    data Continuation a b = Continuation# (Continuation# RealWorld a b)<br>
<br>
    reset :: IO a -> IO a<br>
    reset (IO m) = IO (reset# m)<br>
<br>
    shift :: (Continuation a b -> IO b) -> IO a<br>
    shift f = IO (shift# \k -> let !(IO m) = f (Continuation# k) in m)<br>
<br>
    applyContinuation :: Continuation a b -> a -> IO b<br>
    applyContinuation (Continuation# k) a = IO (applyContinuation# k a)<br>
<br>
    main :: IO ()<br>
    main = do<br>
      ns <- reset do<br>
        n <- shift \(k :: Continuation Integer [Integer]) -> do<br>
          a <- applyContinuation k 2<br>
          b <- applyContinuation k 3<br>
          pure (a ++ b)<br>
        pure [n]<br>
      print ns<br>
<br>
The output of this program is [2, 3], as expected.<br></blockquote><div><br></div><div>That's impressive!<br></div><div> </div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
<br>
My implementation doesn’t share any code with raiseAsync. Currently, it<br>
isn’t very clever:<br>
<br>
    * reset# pushes a RET_SMALL frame with a well-known info pointer,<br>
      &stg_reset_frame_info.<br>
<br>
    * shift# walks the stack and copies it up to the nearest reset<br>
      frame. If the stack consists of several chunks, it only copies the<br>
      chunk that contains the reset frame, and it just repurposes the<br>
      other chunks as the continuation (since the stack is unwinding<br>
      anyway).<br>
<br>
    * applyContinuation# copies the captured stack and updates the<br>
      UNDERFLOW frames as needed to point to the current stack.<br>
<br>
    * I haven’t implemented it yet, but it would be straightforward to<br>
      implement an applyContinuationOneShot# operation that works like<br>
      applyContinuation#, but doesn’t actually copy anything and just<br>
      updates the UNDERFLOW frames in the captured stack itself.<br>
<br>
This seems to work in my very simple examples, but there are also things<br>
I know it doesn’t handle properly:<br>
<br>
    * It doesn’t make any attempt to handle modifications to the<br>
      interrupt masking state properly. The right thing to do here is<br>
      probably to look for mask/unmask frames on the stack during<br>
      unwinding and to stash that information somewhere.<br>
<br>
    * It doesn’t do anything special for UPDATE_FRAMEs, so if there’s an<br>
      UPDATE_FRAME that owns a blackhole on the stack, things will go<br>
      quite wrong.<br>
<br>
      I haven’t been worrying about this because I don’t think there<br>
      should ever be any update frames between shift# and reset#. In the<br>
      case of raiseAsync, the location of the “prompt” is well-defined:<br>
      it’s the update frame. But shift# captures up to an explicit<br>
      prompt, so using shift# when there’s an update frame on the stack<br>
      can surely only lead to nonsense... right?<br>
<br>
    * It doesn’t do anything special for STM frames, so trying to<br>
      capture a continuation through those will be similarly broken.<br></blockquote><div><br></div><div>Yes, these are all the things that make raiseAsync tricky! You can either copy what raiseAsync does (but be warned, it has taken a lot of iteration to get right) or try to use raiseAsync and/or modify it to do what you want.</div><div><br></div><div>Cheers</div><div>Simon<br></div><div><br></div><div> <br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
<br>
There are also probably bugs I don’t know about — I haven’t exercised<br>
the implementation very hard yet — but I’ll keep playing with it. If<br>
anyone is at all interested, I’ve pushed the code to a branch here:<br>
<br>
    <a href="https://gitlab.haskell.org/lexi.lambda/ghc/compare/master...first-class-continuations" rel="noreferrer" target="_blank">https://gitlab.haskell.org/lexi.lambda/ghc/compare/master...first-class-continuations</a><br>
<br>
My thanks again to everyone’s help!<br>
<br>
Alexis</blockquote></div></div>