Import

.hlint.yaml

@@ -45,6 +45,7 @@
       , TestLanguagePipeline
       ]
     }
+  - {name: Unsafe.Coerce.unsafeCoerce, within: [Swarm.Language.Elaborate.elaborate]}
 
 # Add custom hints for this project
 #

app/game/Swarm/App.hs

@@ -24,8 +24,8 @@ module Swarm.App (
 
 import Brick
 import Brick.BChan
+import Control.Carrier.Error.Either (runError)
 import Control.Carrier.Lift (runM)
-import Control.Carrier.Throw.Either (runThrow)
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (bracket, try)
 import Control.Lens (Setter', view, (%~), (?~), (^.))
@@ -75,7 +75,7 @@ app eventHandler =
 appMain :: AppOpts -> IO ()
 appMain opts = do
   chan <- createChannel
-  res <- runM . runThrow $ initAppState opts (Just chan)
+  res <- runM . runError $ initAppState opts (Just chan)
   case res of
     Left err -> do
       T.hPutStrLn stderr (prettyText @SystemFailure err)
@@ -120,7 +120,7 @@ demoWeb = do
   let demoPort = 8080
   chan <- createChannel
   res <-
-    runM . runThrow $ initAppState (defaultAppOpts {userScenario = demoScenario}) (Just chan)
+    runM . runError $ initAppState (defaultAppOpts {userScenario = demoScenario}) (Just chan)
   case res of
     Left err -> T.putStrLn (prettyText @SystemFailure err)
     Right s -> do

data/scenarios/Tutorials/move.yaml

@@ -142,32 +142,29 @@ robots:
   #################
   - name: check
     system: true
-    program: instant {run "scenarios/Tutorials/move_check.sw"}
+    program: instant {import "scenarios/Tutorials/move_check.sw"; main}
   #################
   ## WALLS       ##
   #################
   - name: 1P wall
     system: true
     program: |
-      def main = \a. pure noop end
       instant {
-        run "scenarios/Tutorials/move_surveil.sw";
+        import "scenarios/Tutorials/move_surveil.sw";
         main [entity="wall", room=1]
       }
   - name: 2P wall
     system: true
     program: |
-      def main = \a. noop end
       instant {
-        run "scenarios/Tutorials/move_surveil.sw";
+        import "scenarios/Tutorials/move_surveil.sw";
         main [entity="wall", room=2]
       }
   - name: 3P wall
     system: true
     program: |
-      def main = \a. noop end
       instant {
-        run "scenarios/Tutorials/move_surveil.sw";
+        import "scenarios/Tutorials/move_surveil.sw";
         main [entity="wall", room=3]
       }
   #################
@@ -176,25 +173,22 @@ robots:
   - name: 1P flower
     system: true
     program: |
-      def main = \a. noop end
       instant {
-        run "scenarios/Tutorials/move_surveil.sw";
+        import "scenarios/Tutorials/move_surveil.sw";
         main [entity="flower", room=1]
       }
   - name: 2P flower
     system: true
     program: |
-      def main = \a. noop end
       instant {
-        run "scenarios/Tutorials/move_surveil.sw";
+        import "scenarios/Tutorials/move_surveil.sw";
         main [entity="flower", room=2]
       }
   - name: 3P flower
     system: true
     program: |
-      def main = \a. noop end
       instant {
-        run "scenarios/Tutorials/move_surveil.sw";
+        import "scenarios/Tutorials/move_surveil.sw";
         main [entity="flower", room=3]
       }
 entities:

data/scenarios/Tutorials/move_check.sw

@@ -55,5 +55,3 @@ def main =
    room2;
    room3;
 end
-
-main

data/test/import/a.sw

@@ -0,0 +1 @@
+def a : Int = 3 end

data/test/import/b.sw

@@ -0,0 +1,3 @@
+import "c"
+
+def b : Int = 1 end

data/test/import/c.sw

@@ -0,0 +1 @@
+def c : Int = 7 end

data/test/import/d.sw

@@ -0,0 +1,3 @@
+import "e"
+
+def d : Int = e * 5 end

data/test/import/e.sw

@@ -0,0 +1 @@
+def e : Int = 9 end

data/test/import/f.sw

@@ -0,0 +1,3 @@
+import "g"
+
+def f : Int = g + 7 end

data/test/import/g.sw

@@ -0,0 +1 @@
+def g : Int = 9 end

src/swarm-doc/Swarm/Doc/Pedagogy.hs

@@ -20,6 +20,7 @@ module Swarm.Doc.Pedagogy (
 
 import Control.Lens (universe, view, (^.))
 import Control.Monad (guard)
+import Data.Data (Data, Typeable)
 import Data.Foldable (Foldable (..))
 import Data.List (intercalate, sort, sortOn)
 import Data.List.Extra (zipFrom)
@@ -55,9 +56,9 @@ import Swarm.Game.ScenarioInfo (
   scenarioCollectionToList,
  )
 import Swarm.Game.World.DSL (loadWorlds)
+import Swarm.Language.Load (getSyntax)
 import Swarm.Language.Syntax
 import Swarm.Language.Text.Markdown (docToText, findCode)
-import Swarm.Language.Types (Polytype)
 import Swarm.Util.Effect (ignoreWarnings)
 import Prelude hiding (Foldable (..))
 
@@ -100,19 +101,27 @@ extractCommandUsages :: Int -> ScenarioWith ScenarioPath -> TutorialInfo
 extractCommandUsages idx siPair@(ScenarioWith s _si) =
   TutorialInfo siPair idx solnCommands $ getDescCommands s
  where
-  solnCommands = getCommands maybeSoln
+  solnCommands = getCommands . fmap getSyntax $ maybeSoln
   maybeSoln = view (scenarioOperation . scenarioSolution) s
 
 -- | Obtain the set of all commands mentioned by
 -- name in the tutorial's goal descriptions.
-getDescCommands :: Scenario -> Set Const
+getDescCommands ::
+  forall phase.
+  ( Data (Anchor (ImportPhaseFor phase))
+  , Data (SwarmType phase)
+  , Typeable phase
+  , Typeable (ImportPhaseFor phase)
+  ) =>
+  Scenario phase ->
+  Set Const
 getDescCommands s = S.fromList $ concatMap filterConst allCode
  where
   goalTextParagraphs = view objectiveGoal <$> view (scenarioOperation . scenarioObjectives) s
   allCode = concatMap findCode goalTextParagraphs
-  filterConst :: Syntax -> [Const]
+  filterConst :: Syntax phase -> [Const]
   filterConst sx = mapMaybe toConst $ universe (sx ^. sTerm)
-  toConst :: Term -> Maybe Const
+  toConst :: Term phase -> Maybe Const
   toConst = \case
     TConst c -> Just c
     _ -> Nothing
@@ -129,14 +138,21 @@ isConsidered c = isUserFunc c && c `S.notMember` ignoredCommands
 -- the player did not write it explicitly in their code.
 --
 -- Also, the code from `run` is not parsed transitively yet.
-getCommands :: Maybe TSyntax -> Map Const [SrcLoc]
+getCommands ::
+  forall phase.
+  ( Data (Anchor (ImportPhaseFor phase))
+  , Data (SwarmType phase)
+  , Typeable phase
+  , Typeable (ImportPhaseFor phase)
+  ) =>
+  Maybe (Syntax phase) ->
+  Map Const [SrcLoc]
 getCommands Nothing = mempty
 getCommands (Just tsyn) =
   M.fromListWith (<>) $ mapMaybe isCommand nodelist
  where
-  nodelist :: [Syntax' Polytype]
   nodelist = universe tsyn
-  isCommand (Syntax' sloc t _ _) = case t of
+  isCommand (Syntax sloc t _ _) = case t of
     TConst c -> guard (isConsidered c) >> Just (c, [sloc])
     _ -> Nothing
 
@@ -208,7 +224,7 @@ renderUsagesMarkdown (CoverageInfo (TutorialInfo (ScenarioWith s (ScenarioPath s
       , renderTutorialTitle idx s
       ]
 
-renderTutorialTitle :: (Show a) => a -> Scenario -> Text
+renderTutorialTitle :: (Show a) => a -> Scenario Elaborated -> Text
 renderTutorialTitle idx s =
   T.unwords
     [ T.pack $ show idx <> ":"

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

@@ -73,6 +73,7 @@ module Swarm.Game.CESK (
   continue,
   cancel,
   prepareTerm,
+  insertSuspend,
 
   -- ** Extracting information
   finalValue,
@@ -81,10 +82,11 @@ module Swarm.Game.CESK (
   cont,
 ) where
 
-import Control.Lens (Lens', Traversal', lens, traversal, (^.))
+import Control.Lens (Lens', Traversal', lens, traversal, (%~), (&), (.~), (^.))
 import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON)
 import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IM
+import Data.Map qualified as M
 import GHC.Generics (Generic)
 import Prettyprinter (Doc, Pretty (..), encloseSep, hsep, (<+>))
 import Swarm.Game.Entity (Entity)
@@ -93,6 +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 (SyntaxWithImports (..))
 import Swarm.Language.Requirements.Type (Requirements)
 import Swarm.Language.Syntax
 import Swarm.Language.Types
@@ -111,7 +114,7 @@ data Frame
   = -- | We were evaluating the first component of a pair; next, we
     --   should evaluate the second component which was saved in this
     --   frame (and push a 'FFst' frame on the stack to save the first component).
-    FSnd Term Env
+    FSnd (Term Resolved) Env
   | -- | We were evaluating the second component of a pair; when done,
     --   we should combine it with the value of the first component saved
     --   in this frame to construct a fully evaluated pair.
@@ -121,7 +124,7 @@ data Frame
     -- term @t@ (the right-hand side, /i.e./ argument of the
     -- application) in environment @e@.  We will also push an 'FApp'
     -- frame on the stack.
-    FArg Term Env
+    FArg (Term Resolved) Env
   | -- | @FVArg v@ says that we were evaluating the left-hand side of
     --   an application, and the next thing we should do is apply it
     --   to the given value.  This does not normally occur as part of
@@ -138,7 +141,7 @@ data Frame
     -- is, we were evaluating the definition of @x@; the next thing we
     -- should do is evaluate @t2@ in the environment @e@ extended with
     -- a binding for @x@.
-    FLet Var (Maybe (Polytype, Requirements)) Term Env
+    FLet Var (Maybe (Polytype, Requirements)) (Term Resolved) Env
   | -- | We are executing inside a 'Try' block.  If an exception is
     --   raised, we will execute the stored term (the "catch" block).
     FTry Value
@@ -149,7 +152,10 @@ data Frame
     --   bind; once done, we should also execute the second component
     --   in the given environment (extended by binding the variable,
     --   if there is one, to the output of the first command).
-    FBind (Maybe Var) (Maybe (Polytype, Requirements)) Term Env
+    FBind (Maybe Var) (Maybe (Polytype, Requirements)) (Term Resolved) Env
+  | -- | We are in the process of evaluating an import; once done, we
+    --   should proceed to evaluate the given body.
+    FImport (Term Resolved)
   | -- | Apply specific updates to the world and current robot.
     --
     -- The 'Const' is used to track the original command for error messages.
@@ -161,7 +167,7 @@ data Frame
   | -- | We are in the middle of evaluating a record: some fields have
     --   already been evaluated; we are focusing on evaluating one
     --   field; and some fields have yet to be evaluated.
-    FRcd Env [(Var, Value)] Var [(Var, Maybe Term)]
+    FRcd Env [(Var, Value)] Var [(Var, Maybe (Term Resolved))]
   | -- | We are in the middle of evaluating a record field projection.
     FProj Var
   | -- | We should suspend with the given environment once we finish
@@ -239,7 +245,7 @@ data CESK
     --   currently focused term to evaluate in the environment, a store,
     --   and a continuation.  In this mode we generally pattern-match on the
     --   'Term' to decide what to do next.
-    In Term Env Store Cont
+    In (Term Resolved) Env Store Cont
   | -- | Once we finish evaluating a term, we end up with a 'Value'
     --   and we switch into "out" mode, bringing the value back up
     --   out of the depths to the context that was expecting it.  In
@@ -323,21 +329,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 :: TSyntax -> 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 :: TSyntax -> CESK -> CESK
-continue 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
@@ -351,24 +357,28 @@ continue t = \case
   --   environment e (any names brought into scope by executing the
   --   term will be discarded).  If the term succeeds, the extra
   --   FRestoreEnv frame will be discarded.
-  Suspended _ e s k -> In (insertSuspend $ prepareTerm e t) e s (FExec : FRestoreEnv e : k)
+  Suspended _ e s k ->
+    let e' = e & envSourceMap %~ M.union srcMap
+     in In (insertSuspend $ prepareTerm e' t) e' s (FExec : FRestoreEnv e : k)
   -- In any other state, just start with an empty environment.  This
   -- happens e.g. when running a program on the base robot for the
   -- very first time.
-  cesk -> In (insertSuspend $ prepareTerm V.emptyEnv t) V.emptyEnv (cesk ^. store) (FExec : (cesk ^. cont))
+  cesk ->
+    let e = V.emptyEnv & envSourceMap .~ srcMap
+     in In (insertSuspend $ prepareTerm e t) e (cesk ^. store) (FExec : (cesk ^. cont))
 
 -- | Prepare a term for evaluation by a CESK machine in the given
 --   environment: erase all type annotations, and optionally wrap it
 --   in @pure@ if it does not have a command type.  Note that since
 --   the environment might contain type aliases, we have to be careful
 --   to expand them before concluding whether the term has a command
 --   type or not.
-prepareTerm :: Env -> TSyntax -> Term
+prepareTerm :: Env -> Syntax Elaborated -> Term Resolved
 prepareTerm e t = case whnfType (e ^. envTydefs) (ptBody (t ^. sType)) of
   TyCmd _ -> t'
   _ -> TApp (TConst Pure) t'
  where
-  t' = eraseS t
+  t' = erase t ^. sTerm
 
 -- | Cancel the currently running computation.
 cancel :: CESK -> CESK
@@ -418,6 +428,7 @@ prettyFrame f (p, inner) = case f of
   FExec -> prettyPrefix "E·" (p, inner)
   FBind Nothing _ t _ -> (0, pparens (p < 1) inner <+> ";" <+> ppr t)
   FBind (Just x) _ t _ -> (0, hsep [ppr x, "<-", pparens (p < 1) inner, ";", ppr t])
+  FImport t -> (11, hsep ["import", inner, "in", ppr t])
   FImmediate c _worldUpds _robotUpds -> prettyPrefix ("I[" <> ppr c <> "]·") (p, inner)
   FUpdate {} -> (p, inner)
   FFinishAtomic -> prettyPrefix "A·" (p, inner)