From 8b58c4b952183ae2422a3fee6f65e94e5c78bcb5 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Tue, 3 Sep 2024 22:52:54 -0700
Subject: [PATCH 1/2] trace functions

---
 .../2133-robot-function-tracing/00-ORDER.txt  |  1 +
 .../2133-show-functions.yaml                  | 50 +++++++++++++++++++
 .../_2133-show-functions/rat.sw               | 23 +++++++++
 src/swarm-engine/Swarm/Game/Step.hs           | 29 ++++++++++-
 src/swarm-scenario/Swarm/Game/Robot.hs        | 20 +++++++-
 src/swarm-tui/Swarm/TUI/View.hs               |  6 +++
 src/swarm-util/Swarm/Util/RingBuffer.hs       |  7 +++
 7 files changed, 134 insertions(+), 2 deletions(-)
 create mode 100644 data/scenarios/Testing/2133-robot-function-tracing/00-ORDER.txt
 create mode 100644 data/scenarios/Testing/2133-robot-function-tracing/2133-show-functions.yaml
 create mode 100644 data/scenarios/Testing/2133-robot-function-tracing/_2133-show-functions/rat.sw

diff --git a/data/scenarios/Testing/2133-robot-function-tracing/00-ORDER.txt b/data/scenarios/Testing/2133-robot-function-tracing/00-ORDER.txt
new file mode 100644
index 000000000..a714f3b50
--- /dev/null
+++ b/data/scenarios/Testing/2133-robot-function-tracing/00-ORDER.txt
@@ -0,0 +1 @@
+2133-show-functions.yaml
\ No newline at end of file
diff --git a/data/scenarios/Testing/2133-robot-function-tracing/2133-show-functions.yaml b/data/scenarios/Testing/2133-robot-function-tracing/2133-show-functions.yaml
new file mode 100644
index 000000000..67dfe7974
--- /dev/null
+++ b/data/scenarios/Testing/2133-robot-function-tracing/2133-show-functions.yaml
@@ -0,0 +1,50 @@
+version: 1
+name: Show functions
+description: |
+  Show functions
+creative: false
+objectives:
+  - teaser: Follow buddy
+    goal:
+      - You and your buddy each have half of a map to a cache of buried treasure.
+      - |
+        `give` him your `map piece`{=entity}, which he will use to
+        locate the `bitcoin`{=entity}, which you must `grab`.
+    condition: |
+      as base {
+        has "bitcoin";
+      }
+robots:
+  - name: base
+    dir: east
+    devices:
+      - ADT calculator
+      - antenna
+      - branch predictor
+      - comparator
+      - compass
+      - dictionary
+      - grabber
+      - hourglass
+      - logger
+      - treads
+  - name: rat
+    dir: west
+    system: true
+    display:
+      invisible: false
+    devices:
+      - logger
+    program: |
+      run "data/scenarios/Testing/2133-robot-function-tracing/_2133-show-functions/rat.sw"
+known: [bitcoin]
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [blank, null, base]
+    'r': [blank, null, rat]
+    '.': [blank]
+  upperleft: [-1, 0]
+  map: |
+    B.r
diff --git a/data/scenarios/Testing/2133-robot-function-tracing/_2133-show-functions/rat.sw b/data/scenarios/Testing/2133-robot-function-tracing/_2133-show-functions/rat.sw
new file mode 100644
index 000000000..20f286cf5
--- /dev/null
+++ b/data/scenarios/Testing/2133-robot-function-tracing/_2133-show-functions/rat.sw
@@ -0,0 +1,23 @@
+def doWalk =
+    move;
+    move;
+    move;
+    end;
+
+def doTurn =
+    turn left;
+    end;
+
+def runSomeFunction = \f.
+    f;
+    end;
+
+def go =
+    doWalk;
+    wait 2;
+    runSomeFunction doTurn;
+    wait 2;
+    go;
+    end;
+
+go;
diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs
index aadb22d9c..e7546c631 100644
--- a/src/swarm-engine/Swarm/Game/Step.hs
+++ b/src/swarm-engine/Swarm/Game/Step.hs
@@ -30,12 +30,14 @@ import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view
 import Control.Monad (foldM, forM_, unless, when)
 import Data.Functor (void)
 import Data.IntMap qualified as IM
+import Swarm.Util.RingBuffer qualified as RB
 import Data.IntSet qualified as IS
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
 import Data.Sequence ((><))
 import Data.Sequence qualified as Seq
 import Data.Set (Set)
+import Data.Foldable (toList)
 import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -533,7 +535,32 @@ processImmediateFrame v (SKpair s k) unreliableComputation = do
 -- | The main CESK machine workhorse.  Given a robot, look at its CESK
 --   machine state and figure out a single next step.
 stepCESK :: (Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m, Has Effect.Time sig m) => CESK -> m CESK
-stepCESK cesk = case cesk of
+stepCESK cesk = do
+
+
+ case cesk of
+  In t _ _ _ -> evalBuffer @ConcreteRobot %= RB.insert (showT t)
+  _ -> return ()
+
+ case cesk of
+  In (TApp (TConst _) _) _ _ _ -> do
+    return ()
+  -- In (TApp t _) _ _ _ -> do
+  In (TVar t) _ _ _ -> do
+    let functionsOfInterest = [
+            "doWalk"
+          , "doTurn"
+          , "runSomeFunction"
+          , "go"
+          ]
+    if any (`T.isInfixOf` prettyText t) functionsOfInterest
+    then do
+      r <- get @Robot
+      let xs = r ^. evalBuffer
+      currentFunction @ConcreteRobot .= Just (T.unlines $ toList $ RB.getValues xs)
+    else return ()
+  _ -> return ()
+ case cesk of
   ------------------------------------------------------------
   -- Evaluation
 
