trace functions

data/scenarios/Testing/2133-robot-function-tracing/00-ORDER.txt

@@ -0,0 +1 @@
+2133-show-functions.yaml

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

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;

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
 

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
     }

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

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