add SyntaxWithImports type and thread SrcMap through a bunch more stuff

Author: byorgey

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

@@ -95,7 +95,7 @@ import Swarm.Game.Ingredients (Count)
 import Swarm.Game.Tick
 import Swarm.Game.World (WorldUpdate (..))
 import Swarm.Language.Elaborate (insertSuspend)
-import Swarm.Language.Load (SourceMap)
+import Swarm.Language.Load (SourceMap, SyntaxWithImports (..))
 import Swarm.Language.Requirements.Type (Requirements)
 import Swarm.Language.Syntax
 import Swarm.Language.Types
@@ -326,21 +326,21 @@ cont = lens get set
     Waiting t c -> Waiting t (set c k)
     Suspended v e s _ -> Suspended v e s k
 
--- | Create a brand new CESK machine, with empty environment and
---   store, to evaluate a given term.  We always initialize the
---   machine with a single FExec frame as the continuation; if the
---   given term does not have a command type, we wrap it in @pure@.
-initMachine :: Syntax Elaborated -> CESK
-initMachine t = In (prepareTerm V.emptyEnv t) V.emptyEnv emptyStore [FExec]
+-- | Create a brand new CESK machine to evaluate a given term.  We
+--   always initialize the machine with a single FExec frame as the
+--   continuation; if the given term does not have a command type, we
+--   wrap it in @pure@.
+initMachine :: SyntaxWithImports Elaborated -> CESK
+initMachine (SyntaxWithImports srcMap t) = In (prepareTerm V.emptyEnv t) (V.envFromSrcMap srcMap) emptyStore [FExec]
 
 -- | Load a program into an existing robot CESK machine: either
 --   continue from a suspended state, or, as a fallback, start from
 --   scratch with an empty environment but the same store.
 --
 --   Also insert a @suspend@ primitive at the end, so the resulting
 --   term is suitable for execution by the base (REPL) robot.
-continue :: SourceMap Elaborated -> Syntax Elaborated -> CESK -> CESK
-continue srcMap t = \case
+continue :: SyntaxWithImports Elaborated -> CESK -> CESK
+continue (SyntaxWithImports srcMap t) = \case
   -- The normal case is when we are continuing from a suspended state. We:
   --
   --   (1) insert a suspend call at the end of the term, so that in

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

@@ -43,8 +43,9 @@ import Swarm.Game.Robot.Activity
 import Swarm.Game.Robot.Walk (emptyExceptions)
 import Swarm.Game.Tick
 import Swarm.Game.Universe
+import Swarm.Language.Load (SyntaxWithImports)
 import Swarm.Language.Pipeline.QQ (tmQ)
-import Swarm.Language.Syntax (Phase (..), Syntax)
+import Swarm.Language.Syntax (Phase (..))
 import Swarm.Language.Value as V
 import Swarm.Log
 
@@ -112,7 +113,7 @@ instance ToSample (Robot Instantiated) where
           emptyExceptions
           0
 
-mkMachine :: Maybe (Syntax Elaborated) -> C.CESK
+mkMachine :: Maybe (SyntaxWithImports Elaborated) -> C.CESK
 mkMachine Nothing = C.Out VUnit C.emptyStore []
 mkMachine (Just t) = C.initMachine t
 

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

@@ -130,6 +130,7 @@ import Swarm.Game.Tick (addTicks)
 import Swarm.Game.Universe as U
 import Swarm.Game.World qualified as W
 import Swarm.Game.World.Coords
+import Swarm.Language.Load (SyntaxWithImports (..))
 import Swarm.Language.Pipeline (processSource, requireNonEmptyTerm)
 import Swarm.Language.Syntax (Phase (..), SrcLoc (..), Syntax, sLoc)
 import Swarm.Language.Value (Env)
@@ -149,7 +150,7 @@ data SolutionSource
 
 data CodeToRun = CodeToRun
   { _toRunSource :: SolutionSource
-  , _toRunSyntax :: Syntax Elaborated
+  , _toRunSyntax :: SyntaxWithImports Elaborated
   }
 
 makeLenses ''CodeToRun
@@ -166,8 +167,8 @@ parseCodeFile ::
 parseCodeFile filepath = do
   contents <- sendIO $ TIO.readFile filepath
   mpt <- sendIO . runError $ requireNonEmptyTerm =<< processSource contents Nothing
-  pt <- either (throwError @SystemFailure) (pure . snd) mpt -- XXX need SourceMap?
-  let srcLoc = pt ^. sLoc
+  pt <- either (throwError @SystemFailure) pure mpt
+  let srcLoc = getSyntax pt ^. sLoc
       strippedText = stripSrc srcLoc contents
       programBytestring = TL.encodeUtf8 $ TL.fromStrict strippedText
       sha1Hash = showDigest $ sha1 programBytestring
