expose the last evaluated result as it in REPL (#734)

Co-authored-by: Restyled.io <commits@restyled.io>
Co-authored-by: Brent Yorgey <byorgey@gmail.com>

src/Swarm/Game/Robot.hs

@@ -41,6 +41,7 @@ module Swarm.Game.Robot (
   defReqs,
   defVals,
   defStore,
+  emptyRobotContext,
 
   -- ** Lenses
   robotEntity,
@@ -102,6 +103,7 @@ import Swarm.Language.Capability (Capability)
 import Swarm.Language.Context qualified as Ctx
 import Swarm.Language.Requirement (ReqCtx)
 import Swarm.Language.Syntax (toDirection)
+import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Types (TCtx)
 import Swarm.Util ()
 import Swarm.Util.Yaml
@@ -127,6 +129,31 @@ data RobotContext = RobotContext
 
 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
+
 data LogSource = Said | Logged | ErrorTrace
   deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
 
@@ -472,7 +499,7 @@ mkRobot rid pid name descr loc dir disp m devs inv sys heavy ts =
     , _robotLog = Seq.empty
     , _robotLogUpdated = False
     , _robotLocation = loc
-    , _robotContext = RobotContext Ctx.empty Ctx.empty Ctx.empty emptyStore
+    , _robotContext = emptyRobotContext
     , _robotID = rid
     , _robotParentID = pid
     , _robotHeavy = heavy

src/Swarm/Game/State.hs

@@ -38,6 +38,7 @@ module Swarm.Game.State (
   robotsByLocation,
   robotsAtLocation,
   robotsInArea,
+  baseRobot,
   activeRobots,
   waitingRobots,
   availableRecipes,
@@ -61,6 +62,7 @@ module Swarm.Game.State (
   viewCenter,
   needsRedraw,
   replStatus,
+  replNextValueIndex,
   replWorking,
   replActiveType,
   messageQueue,
@@ -153,6 +155,7 @@ import Swarm.Language.Context qualified as Ctx
 import Swarm.Language.Pipeline (ProcessedTerm)
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Syntax (Const, Term (TText), allConst)
+import Swarm.Language.Typed (Typed (Typed))
 import Swarm.Language.Types
 import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
 import System.Clock qualified as Clock
@@ -178,12 +181,12 @@ makePrisms ''ViewCenterRule
 data REPLStatus
   = -- | The REPL is not doing anything actively at the moment.
     --   We persist the last value and its type though.
-    REPLDone (Maybe (Polytype, Value))
+    REPLDone (Maybe (Typed Value))
   | -- | A command entered at the REPL is currently being run.  The
     --   'Polytype' represents the type of the expression that was
     --   entered.  The @Maybe Value@ starts out as @Nothing@ and gets
     --   filled in with a result once the command completes.
-    REPLWorking Polytype (Maybe Value)
+    REPLWorking (Typed (Maybe Value))
   deriving (Eq, Show, Generic, FromJSON, ToJSON)
 
 data WinCondition
@@ -285,6 +288,7 @@ data GameState = GameState
   , _viewCenter :: V2 Int64
   , _needsRedraw :: Bool
   , _replStatus :: REPLStatus
+  , _replNextValueIndex :: Integer
   , _messageQueue :: Seq LogEntry
   , _lastSeenMessageTime :: Integer
   , _focusedRobotID :: RID
@@ -361,6 +365,10 @@ robotsInArea o d gs = map (rm IM.!) rids
   rl = gs ^. robotsByLocation
   rids = concatMap IS.elems $ getElemsInArea o d rl
 
+-- | The base robot, if it exists.
+baseRobot :: Traversal' GameState Robot
+baseRobot = robotMap . ix 0
+
 -- | The list of entities that have been discovered.
 allDiscoveredEntities :: Lens' GameState Inventory
 
@@ -442,6 +450,9 @@ needsRedraw :: Lens' GameState Bool
 -- | The current status of the REPL.
 replStatus :: Lens' GameState REPLStatus
 
+-- | The index of the next it{index} value
+replNextValueIndex :: Lens' GameState Integer
+
 -- | A queue of global messages.
 --
 -- Note that we put the newest entry to the right.
@@ -499,14 +510,14 @@ replWorking :: Getter GameState Bool
 replWorking = to (\s -> matchesWorking $ s ^. replStatus)
  where
   matchesWorking (REPLDone _) = False
-  matchesWorking (REPLWorking _ _) = True
+  matchesWorking (REPLWorking _) = True
 
 -- | Either the type of the command being executed, or of the last command
 replActiveType :: Getter REPLStatus (Maybe Polytype)
 replActiveType = to getter
  where
-  getter (REPLDone (Just (typ, _))) = Just typ
+  getter (REPLDone (Just (Typed _ typ _))) = Just typ
-  getter (REPLWorking typ _) = Just typ
+  getter (REPLWorking (Typed _ typ _)) = Just typ
   getter _ = Nothing
 
 -- | Get the notification list of messages from the point of view of focused robot.
@@ -714,6 +725,7 @@ initGameState = do
       , _viewCenter = V2 0 0
       , _needsRedraw = False
       , _replStatus = REPLDone Nothing
+      , _replNextValueIndex = 0
       , _messageQueue = Empty
       , _lastSeenMessageTime = -1
       , _focusedRobotID = 0
@@ -764,7 +776,8 @@ scenarioToGameState scenario userSeed toRun g = do
         -- otherwise the store of definition cells is not saved (see #333)
         _replStatus = case toRun of
           Nothing -> REPLDone Nothing
-          Just _ -> REPLWorking PolyUnit Nothing
+          Just _ -> REPLWorking (Typed Nothing PolyUnit mempty)
+      , _replNextValueIndex = 0
       , _messageQueue = Empty
       , _focusedRobotID = baseID
       , _ticks = 0

src/Swarm/Game/Step.hs

@@ -65,6 +65,7 @@ import Swarm.Language.Pipeline
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Requirement qualified as R
 import Swarm.Language.Syntax
+import Swarm.Language.Typed (Typed (..))
 import Swarm.Util
 import System.Clock (TimeSpec)
 import System.Clock qualified
@@ -110,10 +111,10 @@ gameTick = do
     Just r -> do
       res <- use replStatus
       case res of
-        REPLWorking ty Nothing -> case getResult r of
+        REPLWorking (Typed Nothing ty req) -> case getResult r of
           Just (v, s) -> do
-            replStatus .= REPLWorking ty (Just v)
+            replStatus .= REPLWorking (Typed (Just v) ty req)
-            robotMap . ix 0 . robotContext . defStore .= s
+            baseRobot . robotContext . defStore .= s
           Nothing -> return ()
         _otherREPLStatus -> return ()
     Nothing -> return ()

src/Swarm/Language/Typed.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Swarm.Language.Typed (Typed (..), value, polytype, requires) where
+
+import Control.Lens (makeLenses)
+import Data.Aeson (ToJSON)
+import Data.Aeson.Types (FromJSON)
+import GHC.Generics (Generic)
+import Swarm.Language.Requirement (Requirements)
+import Swarm.Language.Types (Polytype)
+
+-- | A value, or a hole, or something else that has its type & requirements fixed
+data Typed v = Typed
+  { _value :: v
+  , _polytype :: Polytype
+  , _requires :: Requirements
+  }
+  deriving (Show, Eq, Generic, FromJSON, ToJSON)
+
+makeLenses ''Typed

src/Swarm/TUI/Controller.hs

@@ -57,6 +57,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import Data.String (fromString)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Data.Time (getZonedTime)
@@ -77,6 +78,7 @@ import Swarm.Language.Pipeline
 import Swarm.Language.Pretty
 import Swarm.Language.Requirement qualified as R
 import Swarm.Language.Syntax
+import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Types
 import Swarm.TUI.List
 import Swarm.TUI.Model
@@ -582,16 +584,22 @@ updateUI = do
   -- Now check if the base finished running a program entered at the REPL.
   replUpdated <- case g ^. replStatus of
     -- It did, and the result was the unit value.  Just reset replStatus.
-    REPLWorking _ (Just VUnit) -> do
+    REPLWorking (Typed (Just VUnit) typ reqs) -> do
-      gameState . replStatus .= REPLDone (Just (PolyUnit, VUnit))
+      gameState . replStatus .= REPLDone (Just $ Typed VUnit typ reqs)
       pure True
 
     -- It did, and returned some other value.  Pretty-print the
     -- result as a REPL output, with its type, and reset the replStatus.
-    REPLWorking pty (Just v) -> do
+    REPLWorking (Typed (Just v) pty reqs) -> do
-      let out = T.intercalate " " [into (prettyValue v), ":", prettyText (stripCmd pty)]
+      let finalType = stripCmd pty
+      let val = Typed v finalType reqs
+      itIx <- use (gameState . replNextValueIndex)
+      let itName = fromString $ "it" ++ show itIx
+      let out = T.intercalate " " [itName, ":", prettyText finalType, "=", into (prettyValue v)]
       uiState . uiReplHistory %= addREPLItem (REPLOutput out)
-      gameState . replStatus .= REPLDone (Just (pty, v))
+      gameState . replStatus .= REPLDone (Just val)
+      gameState . baseRobot . robotContext . at itName .= Just val
+      gameState . replNextValueIndex %= (+ 1)
       pure True
 
     -- Otherwise, do nothing.
@@ -677,6 +685,8 @@ loadVisibleRegion = do
       gs <- use gameState
       gameState . world %= W.loadRegion (viewingRegion gs (over both fromIntegral size))
 
+-- | Strips top-level `cmd` from type (in case of REPL evaluation),
+--   and returns a boolean to indicate if it happened
 stripCmd :: Polytype -> Polytype
 stripCmd (Forall xs (TyCmd ty)) = Forall xs ty
 stripCmd pty = pty
@@ -685,30 +695,39 @@ stripCmd pty = pty
 -- REPL events
 ------------------------------------------------------------
 
+-- | Context for the REPL commands to execute in. Contains the base
+--   robot context plus the `it` variable that refer to the previously
+--   computed values. (Note that `it{n}` variables are set in the
+--   base robot context; we only set `it` here because it's so transient)
+topContext :: AppState -> RobotContext
+topContext s = ctxPossiblyWithIt
+ where
+  ctx = fromMaybe emptyRobotContext $ s ^? gameState . baseRobot . robotContext
+
+  ctxPossiblyWithIt = case s ^. gameState . replStatus of
+    REPLDone (Just p) -> ctx & at "it" ?~ p
+    _ -> ctx
+
 -- | Handle a user input event for the REPL.
 handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
 handleREPLEvent = \case
   ControlKey 'c' -> do
-    gameState . robotMap . ix 0 . machine %= cancel
+    gameState . baseRobot . machine %= cancel
     uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt "")
   Key V.KEnter -> do
     s <- get
     let entry = formState (s ^. uiState . uiReplForm)
-        topTypeCtx = s ^. gameState . robotMap . ix 0 . robotContext . defTypes
+        topCtx = topContext s
-        topReqCtx = s ^. gameState . robotMap . ix 0 . robotContext . defReqs
+
-        topValCtx = s ^. gameState . robotMap . ix 0 . robotContext . defVals
+        startBaseProgram t@(ProcessedTerm _ (Module ty _) reqs _) =
-        topStore =
+          (gameState . replStatus .~ REPLWorking (Typed Nothing ty reqs))
-          fromMaybe emptyStore $
+            . (gameState . baseRobot . machine .~ initMachine t (topCtx ^. defVals) (topCtx ^. defStore))
-            s ^? gameState . robotMap . at 0 . _Just . robotContext . defStore
-        startBaseProgram t@(ProcessedTerm _ (Module ty _) _ _) =
-          (gameState . replStatus .~ REPLWorking ty Nothing)
-            . (gameState . robotMap . ix 0 . machine .~ initMachine t topValCtx topStore)
             . (gameState %~ execState (activateRobot 0))
 
     if not $ s ^. gameState . replWorking
       then case entry of
         CmdPrompt uinput _ ->
-          case processTerm' topTypeCtx topReqCtx uinput of
+          case processTerm' (topCtx ^. defTypes) (topCtx ^. defReqs) uinput of
             Right mt -> do
               uiState %= resetWithREPLForm (set promptUpdateL "" (s ^. uiState))
               uiState . uiReplHistory %= addREPLItem (REPLEntry uinput)
@@ -778,7 +797,7 @@ tabComplete s (CmdPrompt t mms)
  where
   completeWith m = T.append t (T.drop (T.length lastWord) m)
   lastWord = T.takeWhileEnd isIdentChar t
-  names = s ^.. gameState . robotMap . ix 0 . robotContext . defTypes . to assocs . traverse . _1
+  names = s ^.. gameState . baseRobot . robotContext . defTypes . to assocs . traverse . _1
   possibleWords = reservedWords ++ names
   matches = filter (lastWord `T.isPrefixOf`) possibleWords
 
@@ -791,7 +810,7 @@ validateREPLForm s =
       let theType = s ^. gameState . replStatus . replActiveType
        in s & uiState . uiReplType .~ theType
     CmdPrompt uinput _ ->
-      let result = processTerm' topTypeCtx topReqCtx uinput
+      let result = processTerm' (topCtx ^. defTypes) (topCtx ^. defReqs) uinput
           theType = case result of
             Right (Just (ProcessedTerm _ (Module ty _) _ _)) -> Just ty
             _ -> Nothing
@@ -801,8 +820,7 @@ validateREPLForm s =
     SearchPrompt _ _ -> s
  where
   replPrompt = s ^. uiState . uiReplForm . to formState
-  topTypeCtx = s ^. gameState . robotMap . ix 0 . robotContext . defTypes
+  topCtx = topContext s
-  topReqCtx = s ^. gameState . robotMap . ix 0 . robotContext . defReqs
   validate result = setFieldValid (isRight result) REPLInput
 
 -- | Update our current position in the REPL history.
@@ -918,16 +936,17 @@ makeEntity :: Entity -> EventM Name AppState ()
 makeEntity e = do
   s <- get
   let mkTy = PolyUnit
+      mkReq = R.singletonCap CMake
       mkProg = TApp (TConst Make) (TText (e ^. entityName))
-      mkPT = ProcessedTerm mkProg (Module mkTy empty) (R.singletonCap CMake) empty
+      mkPT = ProcessedTerm mkProg (Module mkTy empty) mkReq empty
       topStore =
         fromMaybe emptyStore $
-          s ^? gameState . robotMap . at 0 . _Just . robotContext . defStore
+          s ^? gameState . baseRobot . robotContext . defStore
 
-  case isActive <$> (s ^. gameState . robotMap . at 0) of
+  case isActive <$> (s ^? gameState . baseRobot) of
     Just False -> do
-      gameState . replStatus .= REPLWorking mkTy Nothing
+      gameState . replStatus .= REPLWorking (Typed Nothing mkTy mkReq)
-      gameState . robotMap . ix 0 . machine .= initMachine mkPT empty topStore
+      gameState . baseRobot . machine .= initMachine mkPT empty topStore
       gameState %= execState (activateRobot 0)
     _ -> continueWithoutRedraw
 

src/Swarm/TUI/View.hs

@@ -554,7 +554,7 @@ robotsListWidget s = hCenter table
         | otherwise -> withAttr greenAttr $ txt "idle"
 
   basePos :: V2 Double
-  basePos = realToFrac <$> fromMaybe (V2 0 0) (g ^? robotMap . ix 0 . robotLocation)
+  basePos = realToFrac <$> fromMaybe (V2 0 0) (g ^? baseRobot . robotLocation)
   -- Keep the base and non sytem robot (e.g. no seed)
   isRelevant robot = robot ^. robotID == 0 || not (robot ^. systemRobot)
   -- Keep the robot that are less than 32 unit away from the base

swarm.cabal

@@ -90,6 +90,7 @@ library
                       Swarm.Language.Parse.QQ
                       Swarm.Language.Pretty
                       Swarm.Language.Typecheck
+                      Swarm.Language.Typed
                       Swarm.Language.Elaborate
                       Swarm.Language.LSP
                       Swarm.Language.Pipeline

test/integration/Main.hs

@@ -29,6 +29,7 @@ import Swarm.Game.State (
   GameState,
   WinCondition (Won),
   activeRobots,
+  baseRobot,
   initGameStateForScenario,
   messageQueue,
   robotMap,
@@ -221,7 +222,7 @@ testScenarioSolution _ci _em =
     case gs ^. winSolution of
       Nothing -> assertFailure "No solution to test!"
       Just sol -> do
-        let gs' = gs & robotMap . ix 0 . machine .~ initMachine sol Ctx.empty emptyStore
+        let gs' = gs & baseRobot . machine .~ initMachine sol Ctx.empty emptyStore
         m <- timeout (time s) (snd <$> runStateT playUntilWin gs')
         case m of
           Nothing -> assertFailure "Timed out - this likely means that the solution did not work."