get basic imports working with envSourceMap

Author: byorgey

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 (SourceMap)
 import Swarm.Language.Requirements.Type (Requirements)
 import Swarm.Language.Syntax
 import Swarm.Language.Types
@@ -336,8 +339,8 @@ initMachine t = In (prepareTerm V.emptyEnv t) V.emptyEnv emptyStore [FExec]
 --
 --   Also insert a @suspend@ primitive at the end, so the resulting
 --   term is suitable for execution by the base (REPL) robot.
-continue :: Syntax Elaborated -> CESK -> CESK
-continue t = \case
+continue :: SourceMap Elaborated -> Syntax Elaborated -> CESK -> CESK
+continue 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,11 +354,15 @@ 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

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

@@ -78,6 +78,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.Requirements qualified as R
 import Swarm.Language.Syntax
 import Swarm.Language.TDVar (tdVarName)
@@ -91,7 +92,7 @@ import System.Clock (TimeSpec)
 import System.Metrics.Counter qualified as Counter
 import System.Metrics.Distribution qualified as Distribution
 import System.Metrics.Gauge qualified as Gauge
-import Witch (From (from))
+import Witch (From (from), into)
 import Prelude hiding (lookup)
 
 -- | GameState with support for IO and Time effect
@@ -712,10 +713,15 @@ stepCESK cesk = case cesk of
   -- If we see a primitive application of suspend, package it up as
   -- a value until it's time to execute.
   In (TSuspend t) e s k -> return $ Out (VSuspend t e) s k
-  -- XXX keep a map from imports to corresponding Env, don't re-evaluate if it's already
-  -- in the map.  To make this sound, need to disallow all but defs in an import.
-  -- XXX Evaluate the code corresponding to an import.
-  In (TImportIn loc t) e s k -> return $ In t e s k
+  -- Evaluate the code corresponding to an import.
+  In (TImportIn loc t) e s k -> do
+    return $ case M.lookup loc (e ^. envSourceMap) of
+      Nothing -> Up (Fatal (T.append "Import not found: " (into @Text (locToFilePath loc)))) s k
+      Just mmod -> case moduleTerm mmod of
+        Nothing -> In t e s k
+        Just m -> In (insertSuspend $ erase m ^. sTerm) e s (FExec : FBind Nothing Nothing t e : k)
+        -- XXX keep a map from imports to corresponding Env, don't re-evaluate if it's already
+        -- in the map.  To make this sound, need to disallow all but defs in an import.
   -- Ignore explicit parens.
   In (TParens t) e s k -> return $ In t e s k
   ------------------------------------------------------------
@@ -815,12 +821,12 @@ stepCESK cesk = case cesk of
   --
   -- x; z <- y; q; r
   --
-  Suspended _ e s (FBind Nothing _ t2 _ : k) -> return $ In t2 e s (FExec : k)
+  Suspended _ e s (FBind Nothing _ t2 _ : k) -> return $ In t2 e s k
   Suspended v e s (FBind (Just x) mtr t2 _ : k) -> do
     let e' = case mtr of
           Nothing -> addValueBinding x v e
           Just (ty, reqs) -> addBinding x (WithType v ty reqs) e
-    return $ In t2 e' s (FExec : k)
+    return $ In t2 e' s k
   -- Otherwise, if we're suspended with nothing else left to do,
   -- return the machine unchanged (but throw away the rest of the
   -- continuation stack).

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

@@ -75,11 +75,12 @@ insertSuspend t = case t of
   TRequire {} -> thenSuspend
   TStock {} -> thenSuspend
   TRequirements {} -> thenSuspend
-  -- Recurse through def, tydef, bind, and annotate.
+  -- Recurse through def, tydef, bind, annotate, and import.
   TLet ls r x mty mpty mreq t1 t2 -> TLet ls r x mty mpty mreq t1 (insertSuspend t2)
   TTydef x pty mtd t1 -> TTydef x pty mtd (insertSuspend t1)
   TBind mx mty mreq c1 c2 -> TBind mx mty mreq c1 (insertSuspend c2)
   TAnnotate t1 ty -> TAnnotate (insertSuspend t1) ty
