combine all cesk simplifications

src/Swarm/Game/CESK.hs

@@ -59,6 +59,8 @@ module Swarm.Game.CESK (
   RobotUpdate (..),
 
   -- * Store
+  SKPair (..),
+  Go (..),
   Store,
   Addr,
   emptyStore,
@@ -237,23 +239,16 @@ setCell n c (Store nxt m) = Store nxt (IM.insert n c m)
 -- CESK machine
 ------------------------------------------------------------
 
--- | The overall state of a CESK machine, which can actually be one of
---   three kinds of states. The CESK machine is named after the first
---   kind of state, and it would probably be possible to inline a
---   bunch of things and get rid of the second state, but I find it
---   much more natural and elegant this way.  Most tutorial
---   presentations of CEK/CESK machines only have one kind of state, but
---   then again, most tutorial presentations only deal with the bare
---   lambda calculus, so one can tell whether a term is a value just
---   by seeing whether it is syntactically a lambda.  I learned this
---   approach from Harper's Practical Foundations of Programming
---   Languages.
-data CESK
+-- | Represents the heap and the stack in a CESK machine
+data SKPair = SK Store Cont
+  deriving (Eq, Show, Generic, FromJSON, ToJSON)
+
+data Go
   = -- | When we are on our way "in/down" into a term, we have a
     --   currently focused term to evaluate in the environment, a store,
     --   and a continuation.  In this mode we generally pattern-match on the
     --   'Term' to decide what to do next.
-    In Term Env Store Cont
+    In Term Env
   | -- | Once we finish evaluating a term, we end up with a 'Value'
     --   and we switch into "out" mode, bringing the value back up
     --   out of the depths to the context that was expecting it.  In
@@ -264,12 +259,27 @@ data CESK
     --   with variables to evaluate at the moment, and we maintain the
     --   invariant that any unevaluated terms buried inside a 'Value'
     --   or 'Cont' must carry along their environment with them.
-    Out Value Store Cont
+    Out Value
   | -- | An exception has been raised.  Keep unwinding the
     --   continuation stack (until finding an enclosing 'Try' in the
     --   case of a command failure or a user-generated exception, or
     --   until the stack is empty in the case of a fatal exception).
-    Up Exn Store Cont
+    Up Exn
+  deriving (Eq, Show, Generic, FromJSON, ToJSON)
+
+-- | The overall state of a CESK machine, which can actually be one of
+--   four kinds of states. The CESK machine is named after the first
+--   kind of state, and it would probably be possible to inline a
+--   bunch of things and get rid of the second state, but I find it
+--   much more natural and elegant this way.  Most tutorial
+--   presentations of CEK/CESK machines only have one kind of state, but
+--   then again, most tutorial presentations only deal with the bare
+--   lambda calculus, so one can tell whether a term is a value just
+--   by seeing whether it is syntactically a lambda.  I learned this
+--   approach from Harper's Practical Foundations of Programming
+--   Languages.
+data CESK
+  = Go Go SKPair
   | -- | The machine is waiting for the game to reach a certain time
     --   to resume its execution.
     Waiting TickNumber CESK
@@ -279,7 +289,7 @@ data CESK
 --   the final value and store.
 finalValue :: CESK -> Maybe (Value, Store)
 {-# INLINE finalValue #-}
-finalValue (Out v s []) = Just (v, s)
+finalValue (Go (Out v) (SK s [])) = Just (v, s)
 finalValue _ = Nothing
 
 -- | Initialize a machine state with a starting term along with its
@@ -297,27 +307,26 @@ initMachine' (ProcessedTerm (Module t' ctx) _ reqCtx) e s k =
       case ctx of
         -- ...but doesn't contain any definitions, just create a machine
         -- that will evaluate it and then execute it.
-        Empty -> In t e s (FExec : k)
+        Empty -> Go inState (SK s (FExec : k))
         -- Or, if it does contain definitions, then load the resulting
         -- context after executing it.
-        _ -> In t e s (FExec : FLoadEnv ctx reqCtx : k)
+        _ -> Go inState (SK s (FExec : FLoadEnv ctx reqCtx : k))
     -- Otherwise, for a term with a non-command type, just
     -- create a machine to evaluate it.
-    _ -> In t e s k
+    _ -> Go inState (SK s k)
  where
   -- Erase all type and SrcLoc annotations from the term before
   -- putting it in the machine state, since those are irrelevant at
   -- runtime.
   t = eraseS t'
+  inState = In t e
 
 -- | Cancel the currently running computation.
 cancel :: CESK -> CESK
-cancel cesk = Out VUnit s' []
+cancel cesk = Go (Out VUnit) $ SK s' []
  where
   s' = resetBlackholes $ getStore cesk
-  getStore (In _ _ s _) = s
-  getStore (Out _ s _) = s
-  getStore (Up _ s _) = s
+  getStore (Go _ (SK s _)) = s
   getStore (Waiting _ c) = getStore c
 
 -- | Reset any 'Blackhole's in the 'Store'.  We need to use this any
@@ -334,9 +343,12 @@ resetBlackholes (Store n m) = Store n (IM.map resetBlackhole m)
 ------------------------------------------------------------
 
 instance PrettyPrec CESK where
-  prettyPrec _ (In c _ _ k) = prettyCont k (11, "▶" <> ppr c <> "◀")
-  prettyPrec _ (Out v _ k) = prettyCont k (11, "◀" <> ppr (valueToTerm v) <> "▶")
-  prettyPrec _ (Up e _ k) = prettyCont k (11, "!" <> (pretty (formatExn mempty e) <> "!"))
+  prettyPrec _ (Go goState (SK _ k)) = prettyCont k (11, doc)
+   where
+    doc = case goState of
+      In c _ -> "▶" <> ppr c <> "◀"
+      Out v -> "◀" <> ppr (valueToTerm v) <> "▶"
+      Up e -> "!" <> (pretty (formatExn mempty e) <> "!")
   prettyPrec _ (Waiting t cesk) = "🕑" <> pretty t <> "(" <> ppr cesk <> ")"
 
 -- | Take a continuation, and the pretty-printed expression which is

src/Swarm/Game/Robot.hs

@@ -509,7 +509,7 @@ instance FromJSONE EntityMap TRobot where
       <*> liftE (v .:? "heavy" .!= False)
       <*> pure 0
    where
-    mkMachine Nothing = Out VUnit emptyStore []
+    mkMachine Nothing = Go (Out VUnit) $ SK emptyStore []
     mkMachine (Just pt) = initMachine pt mempty emptyStore
 
 -- | Is the robot actively in the middle of a computation?