@@ -204,7 +205,7 @@ data GameState = GameState
   { _creativeMode :: Bool
   , _temporal :: TemporalState
   , _winCondition :: WinCondition Elaborated
-  , _winSolution :: Maybe (Syntax Elaborated)
+  , _winSolution :: Maybe (SyntaxWithImports Elaborated)
   , _robotInfo :: Robots
   , _pathCaching :: PathCaching
   , _discovery :: Discovery
@@ -236,7 +237,7 @@ winCondition :: Lens' GameState (WinCondition Elaborated)
 
 -- | How to win (if possible). This is useful for automated testing
 --   and to show help to cheaters (or testers).
-winSolution :: Lens' GameState (Maybe (Syntax Elaborated))
+winSolution :: Lens' GameState (Maybe (SyntaxWithImports Elaborated))
 
 -- | Get a list of all the robots at a particular location.
 robotsAtLocation :: Cosmic Location -> GameState -> [Robot Instantiated]

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

@@ -113,6 +113,7 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFound
 import Swarm.Game.State.Config
 import Swarm.Game.Tick (TickNumber (..))
 import Swarm.Game.World.Gen (Seed)
+import Swarm.Language.Load (ModuleCtx, ModuleImports, SyntaxWithImports)
 import Swarm.Language.Syntax (Anchor, Const, ImportPhaseFor, Phase (..), SwarmType, Syntax, Unresolvable)
 import Swarm.Language.Types (Polytype)
 import Swarm.Language.Value (Value)
@@ -160,7 +161,7 @@ data WinCondition phase
   deriving (Generic)
 
 deriving instance FromJSON (WinCondition Raw)
-deriving instance (PrettyPrec (Anchor (ImportPhaseFor phase)), Unresolvable (ImportPhaseFor phase), Generic (Anchor (ImportPhaseFor phase)), ToJSON (Anchor (ImportPhaseFor phase)), ToJSON (SwarmType phase)) => ToJSON (WinCondition phase)
+deriving instance (PrettyPrec (Anchor (ImportPhaseFor phase)), Unresolvable (ImportPhaseFor phase), Generic (Anchor (ImportPhaseFor phase)), ToJSON (Anchor (ImportPhaseFor phase)), ToJSON (SwarmType phase), ToJSON (ModuleCtx phase), ToJSON (ModuleImports phase)) => ToJSON (WinCondition phase)
 
 makePrisms ''WinCondition
 
@@ -318,7 +319,7 @@ data GameControls = GameControls
   , _replNextValueIndex :: Integer
   , _replListener :: Text -> IO ()
   , _inputHandler :: Maybe (Text, Value)
-  , _initiallyRunCode :: Maybe (Syntax Elaborated)
+  , _initiallyRunCode :: Maybe (SyntaxWithImports Elaborated)
   }
 
 makeLensesNoSigs ''GameControls
@@ -338,7 +339,7 @@ inputHandler :: Lens' GameControls (Maybe (Text, Value))
 
 -- | Code that is run upon scenario start, before any
 -- REPL interaction.
-initiallyRunCode :: Lens' GameControls (Maybe (Syntax Elaborated))
+initiallyRunCode :: Lens' GameControls (Maybe (SyntaxWithImports Elaborated))
 
 data Discovery = Discovery
   { _allDiscoveredEntities :: Inventory

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

@@ -80,7 +80,7 @@ import Swarm.Game.Step.Util
 import Swarm.Game.Step.Util.Command
 import Swarm.Game.Tick
 import Swarm.Language.Capability
-import Swarm.Language.Load (moduleTerm)
+import Swarm.Language.Load (SyntaxWithImports, moduleTerm)
 import Swarm.Language.Requirements qualified as R
 import Swarm.Language.Syntax
 import Swarm.Language.TDVar (tdVarName)
@@ -449,7 +449,7 @@ evalT ::
   , Has (State GameState) sig m
   , Has (Lift IO) sig m
   ) =>
-  Syntax Elaborated ->
+  SyntaxWithImports Elaborated ->
   m Value
 evalT = evaluateCESK . initMachine
 

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

@@ -39,6 +39,7 @@ import Swarm.Game.Step.RobotStepState
 import Swarm.Game.Step.Util
 import Swarm.Game.Step.Util.Inspect
 import Swarm.Game.Universe
+import Swarm.Language.Load (SyntaxWithImports)
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Syntax
 import Swarm.Language.Syntax.Direction (Direction)
@@ -142,7 +143,7 @@ addCombustionBot inputEntity combustibility ts loc = do
 -- 3. Spawn more robots whose sole purpose is to observe for changes to neighbor
 --    cells. This would avoid polluting the logic of the currently burning cell
 --    with logic to manage probabilities of combustion propagation.