+  TImportIn loc t1 -> TImportIn loc (insertSuspend t1)
   -- Replace pure or noop with suspend
   TApp (TConst Pure) t1 -> TSuspend t1
   TConst Noop -> TSuspend TUnit

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

@@ -22,7 +22,6 @@ import Control.Effect.State (State, get, modify)
 import Control.Effect.Throw (Throw, throwError)
 import Control.Lens ((.~))
 import Control.Monad (forM_)
-import Data.Aeson (ToJSON)
 import Data.Data (Data, Typeable)
 import Data.Function ((&))
 import Data.Hashable (Hashable)
@@ -78,6 +77,7 @@ data Module phase = Module
   }
   deriving (Generic)
 
+deriving instance (Show (Anchor (ImportPhaseFor phase)), Show (SwarmType phase), Show (ModuleCtx phase), Show (ModuleImports phase)) => Show (Module phase)
 deriving instance (Eq (ModuleImports phase), Eq (ModuleCtx phase), Eq (SwarmType phase), Eq (Anchor (ImportPhaseFor phase))) => Eq (Module phase)
 deriving instance (Eq (Anchor (ImportPhaseFor phase)), Data (Anchor (ImportPhaseFor phase)), Typeable phase, Typeable (ImportPhaseFor phase), Data (ModuleCtx phase), Data (ModuleImports phase), Data (SwarmType phase)) => Data (Module phase)
 deriving instance (Hashable (ModuleImports phase), Hashable (ModuleCtx phase), Hashable (SwarmType phase), Hashable (Anchor (ImportPhaseFor phase)), Generic (Anchor (ImportPhaseFor phase))) => Hashable (Module phase)
@@ -168,7 +168,7 @@ resolveImport parent loc = do
       -- Finally, record the loaded module in the SourceMap.
       modify @(SourceMap Resolved) (M.insert canonicalLoc $ Module mt' () imps)
 
-      -- XXX make sure imports contain ONLY defs?
+      -- XXX make sure imports contain ONLY defs + more imports?
       -- Otherwise we can't cache their values---we would have to
       -- re-execute them every time they are imported.
 

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

@@ -163,7 +163,6 @@ extractReqCtx (Syntax _ t _ _) = extractReqCtxTerm t
 
 class Processable t where
   process :: (Has (Lift IO) sig m, Has (Error SystemFailure) sig m) => t Raw -> m (t Elaborated)
-  -- XXX should m include effects to save resulting SrcMap ??
 
 instance Processable Syntax where
   process s = do

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

@@ -1117,8 +1117,8 @@ collectDefs ::
   (Has Unification sig m, Has (Reader UCtx) sig m) =>
   Syntax Inferred ->
   m UCtx
-collectDefs (Syntax _ (SLet LSDef _ x _ _ _ _ t) _ ty) = do
-  ty' <- generalize ty
+collectDefs (Syntax _ (SLet LSDef _ x _ _ _ body t) _ _) = do
+  ty' <- generalize (body ^. sType)
   (Ctx.singleton (lvVar x) ty' <>) <$> collectDefs t
 collectDefs _ = pure Ctx.empty
 

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

@@ -270,12 +270,12 @@ runBaseTerm = mapM_ startBaseProgram
   -- The player typed something at the REPL and hit Enter; this
   -- function takes the resulting term (if the REPL
   -- input is valid) and sets up the base robot to run it.
-  startBaseProgram (srcMap, t) = do   -- XXX use srcMap!
+  startBaseProgram (srcMap, t) = do
     -- Set the REPL status to Working
     gameState . gameControls . replStatus .= REPLWorking (t ^. sType) Nothing
     -- Set up the robot's CESK machine to evaluate/execute the
     -- given term.
-    gameState . baseRobot . machine %= continue t
+    gameState . baseRobot . machine %= continue srcMap t
     -- Finally, be sure to activate the base robot.
     gameState %= execState (zoomRobots $ activateRobot 0)