split scenario construction into separate sublibrary

src/Swarm/TUI/Controller.hs

@@ -78,6 +78,8 @@ import Swarm.Game.Entity hiding (empty)
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Context
+import Swarm.Game.Robot.Query
 import Swarm.Game.Scenario.Topography.Structure.Recognition (automatons)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (originalStructureDefinitions)
 import Swarm.Game.ScenarioInfo

src/Swarm/TUI/Model.hs

@@ -142,6 +142,7 @@ import Swarm.Game.Failure
 import Swarm.Game.Recipe (Recipe, loadRecipes)
 import Swarm.Game.ResourceLoading (NameGenerator, initNameGenerator, readAppData)
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Context
 import Swarm.Game.Scenario.Status
 import Swarm.Game.ScenarioInfo (ScenarioCollection, loadScenarios, _SISingle)
 import Swarm.Game.State

src/Swarm/TUI/View.hs

@@ -78,6 +78,7 @@ import Swarm.Game.Entity as E
 import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Query
 import Swarm.Game.Scenario (
   scenarioAuthor,
   scenarioCreative,

src/swarm-engine/Swarm/Game/Robot/Query.hs

@@ -0,0 +1,39 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- State-aware robot utility functions
+module Swarm.Game.Robot.Query where
+
+import Control.Lens (view, (^.))
+import Data.Maybe (isNothing)
+import Swarm.Game.CESK qualified as C
+import Swarm.Game.Robot
+import Swarm.Language.Value as V
+
+-- | Is the robot actively in the middle of a computation?
+isActive :: Robot -> Bool
+{-# INLINE isActive #-}
+isActive = isNothing . getResult
+
+-- | "Active" robots include robots that are waiting; 'wantsToStep' is
+--   true if the robot actually wants to take another step right now
+--   (this is a /subset/ of active robots).
+wantsToStep :: C.TickNumber -> Robot -> Bool
+wantsToStep now robot
+  | not (isActive robot) = False
+  | otherwise = maybe True (now >=) (waitingUntil robot)
+
+-- | The time until which the robot is waiting, if any.
+waitingUntil :: Robot -> Maybe C.TickNumber
+waitingUntil robot =
+  case robot ^. machine of
+    C.Waiting time _ -> Just time
+    _ -> Nothing
+
+-- | Get the result of the robot's computation if it is finished.
+getResult :: Robot -> Maybe (Value, C.Store)
+{-# INLINE getResult #-}
+getResult = C.finalValue . view machine
+
+hearingDistance :: (Num i) => i
+hearingDistance = 32

src/swarm-engine/Swarm/Game/State.hs

@@ -111,6 +111,7 @@ import Swarm.Game.Recipe (
   outRecipeMap,
  )
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Query
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Status
 import Swarm.Game.Scenario.Topography.Structure qualified as Structure

src/swarm-engine/Swarm/Game/State/Robot.hs

@@ -70,6 +70,7 @@ import Swarm.Game.CESK (CESK (Waiting), TickNumber (..), addTicks)
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (NameGenerator)
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Query
 import Swarm.Game.State.Config
 import Swarm.Game.Universe as U
 import Swarm.Util (binTuples, surfaceEmpty, (<+=), (<<.=))

src/swarm-engine/Swarm/Game/Step.hs

@@ -49,6 +49,8 @@ import Swarm.Game.Display
 import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
 import Swarm.Game.Exception
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Context
+import Swarm.Game.Robot.Query
 import Swarm.Game.Scenario.Objective qualified as OB
 import Swarm.Game.Scenario.Objective.WinCheck qualified as WC
 import Swarm.Game.State

src/swarm-engine/Swarm/Game/Step/Const.hs

@@ -56,6 +56,8 @@ import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.ResourceLoading (getDataFileNameSafe)
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Context
+import Swarm.Game.Robot.Query
 import Swarm.Game.Scenario.Topography.Area (getAreaDimensions)
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
 import Swarm.Game.Scenario.Topography.Navigation.Util

src/swarm-engine/Swarm/Game/Step/Path/Cache.hs

@@ -41,6 +41,7 @@ import Data.Map qualified as M
 import Swarm.Game.Entity
 import Swarm.Game.Location
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Context (WalkabilityContext)
 import Swarm.Game.State
 import Swarm.Game.Step.Path.Cache.DistanceLimit
 import Swarm.Game.Step.Path.Type

src/swarm-engine/Swarm/Game/Step/Path/Type.hs

@@ -25,7 +25,8 @@ import Data.Map qualified as M
 import GHC.Generics (Generic)
 import Swarm.Game.Entity
 import Swarm.Game.Location
-import Swarm.Game.Robot (RID, WalkabilityContext)
+import Swarm.Game.Robot (RID)
+import Swarm.Game.Robot.Context (WalkabilityContext)
 import Swarm.Game.Universe (SubworldName)
 import Swarm.Util.Lens (makeLensesNoSigs)
 import Swarm.Util.RingBuffer

src/swarm-engine/Swarm/Game/Step/Path/Walkability.hs

@@ -7,7 +7,7 @@ module Swarm.Game.Step.Path.Walkability where
 import Control.Lens
 import Data.Set qualified as S
 import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
-import Swarm.Game.Robot
+import Swarm.Game.Robot.Context
 import Swarm.Language.Capability
 
 data MoveFailureMode = PathBlocked | PathLiquid

src/swarm-engine/Swarm/Game/Robot.hs → src/swarm-scenario/Swarm/Game/Robot.hs

@@ -20,18 +20,6 @@ module Swarm.Game.Robot (
   Robot,
   TRobot,
 
-  -- ** Runtime robot update
-  RobotUpdate (..),
-
-  -- * Robot context
-  RobotContext,
-  defTypes,
-  defReqs,
-  defVals,
-  defStore,
-  emptyRobotContext,
-  WalkabilityContext (..),
-
   -- ** Lenses
   robotEntity,
   robotName,
@@ -72,13 +60,6 @@ module Swarm.Game.Robot (
 
   -- ** Query
   robotKnows,
-  isActive,
-  wantsToStep,
-  waitingUntil,
-  getResult,
-
-  -- ** Constants
-  hearingDistance,
 ) where
 
 import Control.Applicative ((<|>))
@@ -87,7 +68,7 @@ import Data.Aeson qualified as Ae (FromJSON, Key, KeyValue, ToJSON (..), object,
 import Data.Hashable (hashWithSalt)
 import Data.Kind qualified
 import Data.Map (Map)
-import Data.Maybe (catMaybes, fromMaybe, isNothing)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Sequence (Seq)
 import Data.Sequence qualified as Seq
 import Data.Set (Set)
@@ -97,73 +78,23 @@ import GHC.Generics (Generic)
 import Linear
 import Servant.Docs (ToSample)
 import Servant.Docs qualified as SD
-import Swarm.Game.CESK
+import Swarm.Game.CESK qualified as C
 import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible)
 import Swarm.Game.Entity hiding (empty)
 import Swarm.Game.Location (Heading, Location, toDirection, toHeading)
+import Swarm.Game.Robot.Context
 import Swarm.Game.Universe
 import Swarm.Language.Capability (Capability)
-import Swarm.Language.Context qualified as Ctx
 import Swarm.Language.Pipeline.QQ (tmQ)
-import Swarm.Language.Requirement (ReqCtx)
 import Swarm.Language.Syntax (Const, Syntax)
 import Swarm.Language.Text.Markdown (Document)
-import Swarm.Language.Typed (Typed (..))
-import Swarm.Language.Types (TCtx)
 import Swarm.Language.Value as V
 import Swarm.Log
 import Swarm.Util.Lens (makeLensesExcluding, makeLensesNoSigs)
 import Swarm.Util.WindowedCounter
 import Swarm.Util.Yaml
 import System.Clock (TimeSpec)
 
--- | A record that stores the information
---   for all definitions stored in a 'Robot'
-data RobotContext = RobotContext
-  { _defTypes :: TCtx
-  -- ^ Map definition names to their types.
-  , _defReqs :: ReqCtx
-  -- ^ Map definition names to the capabilities
-  --   required to evaluate/execute them.
-  , _defVals :: Env
-  -- ^ Map definition names to their values. Note that since
-  --   definitions are delayed, the values will just consist of
-  --   'VRef's pointing into the store.
-  , _defStore :: Store
-  -- ^ A store containing memory cells allocated to hold
-  --   definitions.
-  }
-  deriving (Eq, Show, Generic, Ae.FromJSON, Ae.ToJSON)
-
-makeLenses ''RobotContext
-
-emptyRobotContext :: RobotContext
-emptyRobotContext = RobotContext Ctx.empty Ctx.empty Ctx.empty emptyStore
-
-type instance Index RobotContext = Ctx.Var
-type instance IxValue RobotContext = Typed Value
-
-instance Ixed RobotContext
-instance At RobotContext where
-  at name = lens getter setter
-   where
-    getter ctx =
-      do
-        typ <- Ctx.lookup name (ctx ^. defTypes)
-        val <- Ctx.lookup name (ctx ^. defVals)
-        req <- Ctx.lookup name (ctx ^. defReqs)
-        return $ Typed val typ req
-    setter ctx Nothing =
-      ctx
-        & defTypes %~ Ctx.delete name
-        & defVals %~ Ctx.delete name
-        & defReqs %~ Ctx.delete name
-    setter ctx (Just (Typed val typ req)) =
-      ctx
-        & defTypes %~ Ctx.addBinding name typ
-        & defVals %~ Ctx.addBinding name val
-        & defReqs %~ Ctx.addBinding name req
-
 -- | A unique identifier for a robot.
 type RID = Int
 
@@ -181,7 +112,7 @@ data ActivityCounts = ActivityCounts
   , _tangibleCommandCount :: Int
   , _commandsHistogram :: Map Const Int
   , _lifetimeStepCount :: Int
-  , _activityWindow :: WindowedCounter TickNumber
+  , _activityWindow :: WindowedCounter C.TickNumber
   }
   deriving (Eq, Show, Generic, Ae.FromJSON, Ae.ToJSON)
 
@@ -253,7 +184,7 @@ commandsHistogram :: Lens' ActivityCounts (Map Const Int)
 lifetimeStepCount :: Lens' ActivityCounts Int
 
 -- | Sliding window over a span of ticks indicating ratio of activity
-activityWindow :: Lens' ActivityCounts (WindowedCounter TickNumber)
+activityWindow :: Lens' ActivityCounts (WindowedCounter C.TickNumber)
 
 -- | With a robot template, we may or may not have a location.  With a
 --   concrete robot we must have a location.
@@ -282,7 +213,7 @@ data RobotR (phase :: RobotPhase) = RobotR
   , _robotID :: RobotID phase
   , _robotParentID :: Maybe RID
   , _robotHeavy :: Bool
-  , _machine :: CESK
+  , _machine :: C.CESK
   , _systemRobot :: Bool
   , _selfDestruct :: Bool
   , _activityCounts :: ActivityCounts
@@ -320,7 +251,7 @@ instance ToSample Robot where
         defaultCosmicLocation
         zero
         defaultRobotDisplay
-        (initMachine [tmQ| move |] mempty emptyStore)
+        (C.initMachine [tmQ| move |] mempty C.emptyStore)
         []
         []
         False
@@ -495,7 +426,7 @@ robotCapabilities :: Getter Robot (Set Capability)
 robotCapabilities = to _robotCapabilities
 
 -- | The robot's current CEK machine state.
-machine :: Lens' Robot CESK
+machine :: Lens' Robot C.CESK
 
 -- | Is this robot a "system robot"?  System robots are generated by
 --   the system (as opposed to created by the user) and are not
@@ -510,15 +441,6 @@ activityCounts :: Lens' Robot ActivityCounts
 
 -- | Is the robot currently running an atomic block?
 runningAtomic :: Lens' Robot Bool
-
--- | Properties of a robot used to determine whether an entity is walkable
-data WalkabilityContext
-  = WalkabilityContext
-      (Set Capability)
-      -- | which entities are unwalkable by this robot
-      (Set EntityName)
-  deriving (Show, Eq, Generic, Ae.ToJSON)
-
 walkabilityContext :: Getter Robot WalkabilityContext
 walkabilityContext = to $
   \x -> WalkabilityContext (_robotCapabilities x) (_unwalkableEntities x)
@@ -540,7 +462,7 @@ mkRobot ::
   -- | Robot display.
   Display ->
   -- | Initial CESK machine.
-  CESK ->
+  C.CESK ->
   -- | Equipped devices.
   [Entity] ->
   -- | Initial inventory.
@@ -611,8 +533,8 @@ instance FromJSONE EntityMap TRobot where
       <*> liftE (v .:? "unwalkable" ..!= mempty)
       <*> pure 0
    where
-    mkMachine Nothing = Out VUnit emptyStore []
-    mkMachine (Just pt) = initMachine pt mempty emptyStore
+    mkMachine Nothing = C.Out VUnit C.emptyStore []
+    mkMachine (Just pt) = C.initMachine pt mempty C.emptyStore
 
 (.=?) :: (Ae.KeyValue a, Ae.ToJSON v, Eq v) => Ae.Key -> v -> v -> Maybe a
 (.=?) n v defaultVal = if defaultVal /= v then Just $ n Ae..= v else Nothing
@@ -648,31 +570,3 @@ instance Ae.ToJSON Robot where
         ]
    where
     sys = r ^. systemRobot
-
--- | Is the robot actively in the middle of a computation?
-isActive :: Robot -> Bool
-{-# INLINE isActive #-}
-isActive = isNothing . getResult
-
--- | "Active" robots include robots that are waiting; 'wantsToStep' is
---   true if the robot actually wants to take another step right now
---   (this is a /subset/ of active robots).
-wantsToStep :: TickNumber -> Robot -> Bool
-wantsToStep now robot
-  | not (isActive robot) = False
-  | otherwise = maybe True (now >=) (waitingUntil robot)
-
--- | The time until which the robot is waiting, if any.
-waitingUntil :: Robot -> Maybe TickNumber
-waitingUntil robot =
-  case _machine robot of
-    Waiting time _ -> Just time
-    _ -> Nothing
-
--- | Get the result of the robot's computation if it is finished.
-getResult :: Robot -> Maybe (Value, Store)
-{-# INLINE getResult #-}
-getResult = finalValue . view machine
-
-hearingDistance :: (Num i) => i
-hearingDistance = 32