mirror of
https://github.com/swarm-game/swarm.git
synced 2024-10-27 10:04:12 +03:00
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>
This commit is contained in:
parent
683508f36e
commit
977e0edd68
@ -41,6 +41,7 @@ module Swarm.Game.Robot (
|
|||||||
defReqs,
|
defReqs,
|
||||||
defVals,
|
defVals,
|
||||||
defStore,
|
defStore,
|
||||||
|
emptyRobotContext,
|
||||||
|
|
||||||
-- ** Lenses
|
-- ** Lenses
|
||||||
robotEntity,
|
robotEntity,
|
||||||
@ -102,6 +103,7 @@ import Swarm.Language.Capability (Capability)
|
|||||||
import Swarm.Language.Context qualified as Ctx
|
import Swarm.Language.Context qualified as Ctx
|
||||||
import Swarm.Language.Requirement (ReqCtx)
|
import Swarm.Language.Requirement (ReqCtx)
|
||||||
import Swarm.Language.Syntax (toDirection)
|
import Swarm.Language.Syntax (toDirection)
|
||||||
|
import Swarm.Language.Typed (Typed (..))
|
||||||
import Swarm.Language.Types (TCtx)
|
import Swarm.Language.Types (TCtx)
|
||||||
import Swarm.Util ()
|
import Swarm.Util ()
|
||||||
import Swarm.Util.Yaml
|
import Swarm.Util.Yaml
|
||||||
@ -127,6 +129,31 @@ data RobotContext = RobotContext
|
|||||||
|
|
||||||
makeLenses ''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
|
data LogSource = Said | Logged | ErrorTrace
|
||||||
deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
|
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
|
, _robotLog = Seq.empty
|
||||||
, _robotLogUpdated = False
|
, _robotLogUpdated = False
|
||||||
, _robotLocation = loc
|
, _robotLocation = loc
|
||||||
, _robotContext = RobotContext Ctx.empty Ctx.empty Ctx.empty emptyStore
|
, _robotContext = emptyRobotContext
|
||||||
, _robotID = rid
|
, _robotID = rid
|
||||||
, _robotParentID = pid
|
, _robotParentID = pid
|
||||||
, _robotHeavy = heavy
|
, _robotHeavy = heavy
|
||||||
|
@ -38,6 +38,7 @@ module Swarm.Game.State (
|
|||||||
robotsByLocation,
|
robotsByLocation,
|
||||||
robotsAtLocation,
|
robotsAtLocation,
|
||||||
robotsInArea,
|
robotsInArea,
|
||||||
|
baseRobot,
|
||||||
activeRobots,
|
activeRobots,
|
||||||
waitingRobots,
|
waitingRobots,
|
||||||
availableRecipes,
|
availableRecipes,
|
||||||
@ -61,6 +62,7 @@ module Swarm.Game.State (
|
|||||||
viewCenter,
|
viewCenter,
|
||||||
needsRedraw,
|
needsRedraw,
|
||||||
replStatus,
|
replStatus,
|
||||||
|
replNextValueIndex,
|
||||||
replWorking,
|
replWorking,
|
||||||
replActiveType,
|
replActiveType,
|
||||||
messageQueue,
|
messageQueue,
|
||||||
@ -153,6 +155,7 @@ import Swarm.Language.Context qualified as Ctx
|
|||||||
import Swarm.Language.Pipeline (ProcessedTerm)
|
import Swarm.Language.Pipeline (ProcessedTerm)
|
||||||
import Swarm.Language.Pipeline.QQ (tmQ)
|
import Swarm.Language.Pipeline.QQ (tmQ)
|
||||||
import Swarm.Language.Syntax (Const, Term (TText), allConst)
|
import Swarm.Language.Syntax (Const, Term (TText), allConst)
|
||||||
|
import Swarm.Language.Typed (Typed (Typed))
|
||||||
import Swarm.Language.Types
|
import Swarm.Language.Types
|
||||||
import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
|
import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
|
||||||
import System.Clock qualified as Clock
|
import System.Clock qualified as Clock
|
||||||
@ -178,12 +181,12 @@ makePrisms ''ViewCenterRule
|
|||||||
data REPLStatus
|
data REPLStatus
|
||||||
= -- | The REPL is not doing anything actively at the moment.
|
= -- | The REPL is not doing anything actively at the moment.
|
||||||
-- We persist the last value and its type though.
|
-- 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
|
| -- | A command entered at the REPL is currently being run. The
|
||||||
-- 'Polytype' represents the type of the expression that was
|
-- 'Polytype' represents the type of the expression that was
|
||||||
-- entered. The @Maybe Value@ starts out as @Nothing@ and gets
|
-- entered. The @Maybe Value@ starts out as @Nothing@ and gets
|
||||||
-- filled in with a result once the command completes.
|
-- filled in with a result once the command completes.
|
||||||
REPLWorking Polytype (Maybe Value)
|
REPLWorking (Typed (Maybe Value))
|
||||||
deriving (Eq, Show, Generic, FromJSON, ToJSON)
|
deriving (Eq, Show, Generic, FromJSON, ToJSON)
|
||||||
|
|
||||||
data WinCondition
|
data WinCondition
|
||||||
@ -285,6 +288,7 @@ data GameState = GameState
|
|||||||
, _viewCenter :: V2 Int64
|
, _viewCenter :: V2 Int64
|
||||||
, _needsRedraw :: Bool
|
, _needsRedraw :: Bool
|
||||||
, _replStatus :: REPLStatus
|
, _replStatus :: REPLStatus
|
||||||
|
, _replNextValueIndex :: Integer
|
||||||
, _messageQueue :: Seq LogEntry
|
, _messageQueue :: Seq LogEntry
|
||||||
, _lastSeenMessageTime :: Integer
|
, _lastSeenMessageTime :: Integer
|
||||||
, _focusedRobotID :: RID
|
, _focusedRobotID :: RID
|
||||||
@ -361,6 +365,10 @@ robotsInArea o d gs = map (rm IM.!) rids
|
|||||||
rl = gs ^. robotsByLocation
|
rl = gs ^. robotsByLocation
|
||||||
rids = concatMap IS.elems $ getElemsInArea o d rl
|
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.
|
-- | The list of entities that have been discovered.
|
||||||
allDiscoveredEntities :: Lens' GameState Inventory
|
allDiscoveredEntities :: Lens' GameState Inventory
|
||||||
|
|
||||||
@ -442,6 +450,9 @@ needsRedraw :: Lens' GameState Bool
|
|||||||
-- | The current status of the REPL.
|
-- | The current status of the REPL.
|
||||||
replStatus :: Lens' GameState REPLStatus
|
replStatus :: Lens' GameState REPLStatus
|
||||||
|
|
||||||
|
-- | The index of the next it{index} value
|
||||||
|
replNextValueIndex :: Lens' GameState Integer
|
||||||
|
|
||||||
-- | A queue of global messages.
|
-- | A queue of global messages.
|
||||||
--
|
--
|
||||||
-- Note that we put the newest entry to the right.
|
-- Note that we put the newest entry to the right.
|
||||||
@ -499,14 +510,14 @@ replWorking :: Getter GameState Bool
|
|||||||
replWorking = to (\s -> matchesWorking $ s ^. replStatus)
|
replWorking = to (\s -> matchesWorking $ s ^. replStatus)
|
||||||
where
|
where
|
||||||
matchesWorking (REPLDone _) = False
|
matchesWorking (REPLDone _) = False
|
||||||
matchesWorking (REPLWorking _ _) = True
|
matchesWorking (REPLWorking _) = True
|
||||||
|
|
||||||
-- | Either the type of the command being executed, or of the last command
|
-- | Either the type of the command being executed, or of the last command
|
||||||
replActiveType :: Getter REPLStatus (Maybe Polytype)
|
replActiveType :: Getter REPLStatus (Maybe Polytype)
|
||||||
replActiveType = to getter
|
replActiveType = to getter
|
||||||
where
|
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
|
getter _ = Nothing
|
||||||
|
|
||||||
-- | Get the notification list of messages from the point of view of focused robot.
|
-- | Get the notification list of messages from the point of view of focused robot.
|
||||||
@ -714,6 +725,7 @@ initGameState = do
|
|||||||
, _viewCenter = V2 0 0
|
, _viewCenter = V2 0 0
|
||||||
, _needsRedraw = False
|
, _needsRedraw = False
|
||||||
, _replStatus = REPLDone Nothing
|
, _replStatus = REPLDone Nothing
|
||||||
|
, _replNextValueIndex = 0
|
||||||
, _messageQueue = Empty
|
, _messageQueue = Empty
|
||||||
, _lastSeenMessageTime = -1
|
, _lastSeenMessageTime = -1
|
||||||
, _focusedRobotID = 0
|
, _focusedRobotID = 0
|
||||||
@ -764,7 +776,8 @@ scenarioToGameState scenario userSeed toRun g = do
|
|||||||
-- otherwise the store of definition cells is not saved (see #333)
|
-- otherwise the store of definition cells is not saved (see #333)
|
||||||
_replStatus = case toRun of
|
_replStatus = case toRun of
|
||||||
Nothing -> REPLDone Nothing
|
Nothing -> REPLDone Nothing
|
||||||
Just _ -> REPLWorking PolyUnit Nothing
|
Just _ -> REPLWorking (Typed Nothing PolyUnit mempty)
|
||||||
|
, _replNextValueIndex = 0
|
||||||
, _messageQueue = Empty
|
, _messageQueue = Empty
|
||||||
, _focusedRobotID = baseID
|
, _focusedRobotID = baseID
|
||||||
, _ticks = 0
|
, _ticks = 0
|
||||||
|
@ -65,6 +65,7 @@ import Swarm.Language.Pipeline
|
|||||||
import Swarm.Language.Pipeline.QQ (tmQ)
|
import Swarm.Language.Pipeline.QQ (tmQ)
|
||||||
import Swarm.Language.Requirement qualified as R
|
import Swarm.Language.Requirement qualified as R
|
||||||
import Swarm.Language.Syntax
|
import Swarm.Language.Syntax
|
||||||
|
import Swarm.Language.Typed (Typed (..))
|
||||||
import Swarm.Util
|
import Swarm.Util
|
||||||
import System.Clock (TimeSpec)
|
import System.Clock (TimeSpec)
|
||||||
import System.Clock qualified
|
import System.Clock qualified
|
||||||
@ -110,10 +111,10 @@ gameTick = do
|
|||||||
Just r -> do
|
Just r -> do
|
||||||
res <- use replStatus
|
res <- use replStatus
|
||||||
case res of
|
case res of
|
||||||
REPLWorking ty Nothing -> case getResult r of
|
REPLWorking (Typed Nothing ty req) -> case getResult r of
|
||||||
Just (v, s) -> do
|
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 ()
|
Nothing -> return ()
|
||||||
_otherREPLStatus -> return ()
|
_otherREPLStatus -> return ()
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
20
src/Swarm/Language/Typed.hs
Normal file
20
src/Swarm/Language/Typed.hs
Normal file
@ -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
|
@ -57,6 +57,7 @@ import Data.List.NonEmpty (NonEmpty (..))
|
|||||||
import Data.List.NonEmpty qualified as NE
|
import Data.List.NonEmpty qualified as NE
|
||||||
import Data.Map qualified as M
|
import Data.Map qualified as M
|
||||||
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||||
|
import Data.String (fromString)
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Text.IO qualified as T
|
import Data.Text.IO qualified as T
|
||||||
import Data.Time (getZonedTime)
|
import Data.Time (getZonedTime)
|
||||||
@ -77,6 +78,7 @@ import Swarm.Language.Pipeline
|
|||||||
import Swarm.Language.Pretty
|
import Swarm.Language.Pretty
|
||||||
import Swarm.Language.Requirement qualified as R
|
import Swarm.Language.Requirement qualified as R
|
||||||
import Swarm.Language.Syntax
|
import Swarm.Language.Syntax
|
||||||
|
import Swarm.Language.Typed (Typed (..))
|
||||||
import Swarm.Language.Types
|
import Swarm.Language.Types
|
||||||
import Swarm.TUI.List
|
import Swarm.TUI.List
|
||||||
import Swarm.TUI.Model
|
import Swarm.TUI.Model
|
||||||
@ -582,16 +584,22 @@ updateUI = do
|
|||||||
-- Now check if the base finished running a program entered at the REPL.
|
-- Now check if the base finished running a program entered at the REPL.
|
||||||
replUpdated <- case g ^. replStatus of
|
replUpdated <- case g ^. replStatus of
|
||||||
-- It did, and the result was the unit value. Just reset replStatus.
|
-- 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
|
pure True
|
||||||
|
|
||||||
-- It did, and returned some other value. Pretty-print the
|
-- It did, and returned some other value. Pretty-print the
|
||||||
-- result as a REPL output, with its type, and reset the replStatus.
|
-- 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)
|
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
|
pure True
|
||||||
|
|
||||||
-- Otherwise, do nothing.
|
-- Otherwise, do nothing.
|
||||||
@ -677,6 +685,8 @@ loadVisibleRegion = do
|
|||||||
gs <- use gameState
|
gs <- use gameState
|
||||||
gameState . world %= W.loadRegion (viewingRegion gs (over both fromIntegral size))
|
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 :: Polytype -> Polytype
|
||||||
stripCmd (Forall xs (TyCmd ty)) = Forall xs ty
|
stripCmd (Forall xs (TyCmd ty)) = Forall xs ty
|
||||||
stripCmd pty = pty
|
stripCmd pty = pty
|
||||||
@ -685,30 +695,39 @@ stripCmd pty = pty
|
|||||||
-- REPL events
|
-- 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.
|
-- | Handle a user input event for the REPL.
|
||||||
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
|
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
|
||||||
handleREPLEvent = \case
|
handleREPLEvent = \case
|
||||||
ControlKey 'c' -> do
|
ControlKey 'c' -> do
|
||||||
gameState . robotMap . ix 0 . machine %= cancel
|
gameState . baseRobot . machine %= cancel
|
||||||
uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt "")
|
uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt "")
|
||||||
Key V.KEnter -> do
|
Key V.KEnter -> do
|
||||||
s <- get
|
s <- get
|
||||||
let entry = formState (s ^. uiState . uiReplForm)
|
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))
|
. (gameState %~ execState (activateRobot 0))
|
||||||
|
|
||||||
if not $ s ^. gameState . replWorking
|
if not $ s ^. gameState . replWorking
|
||||||
then case entry of
|
then case entry of
|
||||||
CmdPrompt uinput _ ->
|
CmdPrompt uinput _ ->
|
||||||
case processTerm' topTypeCtx topReqCtx uinput of
|
case processTerm' (topCtx ^. defTypes) (topCtx ^. defReqs) uinput of
|
||||||
Right mt -> do
|
Right mt -> do
|
||||||
uiState %= resetWithREPLForm (set promptUpdateL "" (s ^. uiState))
|
uiState %= resetWithREPLForm (set promptUpdateL "" (s ^. uiState))
|
||||||
uiState . uiReplHistory %= addREPLItem (REPLEntry uinput)
|
uiState . uiReplHistory %= addREPLItem (REPLEntry uinput)
|
||||||
@ -778,7 +797,7 @@ tabComplete s (CmdPrompt t mms)
|
|||||||
where
|
where
|
||||||
completeWith m = T.append t (T.drop (T.length lastWord) m)
|
completeWith m = T.append t (T.drop (T.length lastWord) m)
|
||||||
lastWord = T.takeWhileEnd isIdentChar t
|
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
|
possibleWords = reservedWords ++ names
|
||||||
matches = filter (lastWord `T.isPrefixOf`) possibleWords
|
matches = filter (lastWord `T.isPrefixOf`) possibleWords
|
||||||
|
|
||||||
@ -791,7 +810,7 @@ validateREPLForm s =
|
|||||||
let theType = s ^. gameState . replStatus . replActiveType
|
let theType = s ^. gameState . replStatus . replActiveType
|
||||||
in s & uiState . uiReplType .~ theType
|
in s & uiState . uiReplType .~ theType
|
||||||
CmdPrompt uinput _ ->
|
CmdPrompt uinput _ ->
|
||||||
let result = processTerm' topTypeCtx topReqCtx uinput
|
let result = processTerm' (topCtx ^. defTypes) (topCtx ^. defReqs) uinput
|
||||||
theType = case result of
|
theType = case result of
|
||||||
Right (Just (ProcessedTerm _ (Module ty _) _ _)) -> Just ty
|
Right (Just (ProcessedTerm _ (Module ty _) _ _)) -> Just ty
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
@ -801,8 +820,7 @@ validateREPLForm s =
|
|||||||
SearchPrompt _ _ -> s
|
SearchPrompt _ _ -> s
|
||||||
where
|
where
|
||||||
replPrompt = s ^. uiState . uiReplForm . to formState
|
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
|
validate result = setFieldValid (isRight result) REPLInput
|
||||||
|
|
||||||
-- | Update our current position in the REPL history.
|
-- | Update our current position in the REPL history.
|
||||||
@ -918,16 +936,17 @@ makeEntity :: Entity -> EventM Name AppState ()
|
|||||||
makeEntity e = do
|
makeEntity e = do
|
||||||
s <- get
|
s <- get
|
||||||
let mkTy = PolyUnit
|
let mkTy = PolyUnit
|
||||||
|
mkReq = R.singletonCap CMake
|
||||||
mkProg = TApp (TConst Make) (TText (e ^. entityName))
|
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 =
|
topStore =
|
||||||
fromMaybe emptyStore $
|
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
|
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)
|
gameState %= execState (activateRobot 0)
|
||||||
_ -> continueWithoutRedraw
|
_ -> continueWithoutRedraw
|
||||||
|
|
||||||
|
@ -554,7 +554,7 @@ robotsListWidget s = hCenter table
|
|||||||
| otherwise -> withAttr greenAttr $ txt "idle"
|
| otherwise -> withAttr greenAttr $ txt "idle"
|
||||||
|
|
||||||
basePos :: V2 Double
|
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)
|
-- Keep the base and non sytem robot (e.g. no seed)
|
||||||
isRelevant robot = robot ^. robotID == 0 || not (robot ^. systemRobot)
|
isRelevant robot = robot ^. robotID == 0 || not (robot ^. systemRobot)
|
||||||
-- Keep the robot that are less than 32 unit away from the base
|
-- Keep the robot that are less than 32 unit away from the base
|
||||||
|
@ -90,6 +90,7 @@ library
|
|||||||
Swarm.Language.Parse.QQ
|
Swarm.Language.Parse.QQ
|
||||||
Swarm.Language.Pretty
|
Swarm.Language.Pretty
|
||||||
Swarm.Language.Typecheck
|
Swarm.Language.Typecheck
|
||||||
|
Swarm.Language.Typed
|
||||||
Swarm.Language.Elaborate
|
Swarm.Language.Elaborate
|
||||||
Swarm.Language.LSP
|
Swarm.Language.LSP
|
||||||
Swarm.Language.Pipeline
|
Swarm.Language.Pipeline
|
||||||
|
@ -29,6 +29,7 @@ import Swarm.Game.State (
|
|||||||
GameState,
|
GameState,
|
||||||
WinCondition (Won),
|
WinCondition (Won),
|
||||||
activeRobots,
|
activeRobots,
|
||||||
|
baseRobot,
|
||||||
initGameStateForScenario,
|
initGameStateForScenario,
|
||||||
messageQueue,
|
messageQueue,
|
||||||
robotMap,
|
robotMap,
|
||||||
@ -221,7 +222,7 @@ testScenarioSolution _ci _em =
|
|||||||
case gs ^. winSolution of
|
case gs ^. winSolution of
|
||||||
Nothing -> assertFailure "No solution to test!"
|
Nothing -> assertFailure "No solution to test!"
|
||||||
Just sol -> do
|
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')
|
m <- timeout (time s) (snd <$> runStateT playUntilWin gs')
|
||||||
case m of
|
case m of
|
||||||
Nothing -> assertFailure "Timed out - this likely means that the solution did not work."
|
Nothing -> assertFailure "Timed out - this likely means that the solution did not work."
|
||||||
|
Loading…
Reference in New Issue
Block a user