From 8b58c4b952183ae2422a3fee6f65e94e5c78bcb5 Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Tue, 3 Sep 2024 22:52:54 -0700 Subject: [PATCH] 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