properly handle suspend with more continuation remaining

src/swarm-engine/Swarm/Game/CESK.hs

@@ -298,7 +298,7 @@ instance FromJSON CESK where
 finalValue :: CESK -> Maybe Value
 {-# INLINE finalValue #-}
 finalValue (Out v _ []) = Just v
-finalValue (Suspended v _ _ _) = Just v
+finalValue (Suspended v _ _ []) = Just v
 finalValue _ = Nothing
 
 -- | Extract the environment from a suspended CESK machine (/e.g./ to

src/swarm-engine/Swarm/Game/Step.hs

@@ -757,6 +757,22 @@ stepCESK cesk = case cesk of
   -- never happen).
   Out _ s (FExec : _) -> badMachineState s "FExec frame with non-executable value"
   ------------------------------------------------------------
+  -- Suspension
+  ------------------------------------------------------------
+
+  -- If we're suspended and see the env restore frame, we can discard
+  -- it: it was only there in case an exception was thrown.
+  Suspended v e s (FRestoreEnv _ : k) -> return $ Suspended v e s k
+  -- If we're suspended but we were on the LHS of a bind, switch to
+  -- evaluating that, except with the environment from the suspension
+  -- instead of the environment stored in the FBind frame, as if the
+  -- RHS of the bind had been grafted in right where the suspend was.
+  Suspended _ e s (FBind _ _ t2 _ : k) -> return $ In t2 e s (FExec : k)
+  -- Otherwise, if we're suspended with nothing else left to do,
+  -- return the machine unchanged (but throw away the rest of the
+  -- continuation).
+  Suspended v e s _ -> return $ Suspended v e s []
+  ------------------------------------------------------------
   -- Exception handling
   ------------------------------------------------------------
 
@@ -780,9 +796,8 @@ stepCESK cesk = case cesk of
   -- Otherwise, keep popping from the continuation stack.
   Up exn s (_ : k) -> return $ Up exn s k
   -- Finally, if we're done evaluating and the continuation stack is
-  -- empty, OR if we've hit a suspend, return the machine unchanged.
+  -- empty, return the machine unchanged.
   done@(Out _ _ []) -> return done
-  suspended@(Suspended {}) -> return suspended
  where
   badMachineState s msg =
     let msg' =

src/swarm-engine/Swarm/Game/Step/Const.hs

@@ -1226,13 +1226,10 @@ execConst runChildProg c vs s k = do
 
         case mt of
           Nothing -> return $ mkReturn ()
-          Just pt -> do
+          Just t -> do
             void $ traceLog CmdStatus Info "run: OK."
-            case k of
-              [] -> return $ In (insertSuspend (prepareTerm mempty pt)) mempty s [FExec]
-              _ -> return $ In (prepareTerm mempty pt) mempty s (FExec : k)
-      -- mempty above means we will wipe out all our current definitions every time
-      -- we execute 'run'...
+            cesk <- use machine
+            return $ continue t cesk
       _ -> badConst
     Not -> case vs of
       [VBool b] -> return $ Out (VBool (not b)) s k