diff --git a/src/swarm-scenario/Swarm/Game/Robot.hs b/src/swarm-scenario/Swarm/Game/Robot.hs
index 91f6d72fa..7b5efbafa 100644
--- a/src/swarm-scenario/Swarm/Game/Robot.hs
+++ b/src/swarm-scenario/Swarm/Game/Robot.hs
@@ -36,6 +36,8 @@ module Swarm.Game.Robot (
   trobotName,
   unwalkableEntities,
   robotCreatedAt,
+  currentFunction,
+  evalBuffer,
   robotDisplay,
   robotLocation,
   unsafeSetRobotLocation,
@@ -79,6 +81,7 @@ import Swarm.Game.Land
 import Swarm.Game.Location (Heading, Location, toDirection, toHeading)
 import Swarm.Game.Robot.Walk
 import Swarm.Game.Universe
+import Swarm.Util.RingBuffer
 import Swarm.Language.JSON ()
 import Swarm.Language.Syntax (Syntax, TSyntax)
 import Swarm.Language.Text.Markdown (Document)
@@ -140,6 +143,8 @@ data RobotR (phase :: RobotPhase) = RobotR
   , _systemRobot :: Bool
   , _selfDestruct :: Bool
   , _activityCounts :: RobotActivity phase
+  , _currentFunction :: Maybe Text
+  , _evalBuffer :: RingBuffer Text
   , _runningAtomic :: Bool
   , _unwalkableEntities :: WalkabilityExceptions EntityName
   , _robotCreatedAt :: TimeSpec
@@ -152,7 +157,14 @@ deriving instance (Eq (RobotLocation phase), Eq (RobotID phase), Eq (RobotMachin
 -- See https://byorgey.wordpress.com/2021/09/17/automatically-updated-cached-views-with-lens/
 -- for the approach used here with lenses.
 
-makeLensesExcluding ['_robotCapabilities, '_equippedDevices, '_robotLog, '_robotLogUpdated, '_machine, '_activityCounts] ''RobotR
+makeLensesExcluding [
+    '_robotCapabilities
+  , '_equippedDevices
+  , '_robotLog
+  , '_robotLogUpdated
+  , '_machine
+  , '_activityCounts
+  ] ''RobotR
 
 -- | A template robot, i.e. a template robot record without a unique ID number,
 --   and possibly without a location.
@@ -183,6 +195,10 @@ unwalkableEntities :: Lens' Robot (WalkabilityExceptions EntityName)
 -- | The creation date of the robot.
 robotCreatedAt :: Lens' Robot TimeSpec
 
+currentFunction :: Lens' (RobotR phase) (Maybe Text)
+
+evalBuffer :: Lens' (RobotR phase) (RingBuffer Text)
+
 -- robotName and trobotName could be generalized to
 -- @robotName' :: Lens' (RobotR phase) Text@.
 -- However, type inference does not work
@@ -344,6 +360,8 @@ mkRobot pid name descr loc dir disp m devs inv sys heavy unwalkables ts =
     , _systemRobot = sys
     , _selfDestruct = False
     , _activityCounts = ()
+    , _currentFunction = Nothing
+    , _evalBuffer = mkRingBuffer $ Finite 5
     , _runningAtomic = False
     , _unwalkableEntities = unwalkables
     }
diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs
index 11df2e546..1f5df8806 100644
--- a/src/swarm-tui/Swarm/TUI/View.hs
+++ b/src/swarm-tui/Swarm/TUI/View.hs
@@ -708,6 +708,7 @@ robotsListWidget s = hCenter table
     , "Pos"
     , "Items"
     , "Status"
+    , "Func"
     , "Actns"
     , "Cmds"
     , "Cycles"
@@ -716,6 +717,7 @@ robotsListWidget s = hCenter table
     ]
   headers = withAttr robotAttr . txt <$> applyWhen debugRID ("ID" :) headings
   robotsTable = mkRobotRow <$> robots
+
   mkRobotRow robot =
     applyWhen debugRID (idWidget :) cells
    where
@@ -725,6 +727,7 @@ robotsListWidget s = hCenter table
       , locWidget
       , padRight (Pad 1) (str $ show rInvCount)
       , statusWidget
+      , activeFunction
       , str $ show $ robot ^. activityCounts . tangibleCommandCount
       , -- TODO(#1341): May want to expose the details of this histogram in
         -- a per-robot pop-up
@@ -734,6 +737,9 @@ robotsListWidget s = hCenter table
       , txt rLog
       ]
 
+    
+    activeFunction = txt . fromMaybe "N/A" $ robot ^. currentFunction
+
     idWidget = str $ show $ robot ^. robotID
     nameWidget =
       hBox
diff --git a/src/swarm-util/Swarm/Util/RingBuffer.hs b/src/swarm-util/Swarm/Util/RingBuffer.hs
index 45c5bb991..7b620f72a 100644
--- a/src/swarm-util/Swarm/Util/RingBuffer.hs
+++ b/src/swarm-util/Swarm/Util/RingBuffer.hs
@@ -15,6 +15,7 @@ import Data.Aeson
 import Data.Sequence as S
 import Servant.Docs (ToSample)
 import Servant.Docs qualified as SD
+import Data.Foldable (toList)
 
 -- | Isomorphic to the 'Maybe' type
 data BufferSize = Infinite | Finite Int
@@ -30,6 +31,12 @@ instance (ToJSON a) => ToJSON (RingBuffer a) where
 instance ToSample (RingBuffer a) where
   toSamples _ = SD.noSamples
 
+instance (Show a) => Show (RingBuffer a) where
+  show rb = show $ toList $ getValues rb
+
+instance Eq (RingBuffer a) where
+  _ == _ = True
+
 getValues :: RingBuffer a -> Seq a
 getValues (RingBuffer xs _) = xs
 

From c6e9a218fba64b2d65d2b8f8b7c3ca9c0b3642f1 Mon Sep 17 00:00:00 2001
From: "Restyled.io" <commits@restyled.io>
Date: Wed, 4 Sep 2024 05:54:48 +0000
Subject: [PATCH 2/2] Restyled by fourmolu

---
 src/swarm-engine/Swarm/Game/Step.hs     | 590 ++++++++++++------------
 src/swarm-scenario/Swarm/Game/Robot.hs  |  11 +-
 src/swarm-tui/Swarm/TUI/View.hs         |   1 -
 src/swarm-util/Swarm/Util/RingBuffer.hs |   2 +-
 4 files changed, 300 insertions(+), 304 deletions(-)

diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs
index e7546c631..9fe9ef5c9 100644
--- a/src/swarm-engine/Swarm/Game/Step.hs
+++ b/src/swarm-engine/Swarm/Game/Step.hs
@@ -28,16 +28,15 @@ import Control.Effect.Lens
 import Control.Effect.Lift
 import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
 import Control.Monad (foldM, forM_, unless, when)
+import Data.Foldable (toList)
 import Data.Functor (void)
 import Data.IntMap qualified as IM
-import Swarm.Util.RingBuffer qualified as RB
 import Data.IntSet qualified as IS
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
 import Data.Sequence ((><))
 import Data.Sequence qualified as Seq
 import Data.Set (Set)
-import Data.Foldable (toList)
 import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -73,6 +72,7 @@ import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Value
 import Swarm.Log
 import Swarm.Util hiding (both)
+import Swarm.Util.RingBuffer qualified as RB
 import Swarm.Util.WindowedCounter qualified as WC
 import System.Clock (TimeSpec)
 import Witch (From (from))
@@ -536,301 +536,299 @@ processImmediateFrame v (SKpair s k) unreliableComputation = do
 --   machine state and figure out a single next step.
 stepCESK :: (Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m, Has Effect.Time sig m) => CESK -> m CESK
 stepCESK cesk = do
+  case cesk of
+    In t _ _ _ -> evalBuffer @ConcreteRobot %= RB.insert (showT t)
+    _ -> return ()
 
-
- case cesk of
-  In t _ _ _ -> evalBuffer @ConcreteRobot %= RB.insert (showT t)
-  _ -> return ()
-
- case cesk of
-  In (TApp (TConst _) _) _ _ _ -> do
-    return ()
-  -- In (TApp t _) _ _ _ -> do
-  In (TVar t) _ _ _ -> do
-    let functionsOfInterest = [
-            "doWalk"
-          , "doTurn"
-          , "runSomeFunction"
-          , "go"
-          ]
-    if any (`T.isInfixOf` prettyText t) functionsOfInterest
-    then do
-      r <- get @Robot
-      let xs = r ^. evalBuffer
-      currentFunction @ConcreteRobot .= Just (T.unlines $ toList $ RB.getValues xs)
-    else return ()
-  _ -> return ()
- case cesk of
-  ------------------------------------------------------------
-  -- Evaluation
-
-  -- We wake up robots whose wake-up time has been reached. If it hasn't yet
-  -- then stepCESK is a no-op.
-  Waiting wakeupTime cesk' -> do
-    time <- use $ temporal . ticks
-    if wakeupTime <= time
-      then stepCESK cesk'
-      else return cesk
-  Out v s (FImmediate cmd wf rf : k) ->
-    processImmediateFrame v (SKpair s k) $
-      updateWorldAndRobots cmd wf rf
-  -- Now some straightforward cases.  These all immediately turn
-  -- into values.
-  In TUnit _ s k -> return $ Out VUnit s k
-  In (TDir d) _ s k -> return $ Out (VDir d) s k
-  In (TInt n) _ s k -> return $ Out (VInt n) s k
-  In (TText str) _ s k -> return $ Out (VText str) s k
-  In (TBool b) _ s k -> return $ Out (VBool b) s k
-  -- There should not be any antiquoted variables left at this point.
-  In (TAntiText v) _ s k ->
-    return $ Up (Fatal (T.append "Antiquoted variable found at runtime: $str:" v)) s k
-  In (TAntiInt v) _ s k ->
-    return $ Up (Fatal (T.append "Antiquoted variable found at runtime: $int:" v)) s k
-  -- Require and requireDevice just turn into no-ops.
-  In (TRequireDevice {}) e s k -> return $ In (TConst Noop) e s k
-  In (TRequire {}) e s k -> return $ In (TConst Noop) e s k
-  In (TRequirements x t) e s k -> return $ Out (VRequirements x t e) s k
-  -- Type ascriptions are ignored
-  In (TAnnotate v _) e s k -> return $ In v e s k
-  -- Normally it's not possible to have a TRobot value in surface
-  -- syntax, but the salvage command generates a program that needs to
-  -- refer directly to the salvaging robot.
-  In (TRobot rid) _ s k -> return $ Out (VRobot rid) s k
-  -- Function constants of arity 0 are evaluated immediately
-  -- (e.g. parent, self).  Any other constant is turned into a VCApp,
-  -- which is waiting for arguments and/or an FExec frame.
-  In (TConst c) _ s k
-    | arity c == 0 && not (isCmd c) -> evalConst c [] s k
-    | otherwise -> return $ Out (VCApp c []) s k
-  -- To evaluate a variable, just look it up in the context.
-  In (TVar x) e s k -> withExceptions s k $ do
-    v <-
-      lookupValue x e
-        `isJustOr` Fatal (T.unwords ["Undefined variable", x, "encountered while running the interpreter."])
-
-    -- Now look up any indirections and make sure it's not a blackhole.
-    case resolveValue s v of
-      Left loc -> throwError $ Fatal $ T.append "Reference to unknown memory cell " (from (show loc))
-      Right VBlackhole -> throwError InfiniteLoop
-      Right v' -> return $ Out v' s k
-
-  -- To evaluate a pair, start evaluating the first component.
-  In (TPair t1 t2) e s k -> return $ In t1 e s (FSnd t2 e : k)
-  -- Once that's done, evaluate the second component.
-  Out v1 s (FSnd t2 e : k) -> return $ In t2 e s (FFst v1 : k)
-  -- Finally, put the results together into a pair value.
-  Out v2 s (FFst v1 : k) -> return $ Out (VPair v1 v2) s k
-  -- Lambdas immediately turn into closures.
-  In (TLam x _ t) e s k -> return $ Out (VClo x t e) s k
-  -- To evaluate an application, start by focusing on the left-hand
-  -- side and saving the argument for later.
-  In (TApp t1 t2) e s k -> return $ In t1 e s (FArg t2 e : k)
-  -- Once that's done, switch to evaluating the argument.
-  Out v1 s (FArg t2 e : k) -> return $ In t2 e s (FApp v1 : k)
-  -- We can evaluate an application of a closure in the usual way.
-  Out v2 s (FApp (VClo x t e) : k) -> return $ In t (addValueBinding x v2 e) s k
-  -- We can also evaluate an application of a constant by collecting
-  -- arguments, eventually dispatching to evalConst for function
-  -- constants.
-  Out v2 s (FApp (VCApp c args) : k)
-    | not (isCmd c)
-        && arity c == length args + 1 ->
-        evalConst c (reverse (v2 : args)) s k
-    | otherwise -> return $ Out (VCApp c (v2 : args)) s k
-  Out _ s (FApp _ : _) -> badMachineState s "FApp of non-function"
-  -- Start evaluating a record.  If it's empty, we're done.  Otherwise, focus
-  -- on the first field and record the rest in a FRcd frame.
-  In (TRcd m) e s k -> return $ case M.assocs m of
-    [] -> Out (VRcd M.empty) s k
-    ((x, t) : fs) -> In (fromMaybe (TVar x) t) e s (FRcd e [] x fs : k)
-  -- When we finish evaluating the last field, return a record value.
-  Out v s (FRcd _ done x [] : k) -> return $ Out (VRcd (M.fromList ((x, v) : done))) s k
-  -- Otherwise, save the value of the field just evaluated and move on
-  -- to focus on evaluating the next one.
-  Out v s (FRcd e done x ((y, t) : rest) : k) ->
-    return $ In (fromMaybe (TVar y) t) e s (FRcd e ((x, v) : done) y rest : k)
-  -- Evaluate a record projection: evaluate the record and remember we
-  -- need to do the projection later.
-  In (TProj t x) e s k -> return $ In t e s (FProj x : k)
-  -- Do a record projection
-  Out v s (FProj x : k) -> case v of
-    VRcd m -> case M.lookup x m of
-      Nothing -> badMachineState s $ T.unwords ["Record projection for variable", x, "that does not exist"]
-      Just xv -> return $ Out xv s k
-    _ -> badMachineState s "FProj frame with non-record value"
-  -- To evaluate non-recursive let expressions, we start by focusing on the
-  -- let-bound expression.
-  In (TLet _ False x mty mreq t1 t2) e s k ->
-    return $ In t1 e s (FLet x ((,) <$> mty <*> mreq) t2 e : k)
-  -- To evaluate a recursive let binding:
-  In (TLet _ True x mty mreq t1 t2) e s k -> do
-    -- First, allocate a cell for it in the store with the initial
-    -- value of Blackhole.
-    let (loc, s') = allocate VBlackhole s
-    -- Now evaluate the definition with the variable bound to an
-    -- indirection to the new cell, and push an FUpdate stack frame to
-    -- update the cell with the value once we're done evaluating it,
-    -- followed by an FLet frame to evaluate the body of the let.
-    return $ In t1 (addValueBinding x (VIndir loc) e) s' (FUpdate loc : FLet x ((,) <$> mty <*> mreq) t2 e : k)
-  -- Once we've finished with the let-binding, we switch to evaluating
-  -- the body in a suitably extended environment.
-  Out v1 s (FLet x mtr t2 e : k) -> do
-    let e' = case mtr of
-          Nothing -> addValueBinding x v1 e
-          Just (ty, req) -> addBinding x (Typed v1 ty req) e
-    return $ In t2 e' s k
-  -- To evaluate a tydef, insert it into the context and proceed to
-  -- evaluate the body.
-  In (TTydef x _ tdInfo t1) e s k -> return $ In t1 (maybe id (addTydef x) tdInfo e) s k
-  -- Bind expressions don't evaluate: just package it up as a value
-  -- until such time as it is to be executed.
-  In (TBind mx mty mreq t1 t2) e s k -> return $ Out (VBind mx mty mreq t1 t2 e) s k
-  -- Simple (non-memoized) delay expressions immediately turn into
-  -- VDelay values, awaiting application of 'Force'.
-  In (TDelay t) e s k -> return $ Out (VDelay t e) s k
-  -- If we see an update frame, it means we're supposed to set the value
-  -- of a particular cell to the value we just finished computing.
-  Out v s (FUpdate loc : k) -> return $ Out v (setStore loc v s) k
-  -- If we see a primitive application of suspend, package it up as
-  -- a value until it's time to execute.
-  In (TSuspend t) e s k -> return $ Out (VSuspend t e) s k
-  ------------------------------------------------------------
-  -- Execution
-
-  -- Executing a 'requirements' command generates an appropriate log message
-  -- listing the requirements of the given expression.
-  Out (VRequirements src t e) s (FExec : k) -> do
-    em <- use $ landscape . terrainAndEntities . entityMap
-    let reqCtx = e ^. envReqs
-        tdCtx = e ^. envTydefs
-
-        R.Requirements caps devs inv = R.requirements tdCtx reqCtx t
-
-        devicesForCaps, requiredDevices :: Set (Set Text)
-        -- possible devices to provide each required capability
-        devicesForCaps = S.map (S.fromList . map (^. entityName) . (`devicesForCap` em)) caps
-        -- outright required devices
-        requiredDevices = S.map S.singleton devs
-
-        deviceSets :: Set (Set Text)
-        deviceSets =
-          -- Union together all required device sets, and remove any
-          -- device sets which are a superset of another set.  For
-          -- example, if (grabber OR fast grabber OR harvester) is
-          -- required but (grabber OR fast grabber) is also required
-          -- then we might as well remove the first set, since
-          -- satisfying the second device set will automatically
-          -- satisfy the first.
-          removeSupersets $ devicesForCaps `S.union` requiredDevices
-
-        reqLog =
-          prettyText $
-            BulletList
-              (pretty $ T.unwords ["Requirements for", bquote src <> ":"])
-              ( filter
-                  (not . null . bulletListItems)
-                  [ BulletList
-                      "Equipment:"
-                      (T.intercalate " OR " . S.toList <$> S.toList deviceSets)
-                  , BulletList
-                      "Inventory:"
-                      ((\(item, n) -> item <> " " <> parens (showT n)) <$> M.assocs inv)
-                  ]
-              )
-
-    _ <- traceLog Logged Info reqLog
-    return $ Out VUnit s k
-
-  -- To execute a constant application, delegate to the 'evalConst'
-  -- function.  Set tickStepBudget to 0 if the command is supposed to take
-  -- a tick, so the robot won't take any more steps this tick.
-  Out (VCApp c args) s (FExec : k) -> do
-    when (isTangible c) $ activityCounts . tickStepBudget .= 0
-    evalConst c (reverse args) s k
-
-  -- Reset the runningAtomic flag when we encounter an FFinishAtomic frame.
-  Out v s (FFinishAtomic : k) -> do
-    runningAtomic .= False
-    return $ Out v s k
-
-  -- To execute a bind expression, evaluate and execute the first
-  -- command, and remember the second for execution later.
-  Out (VBind mx mty mreq c1 c2 e) s (FExec : k) -> return $ In c1 e s (FExec : FBind mx ((,) <$> mty <*> mreq) c2 e : k)
-  Out _ s (FBind Nothing _ t2 e : k) -> return $ In t2 e s (FExec : k)
-  Out v s (FBind (Just x) mtr t2 e : k) -> do
-    let e' = case mtr of
-          Nothing -> addValueBinding x v e
-          Just (ty, reqs) -> addBinding x (Typed v ty reqs) e
-    return $ In t2 e' s (FExec : k)
-  -- To execute a suspend instruction, evaluate its argument and then
-  -- suspend.
-  Out (VSuspend t e) s (FExec : k) -> return $ In t e s (FSuspend e : k)
-  -- Once we've finished, enter the Suspended state.
-  Out v s (FSuspend e : k) -> return $ Suspended v e s k
-  -- Any other type of value wiwth an FExec frame is an error (should
-  -- 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
-  -- We can also sometimes get a redundant FExec; discard it.
-  Suspended v e s (FExec : 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,
-  -- i.e. the binds were reassociated.  For example
-  --
-  -- (x; z <- y; suspend z); q; r
-  --
-  -- should be equivalent to
-  --
-  -- x; z <- y; q; r
-  --
-  Suspended _ e s (FBind Nothing _ t2 _ : k) -> return $ In t2 e s (FExec : k)
-  Suspended v e s (FBind (Just x) mtr t2 _ : k) -> do
-    let e' = case mtr of
-          Nothing -> addValueBinding x v e
-          Just (ty, reqs) -> addBinding x (Typed v ty reqs) e
-    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 stack).
-  Suspended v e s _ -> return $ Suspended v e s []
-  ------------------------------------------------------------
-  -- Exception handling
-  ------------------------------------------------------------
-
-  -- First, if we were running a try block but evaluation completed normally,
-  -- just ignore the try block and continue.
-  Out v s (FTry {} : k) -> return $ Out v s k
-  -- Also ignore restore frames when returning normally.
-  Out v s (FRestoreEnv {} : k) -> return $ Out v s k
-  -- If raising an exception up the stack and we reach the top, handle
-  -- it appropriately.
-  Up exn s [] -> handleException exn s Nothing
-  -- If we are raising an exception up the stack and we see an
-  -- FRestoreEnv frame, log the exception, switch into a suspended state,
-  -- and discard the rest of the stack.
-  Up exn s (FRestoreEnv e : _) -> handleException exn s (Just e)
-  -- If an atomic block threw an exception, we should terminate it.
-  Up exn s (FFinishAtomic : k) -> do
-    runningAtomic .= False
-    return $ Up exn s k
-  -- If we are raising a catchable exception up the continuation
-  -- stack and come to a Try frame, force and then execute the associated catch
-  -- block.
-  Up exn s (FTry c : k)
-    | isCatchable exn -> return $ Out c s (FApp (VCApp Force []) : FExec : k)
-  -- 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, return the machine unchanged.
-  done@(Out _ _ []) -> return done
+  case cesk of
+    In (TApp (TConst _) _) _ _ _ -> do
+      return ()
+    -- In (TApp t _) _ _ _ -> do
+    In (TVar t) _ _ _ -> do
+      let functionsOfInterest =
+            [ "doWalk"
+            , "doTurn"
+            , "runSomeFunction"
+            , "go"
+            ]
+      if any (`T.isInfixOf` prettyText t) functionsOfInterest
+        then do
+          r <- get @Robot
+          let xs = r ^. evalBuffer
+          currentFunction @ConcreteRobot .= Just (T.unlines $ toList $ RB.getValues xs)
+        else return ()
+    _ -> return ()
+  case cesk of
+    ------------------------------------------------------------
+    -- Evaluation
+
+    -- We wake up robots whose wake-up time has been reached. If it hasn't yet
+    -- then stepCESK is a no-op.
+    Waiting wakeupTime cesk' -> do
+      time <- use $ temporal . ticks
+      if wakeupTime <= time
+        then stepCESK cesk'
+        else return cesk
+    Out v s (FImmediate cmd wf rf : k) ->
+      processImmediateFrame v (SKpair s k) $
+        updateWorldAndRobots cmd wf rf
+    -- Now some straightforward cases.  These all immediately turn
+    -- into values.
+    In TUnit _ s k -> return $ Out VUnit s k
+    In (TDir d) _ s k -> return $ Out (VDir d) s k
+    In (TInt n) _ s k -> return $ Out (VInt n) s k
+    In (TText str) _ s k -> return $ Out (VText str) s k
+    In (TBool b) _ s k -> return $ Out (VBool b) s k
+    -- There should not be any antiquoted variables left at this point.
+    In (TAntiText v) _ s k ->
+      return $ Up (Fatal (T.append "Antiquoted variable found at runtime: $str:" v)) s k
+    In (TAntiInt v) _ s k ->
+      return $ Up (Fatal (T.append "Antiquoted variable found at runtime: $int:" v)) s k
+    -- Require and requireDevice just turn into no-ops.
+    In (TRequireDevice {}) e s k -> return $ In (TConst Noop) e s k
+    In (TRequire {}) e s k -> return $ In (TConst Noop) e s k
+    In (TRequirements x t) e s k -> return $ Out (VRequirements x t e) s k
+    -- Type ascriptions are ignored
+    In (TAnnotate v _) e s k -> return $ In v e s k
+    -- Normally it's not possible to have a TRobot value in surface
+    -- syntax, but the salvage command generates a program that needs to
+    -- refer directly to the salvaging robot.
+    In (TRobot rid) _ s k -> return $ Out (VRobot rid) s k
+    -- Function constants of arity 0 are evaluated immediately
+    -- (e.g. parent, self).  Any other constant is turned into a VCApp,
+    -- which is waiting for arguments and/or an FExec frame.
+    In (TConst c) _ s k
+      | arity c == 0 && not (isCmd c) -> evalConst c [] s k
+      | otherwise -> return $ Out (VCApp c []) s k
+    -- To evaluate a variable, just look it up in the context.
+    In (TVar x) e s k -> withExceptions s k $ do
+      v <-
+        lookupValue x e
+          `isJustOr` Fatal (T.unwords ["Undefined variable", x, "encountered while running the interpreter."])
+
+      -- Now look up any indirections and make sure it's not a blackhole.
+      case resolveValue s v of
+        Left loc -> throwError $ Fatal $ T.append "Reference to unknown memory cell " (from (show loc))
+        Right VBlackhole -> throwError InfiniteLoop
+        Right v' -> return $ Out v' s k
+
+    -- To evaluate a pair, start evaluating the first component.
+    In (TPair t1 t2) e s k -> return $ In t1 e s (FSnd t2 e : k)
+    -- Once that's done, evaluate the second component.
+    Out v1 s (FSnd t2 e : k) -> return $ In t2 e s (FFst v1 : k)
+    -- Finally, put the results together into a pair value.
+    Out v2 s (FFst v1 : k) -> return $ Out (VPair v1 v2) s k
+    -- Lambdas immediately turn into closures.
+    In (TLam x _ t) e s k -> return $ Out (VClo x t e) s k
+    -- To evaluate an application, start by focusing on the left-hand
+    -- side and saving the argument for later.
+    In (TApp t1 t2) e s k -> return $ In t1 e s (FArg t2 e : k)
+    -- Once that's done, switch to evaluating the argument.
+    Out v1 s (FArg t2 e : k) -> return $ In t2 e s (FApp v1 : k)
+    -- We can evaluate an application of a closure in the usual way.
+    Out v2 s (FApp (VClo x t e) : k) -> return $ In t (addValueBinding x v2 e) s k
+    -- We can also evaluate an application of a constant by collecting
+    -- arguments, eventually dispatching to evalConst for function
+    -- constants.
+    Out v2 s (FApp (VCApp c args) : k)
+      | not (isCmd c)
+          && arity c == length args + 1 ->
+          evalConst c (reverse (v2 : args)) s k
+      | otherwise -> return $ Out (VCApp c (v2 : args)) s k
+    Out _ s (FApp _ : _) -> badMachineState s "FApp of non-function"
+    -- Start evaluating a record.  If it's empty, we're done.  Otherwise, focus
+    -- on the first field and record the rest in a FRcd frame.
+    In (TRcd m) e s k -> return $ case M.assocs m of
+      [] -> Out (VRcd M.empty) s k
+      ((x, t) : fs) -> In (fromMaybe (TVar x) t) e s (FRcd e [] x fs : k)
+    -- When we finish evaluating the last field, return a record value.
+    Out v s (FRcd _ done x [] : k) -> return $ Out (VRcd (M.fromList ((x, v) : done))) s k
+    -- Otherwise, save the value of the field just evaluated and move on
+    -- to focus on evaluating the next one.
+    Out v s (FRcd e done x ((y, t) : rest) : k) ->
+      return $ In (fromMaybe (TVar y) t) e s (FRcd e ((x, v) : done) y rest : k)
+    -- Evaluate a record projection: evaluate the record and remember we
+    -- need to do the projection later.
+    In (TProj t x) e s k -> return $ In t e s (FProj x : k)
+    -- Do a record projection
+    Out v s (FProj x : k) -> case v of
+      VRcd m -> case M.lookup x m of
+        Nothing -> badMachineState s $ T.unwords ["Record projection for variable", x, "that does not exist"]
+        Just xv -> return $ Out xv s k
+      _ -> badMachineState s "FProj frame with non-record value"
+    -- To evaluate non-recursive let expressions, we start by focusing on the
+    -- let-bound expression.
+    In (TLet _ False x mty mreq t1 t2) e s k ->
+      return $ In t1 e s (FLet x ((,) <$> mty <*> mreq) t2 e : k)
+    -- To evaluate a recursive let binding:
+    In (TLet _ True x mty mreq t1 t2) e s k -> do
+      -- First, allocate a cell for it in the store with the initial
+      -- value of Blackhole.
+      let (loc, s') = allocate VBlackhole s
+      -- Now evaluate the definition with the variable bound to an
+      -- indirection to the new cell, and push an FUpdate stack frame to
+      -- update the cell with the value once we're done evaluating it,
+      -- followed by an FLet frame to evaluate the body of the let.
+      return $ In t1 (addValueBinding x (VIndir loc) e) s' (FUpdate loc : FLet x ((,) <$> mty <*> mreq) t2 e : k)
+    -- Once we've finished with the let-binding, we switch to evaluating
+    -- the body in a suitably extended environment.
+    Out v1 s (FLet x mtr t2 e : k) -> do
+      let e' = case mtr of
+            Nothing -> addValueBinding x v1 e
+            Just (ty, req) -> addBinding x (Typed v1 ty req) e
+      return $ In t2 e' s k
+    -- To evaluate a tydef, insert it into the context and proceed to
+    -- evaluate the body.
+    In (TTydef x _ tdInfo t1) e s k -> return $ In t1 (maybe id (addTydef x) tdInfo e) s k
+    -- Bind expressions don't evaluate: just package it up as a value
+    -- until such time as it is to be executed.
+    In (TBind mx mty mreq t1 t2) e s k -> return $ Out (VBind mx mty mreq t1 t2 e) s k
+    -- Simple (non-memoized) delay expressions immediately turn into
+    -- VDelay values, awaiting application of 'Force'.
+    In (TDelay t) e s k -> return $ Out (VDelay t e) s k
+    -- If we see an update frame, it means we're supposed to set the value
+    -- of a particular cell to the value we just finished computing.
+    Out v s (FUpdate loc : k) -> return $ Out v (setStore loc v s) k
+    -- If we see a primitive application of suspend, package it up as
+    -- a value until it's time to execute.
+    In (TSuspend t) e s k -> return $ Out (VSuspend t e) s k
+    ------------------------------------------------------------
+    -- Execution
+
+    -- Executing a 'requirements' command generates an appropriate log message
+    -- listing the requirements of the given expression.
+    Out (VRequirements src t e) s (FExec : k) -> do
+      em <- use $ landscape . terrainAndEntities . entityMap
+      let reqCtx = e ^. envReqs
+          tdCtx = e ^. envTydefs
+
+          R.Requirements caps devs inv = R.requirements tdCtx reqCtx t
+
+          devicesForCaps, requiredDevices :: Set (Set Text)
+          -- possible devices to provide each required capability
+          devicesForCaps = S.map (S.fromList . map (^. entityName) . (`devicesForCap` em)) caps
+          -- outright required devices
+          requiredDevices = S.map S.singleton devs
+
+          deviceSets :: Set (Set Text)
+          deviceSets =
+            -- Union together all required device sets, and remove any
+            -- device sets which are a superset of another set.  For
+            -- example, if (grabber OR fast grabber OR harvester) is
+            -- required but (grabber OR fast grabber) is also required
+            -- then we might as well remove the first set, since
+            -- satisfying the second device set will automatically
+            -- satisfy the first.
+            removeSupersets $ devicesForCaps `S.union` requiredDevices
+
+          reqLog =
+            prettyText $
+              BulletList
+                (pretty $ T.unwords ["Requirements for", bquote src <> ":"])
+                ( filter
+                    (not . null . bulletListItems)
+                    [ BulletList
+                        "Equipment:"
+                        (T.intercalate " OR " . S.toList <$> S.toList deviceSets)
+                    , BulletList
+                        "Inventory:"
+                        ((\(item, n) -> item <> " " <> parens (showT n)) <$> M.assocs inv)
+                    ]
+                )
+
+      _ <- traceLog Logged Info reqLog
+      return $ Out VUnit s k
+
+    -- To execute a constant application, delegate to the 'evalConst'
+    -- function.  Set tickStepBudget to 0 if the command is supposed to take
+    -- a tick, so the robot won't take any more steps this tick.
+    Out (VCApp c args) s (FExec : k) -> do
+      when (isTangible c) $ activityCounts . tickStepBudget .= 0
+      evalConst c (reverse args) s k
+
+    -- Reset the runningAtomic flag when we encounter an FFinishAtomic frame.
+    Out v s (FFinishAtomic : k) -> do
+      runningAtomic .= False
+      return $ Out v s k
+
+    -- To execute a bind expression, evaluate and execute the first
+    -- command, and remember the second for execution later.
+    Out (VBind mx mty mreq c1 c2 e) s (FExec : k) -> return $ In c1 e s (FExec : FBind mx ((,) <$> mty <*> mreq) c2 e : k)
+    Out _ s (FBind Nothing _ t2 e : k) -> return $ In t2 e s (FExec : k)
+    Out v s (FBind (Just x) mtr t2 e : k) -> do
+      let e' = case mtr of
+            Nothing -> addValueBinding x v e
+            Just (ty, reqs) -> addBinding x (Typed v ty reqs) e
+      return $ In t2 e' s (FExec : k)
+    -- To execute a suspend instruction, evaluate its argument and then
+    -- suspend.
+    Out (VSuspend t e) s (FExec : k) -> return $ In t e s (FSuspend e : k)
+    -- Once we've finished, enter the Suspended state.
+    Out v s (FSuspend e : k) -> return $ Suspended v e s k
+    -- Any other type of value wiwth an FExec frame is an error (should
+    -- 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
+    -- We can also sometimes get a redundant FExec; discard it.
+    Suspended v e s (FExec : 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,
+    -- i.e. the binds were reassociated.  For example
+    --
+    -- (x; z <- y; suspend z); q; r
+    --
+    -- should be equivalent to
+    --
+    -- x; z <- y; q; r
+    --
+    Suspended _ e s (FBind Nothing _ t2 _ : k) -> return $ In t2 e s (FExec : k)
+    Suspended v e s (FBind (Just x) mtr t2 _ : k) -> do
+      let e' = case mtr of
+            Nothing -> addValueBinding x v e
+            Just (ty, reqs) -> addBinding x (Typed v ty reqs) e
+      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 stack).
+    Suspended v e s _ -> return $ Suspended v e s []
+    ------------------------------------------------------------
+    -- Exception handling
+    ------------------------------------------------------------
+
+    -- First, if we were running a try block but evaluation completed normally,
+    -- just ignore the try block and continue.
+    Out v s (FTry {} : k) -> return $ Out v s k
+    -- Also ignore restore frames when returning normally.
+    Out v s (FRestoreEnv {} : k) -> return $ Out v s k
+    -- If raising an exception up the stack and we reach the top, handle
+    -- it appropriately.
+    Up exn s [] -> handleException exn s Nothing
+    -- If we are raising an exception up the stack and we see an
+    -- FRestoreEnv frame, log the exception, switch into a suspended state,
+    -- and discard the rest of the stack.
+    Up exn s (FRestoreEnv e : _) -> handleException exn s (Just e)
+    -- If an atomic block threw an exception, we should terminate it.
+    Up exn s (FFinishAtomic : k) -> do
+      runningAtomic .= False
+      return $ Up exn s k
+    -- If we are raising a catchable exception up the continuation
+    -- stack and come to a Try frame, force and then execute the associated catch
+    -- block.
+    Up exn s (FTry c : k)
+      | isCatchable exn -> return $ Out c s (FApp (VCApp Force []) : FExec : k)
+    -- 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, return the machine unchanged.
+    done@(Out _ _ []) -> return done
  where
   badMachineState s msg =
     let msg' =
diff --git a/src/swarm-scenario/Swarm/Game/Robot.hs b/src/swarm-scenario/Swarm/Game/Robot.hs
index 7b5efbafa..231362488 100644
--- a/src/swarm-scenario/Swarm/Game/Robot.hs
+++ b/src/swarm-scenario/Swarm/Game/Robot.hs
@@ -81,11 +81,11 @@ import Swarm.Game.Land
 import Swarm.Game.Location (Heading, Location, toDirection, toHeading)
 import Swarm.Game.Robot.Walk
 import Swarm.Game.Universe
-import Swarm.Util.RingBuffer
 import Swarm.Language.JSON ()
 import Swarm.Language.Syntax (Syntax, TSyntax)
 import Swarm.Language.Text.Markdown (Document)
 import Swarm.Util.Lens (makeLensesExcluding)
+import Swarm.Util.RingBuffer
 import Swarm.Util.Yaml
 import System.Clock (TimeSpec)
 
@@ -157,14 +157,15 @@ deriving instance (Eq (RobotLocation phase), Eq (RobotID phase), Eq (RobotMachin
 -- See https://byorgey.wordpress.com/2021/09/17/automatically-updated-cached-views-with-lens/
 -- for the approach used here with lenses.
 
-makeLensesExcluding [
-    '_robotCapabilities
+makeLensesExcluding
+  [ '_robotCapabilities
   , '_equippedDevices
   , '_robotLog
   , '_robotLogUpdated
   , '_machine
   , '_activityCounts
-  ] ''RobotR
+  ]
+  ''RobotR
 
 -- | A template robot, i.e. a template robot record without a unique ID number,
 --   and possibly without a location.
@@ -194,9 +195,7 @@ unwalkableEntities :: Lens' Robot (WalkabilityExceptions EntityName)
 
 -- | The creation date of the robot.
 robotCreatedAt :: Lens' Robot TimeSpec
-
 currentFunction :: Lens' (RobotR phase) (Maybe Text)
-
 evalBuffer :: Lens' (RobotR phase) (RingBuffer Text)
 
 -- robotName and trobotName could be generalized to
diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs
index 1f5df8806..79d3a2d18 100644
--- a/src/swarm-tui/Swarm/TUI/View.hs
+++ b/src/swarm-tui/Swarm/TUI/View.hs
@@ -737,7 +737,6 @@ robotsListWidget s = hCenter table
       , txt rLog
       ]
 
-    
     activeFunction = txt . fromMaybe "N/A" $ robot ^. currentFunction
 
     idWidget = str $ show $ robot ^. robotID
diff --git a/src/swarm-util/Swarm/Util/RingBuffer.hs b/src/swarm-util/Swarm/Util/RingBuffer.hs
index 7b620f72a..3a7670891 100644
--- a/src/swarm-util/Swarm/Util/RingBuffer.hs
+++ b/src/swarm-util/Swarm/Util/RingBuffer.hs
@@ -12,10 +12,10 @@ module Swarm.Util.RingBuffer (
 ) where
 
 import Data.Aeson
+import Data.Foldable (toList)
 import Data.Sequence as S
 import Servant.Docs (ToSample)
 import Servant.Docs qualified as SD
-import Data.Foldable (toList)
 
 -- | Isomorphic to the 'Maybe' type
 data BufferSize = Infinite | Finite Int