-combustionProgram :: Integer -> Combustibility -> Syntax Elaborated
+combustionProgram :: Integer -> Combustibility -> SyntaxWithImports Elaborated
 combustionProgram _combustionDuration (Combustibility _ _ _ maybeCombustionProduct) =
   [tmQ|
     wait $int:_combustionDuration;
@@ -227,7 +228,7 @@ addIgnitionBot ignitionDelay inputEntity ts loc =
       ts
 
 -- Triggers the ignition of the entity underfoot with some delay.
-ignitionProgram :: Integer -> Syntax Elaborated
+ignitionProgram :: Integer -> SyntaxWithImports Elaborated
 ignitionProgram _waitTime =
   [tmQ|
     wait $int:_waitTime;

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

@@ -1237,10 +1237,10 @@ execConst runChildProg c vs s k = do
 
         case mt of
           Nothing -> return $ mkReturn ()
-          Just (_, t) -> do
+          Just t -> do
             void $ traceLog CmdStatus Info "run: OK."
             cesk <- use machine
-            return $ continue M.empty t cesk
+            return $ continue t cesk
       _ -> badConst
     Not -> case vs of
       [VBool b] -> return $ Out (VBool (not b)) s k

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

@@ -58,6 +58,7 @@ import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.Game.World.Coords
 import Swarm.Language.Capability
+import Swarm.Language.Load (SyntaxWithImports)
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Requirements.Type qualified as R
 import Swarm.Language.Syntax
@@ -519,7 +520,7 @@ seedProgram ::
   Integer ->
   -- | entity to place
   EntityName ->
-  Syntax Elaborated
+  SyntaxWithImports Elaborated
 seedProgram _minTime _randTime _seedlingCount _seedlingRadius _thing =
   [tmQ|
     def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
@@ -589,7 +590,7 @@ addAsphyxiateBot ts loc =
 --   we detect that the base has the life support system re-equipped,
 --   stop the countdown and self-destruct.  Otherwise, at the end of
 --   the countdown, destroy the base.
-asphyxiateProg :: Syntax Elaborated
+asphyxiateProg :: SyntaxWithImports Elaborated
 asphyxiateProg =
   [tmQ|
     def countdown : Int -> Cmd Unit = \n.

src/swarm-lang/Swarm/Language/JSON.hs

@@ -11,8 +11,9 @@
 module Swarm.Language.JSON where
 
 import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON, withText)
+import Data.Map qualified as M
 import GHC.Generics (Generic)
-import Swarm.Language.Load (Module, ModuleCtx, ModuleImports)
+import Swarm.Language.Load (Module, ModuleCtx, ModuleImports, SyntaxWithImports (..))
 import Swarm.Language.Parser (readNonemptyTerm)
 import Swarm.Language.Syntax (Anchor, ImportPhaseFor, Phase (Raw), SwarmType, Syntax, Term)
 import Swarm.Language.Value (Env, Value (..))
@@ -33,6 +34,12 @@ instance (Generic (Anchor (ImportPhaseFor phase)), ToJSON (Anchor (ImportPhaseFo
 
 deriving instance (Generic (Anchor (ImportPhaseFor phase)), ToJSON (Anchor (ImportPhaseFor phase)), ToJSON (SwarmType phase), ToJSON (ModuleCtx phase), ToJSON (ModuleImports phase)) => ToJSON (Module phase)
 
+instance FromJSON (SyntaxWithImports Raw) where
+  parseJSON v = SyntaxWithImports M.empty <$> parseJSON @(Syntax Raw) v
+
+instance (Generic (Anchor (ImportPhaseFor phase)), ToJSON (Anchor (ImportPhaseFor phase)), ToJSON (SwarmType phase), ToJSON (ModuleCtx phase), ToJSON (ModuleImports phase)) => ToJSON (SyntaxWithImports phase) where
+  toJSON = genericToJSON optionsMinimize . getSyntax
+
 instance ToJSON Value where
   toJSON = genericToJSON optionsMinimize
 

src/swarm-lang/Swarm/Language/LSP.hs

@@ -22,6 +22,7 @@ import Language.LSP.Protocol.Types qualified as LSP
 import Language.LSP.Server
 import Language.LSP.VFS (VirtualFile (..), virtualFileText)
 import Swarm.Failure (SystemFailure (..))
+import Swarm.Language.Load (SyntaxWithImports (..))
 import Swarm.Language.LSP.Hover qualified as H
 import Swarm.Language.LSP.VarUsage qualified as VU
 import Swarm.Language.Parser.Util (getLocRange)
@@ -84,7 +85,7 @@ validateSwarmCode doc version content = do
   res <- liftIO . runError $ processSource content Nothing
   let (errors, warnings) = case res of
         Right Nothing -> ([], [])
-        Right (Just (_, term)) -> ([], unusedWarnings)
+        Right (Just (SyntaxWithImports _ term)) -> ([], unusedWarnings)
          where
           VU.Usage _ problems = VU.getUsage mempty (eraseRaw term)
           unusedWarnings = mapMaybe (VU.toErrPos content) problems