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,39 @@
+version: 1
+name: Show functions
+description: |
+  Press F2 to observe robot function execution
+creative: false
+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-scenario/Swarm/Game/Robot.hs

@@ -52,6 +52,9 @@ module Swarm.Game.Robot (
   systemRobot,
   selfDestruct,
   runningAtomic,
+  robotDebug,
+  currentFunction,
+  evalBuffer,
 
   -- ** Creation & instantiation
   mkRobot,
@@ -83,6 +86,7 @@ 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)
 
@@ -121,6 +125,14 @@ type instance RobotLogMember 'TemplateRobot = ()
 type family RobotLogUpdatedMember (phase :: RobotPhase) :: Data.Kind.Type
 type instance RobotLogUpdatedMember 'TemplateRobot = ()
 
+data RobotDebug = RobotDebug
+  { _currentFunction :: Maybe Text
+  , _evalBuffer :: RingBuffer Text
+  }
+  deriving (Show, Eq)
+
+makeLenses ''RobotDebug
+
 -- | A value of type 'RobotR' is a record representing the state of a
 --   single robot.  The @f@ parameter is for tracking whether or not
 --   the robot has been assigned a unique ID.
@@ -140,6 +152,7 @@ data RobotR (phase :: RobotPhase) = RobotR
   , _systemRobot :: Bool
   , _selfDestruct :: Bool
   , _activityCounts :: RobotActivity phase
+  , _robotDebug :: RobotDebug
   , _runningAtomic :: Bool
   , _unwalkableEntities :: WalkabilityExceptions EntityName
   , _robotCreatedAt :: TimeSpec
@@ -152,7 +165,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, '_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.
@@ -182,6 +203,7 @@ unwalkableEntities :: Lens' Robot (WalkabilityExceptions EntityName)
 
 -- | The creation date of the robot.
 robotCreatedAt :: Lens' Robot TimeSpec
+robotDebug :: Lens' (RobotR phase) RobotDebug
 
 -- robotName and trobotName could be generalized to
 -- @robotName' :: Lens' (RobotR phase) Text@.
@@ -344,6 +366,11 @@ mkRobot pid name descr loc dir disp m devs inv sys heavy unwalkables ts =
     , _systemRobot = sys
     , _selfDestruct = False
     , _activityCounts = ()
+    , _robotDebug =
+        RobotDebug
+          { _currentFunction = Nothing
+          , _evalBuffer = mkRingBuffer $ Finite 16
+          }
     , _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,8 @@ robotsListWidget s = hCenter table
       , txt rLog
       ]
 
+    activeFunction = txt . fromMaybe "N/A" $ robot ^. robotDebug . currentFunction
+
     idWidget = str $ show $ robot ^. robotID
     nameWidget =
       hBox

src/swarm-tui/Swarm/TUI/View/Util.hs

@@ -49,7 +49,7 @@ generateModal s mt = Modal mt (dialog (Just $ str title) buttons (maxModalWindow
   (title, buttons, requiredWidth) =
     case mt of
       HelpModal -> (" Help ", Nothing, descriptionWidth)
-      RobotsModal -> ("Robots", Nothing, descriptionWidth)
+      RobotsModal -> ("Robots", Nothing, 160)
       RecipesModal -> ("Available Recipes", Nothing, descriptionWidth)
       CommandsModal -> ("Available Commands", Nothing, descriptionWidth)
       MessagesModal -> ("Messages", Nothing, descriptionWidth)

src/swarm-util/Swarm/Util/RingBuffer.hs

@@ -12,6 +12,7 @@ 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
@@ -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