mirror of
https://github.com/swarm-game/swarm.git
synced 2024-09-19 03:19:53 +03:00
Refactor robot context information into a single record (#198)
Closes #190
This commit is contained in:
parent
4265233637
commit
07d93a9d49
@ -10,6 +10,8 @@
|
||||
--
|
||||
-- A data type to represent robots.
|
||||
module Swarm.Game.Robot (
|
||||
-- * Robots data
|
||||
|
||||
-- * Robot log entries
|
||||
LogEntry (..),
|
||||
leText,
|
||||
@ -19,6 +21,12 @@ module Swarm.Game.Robot (
|
||||
-- * Robots
|
||||
Robot,
|
||||
|
||||
-- * Robot context
|
||||
RobotContext,
|
||||
defTypes,
|
||||
defCaps,
|
||||
defVals,
|
||||
|
||||
-- ** Lenses
|
||||
robotEntity,
|
||||
robotName,
|
||||
@ -31,8 +39,7 @@ module Swarm.Game.Robot (
|
||||
robotLogUpdated,
|
||||
inventoryHash,
|
||||
robotCapabilities,
|
||||
robotCtx,
|
||||
robotEnv,
|
||||
robotContext,
|
||||
machine,
|
||||
systemRobot,
|
||||
selfDestruct,
|
||||
@ -68,6 +75,21 @@ import Swarm.Language.Context
|
||||
import Swarm.Language.Syntax (east)
|
||||
import Swarm.Language.Types (TCtx)
|
||||
|
||||
-- | A record that stores the information
|
||||
-- for all defintions stored in a 'Robot'
|
||||
data RobotContext = RobotContext
|
||||
{ -- | maps a definition to it's type
|
||||
_defTypes :: TCtx
|
||||
, -- | maps a defintion to the capabilities
|
||||
-- required to compute it
|
||||
_defCaps :: CapCtx
|
||||
, -- | maps a defintion to it's value
|
||||
_defVals :: Env
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
makeLenses ''RobotContext
|
||||
|
||||
-- | An entry in a robot's log.
|
||||
data LogEntry = LogEntry
|
||||
{ -- | The text of the log entry.
|
||||
@ -92,8 +114,7 @@ data Robot = Robot
|
||||
, _robotLog :: Seq LogEntry
|
||||
, _robotLogUpdated :: Bool
|
||||
, _robotLocation :: V2 Int64
|
||||
, _robotCtx :: (TCtx, CapCtx)
|
||||
, _robotEnv :: Env
|
||||
, _robotContext :: RobotContext
|
||||
, _machine :: CEK
|
||||
, _systemRobot :: Bool
|
||||
, _selfDestruct :: Bool
|
||||
@ -145,6 +166,9 @@ robotOrientation = robotEntity . entityOrientation
|
||||
robotInventory :: Lens' Robot Inventory
|
||||
robotInventory = robotEntity . entityInventory
|
||||
|
||||
-- | The robot's context
|
||||
robotContext :: Lens' Robot RobotContext
|
||||
|
||||
-- | A separate inventory for "installed devices", which provide the
|
||||
-- robot with certain capabilities.
|
||||
--
|
||||
@ -204,13 +228,6 @@ inventoryCapabilities = setOf (to elems . traverse . _2 . entityCapabilities . t
|
||||
robotCapabilities :: Getter Robot (Set Capability)
|
||||
robotCapabilities = to _robotCapabilities
|
||||
|
||||
-- | The type and capability contexts describing the robot's currently
|
||||
-- stored definitions.
|
||||
robotCtx :: Lens' Robot (TCtx, CapCtx)
|
||||
|
||||
-- | The robot's environment of stored definitions.
|
||||
robotEnv :: Lens' Robot Env
|
||||
|
||||
-- | The robot's current CEK machine state.
|
||||
machine :: Lens' Robot CEK
|
||||
|
||||
@ -288,8 +305,7 @@ mkRobot name l d m devs =
|
||||
, _robotLog = Seq.empty
|
||||
, _robotLogUpdated = False
|
||||
, _robotLocation = l
|
||||
, _robotCtx = (empty, empty)
|
||||
, _robotEnv = empty
|
||||
, _robotContext = RobotContext empty empty empty
|
||||
, _machine = m
|
||||
, _systemRobot = False
|
||||
, _selfDestruct = False
|
||||
@ -315,8 +331,7 @@ baseRobot devs =
|
||||
, _robotLog = Seq.empty
|
||||
, _robotLogUpdated = False
|
||||
, _robotLocation = V2 0 0
|
||||
, _robotCtx = (empty, empty)
|
||||
, _robotEnv = empty
|
||||
, _robotContext = RobotContext empty empty empty
|
||||
, _machine = idleMachine
|
||||
, _systemRobot = False
|
||||
, _selfDestruct = False
|
||||
|
@ -19,7 +19,6 @@
|
||||
-- interpreter for the Swarm language.
|
||||
module Swarm.Game.Step where
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Control.Lens hiding (Const, from, parts)
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.State
|
||||
@ -420,8 +419,9 @@ stepCEK cek = case cek of
|
||||
-- top-level environment and contexts, so they will be available to
|
||||
-- future programs.
|
||||
Out (VResult v e) (FLoadEnv ctx cctx : k) -> do
|
||||
robotEnv %= (`union` e)
|
||||
robotCtx %= ((`union` ctx) *** (`union` cctx))
|
||||
robotContext . defVals %= (`union` e)
|
||||
robotContext . defTypes %= (`union` ctx)
|
||||
robotContext . defCaps %= (`union` cctx)
|
||||
return $ Out v k
|
||||
Out v (FLoadEnv {} : k) -> return $ Out v k
|
||||
-- Any other type of value wiwth an FExec frame is an error (should
|
||||
@ -933,10 +933,9 @@ execConst c vs k = do
|
||||
_ -> badConst
|
||||
Reprogram -> case vs of
|
||||
[VString childRobotName, VDelay _ cmd e] -> do
|
||||
r <- get
|
||||
em <- doOnGame $ use entityMap
|
||||
mode <- doOnGame $ use gameMode
|
||||
rctx@(_, capCtx) <- use robotCtx
|
||||
renv <- use robotEnv
|
||||
|
||||
-- check if robot exists
|
||||
childRobot <-
|
||||
@ -965,7 +964,7 @@ execConst c vs k = do
|
||||
let -- Find out what capabilities are required by the program that will
|
||||
-- be run on the other robot, and what devices would provide those
|
||||
-- capabilities.
|
||||
(caps, _capCtx) = requiredCaps capCtx cmd
|
||||
(caps, _capCtx) = requiredCaps (r ^. robotContext . defCaps) cmd
|
||||
capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps
|
||||
|
||||
-- device is ok if it is installed on the childRobot
|
||||
@ -984,8 +983,7 @@ execConst c vs k = do
|
||||
-- and context which collectively mean all the variables
|
||||
-- declared in the parent robot
|
||||
doOnGame $ robotMap . at childRobotName . _Just . machine .= In cmd e [FExec]
|
||||
doOnGame $ robotMap . at childRobotName . _Just . robotEnv .= renv
|
||||
doOnGame $ robotMap . at childRobotName . _Just . robotCtx .= rctx
|
||||
doOnGame $ robotMap . at childRobotName . _Just . robotContext .= r ^. robotContext
|
||||
|
||||
return $ Out VUnit k
|
||||
_ -> badConst
|
||||
@ -1005,7 +1003,7 @@ execConst c vs k = do
|
||||
-- Find out what capabilities are required by the program that will
|
||||
-- be run on the newly constructed robot, and what devices would
|
||||
-- provide those capabilities.
|
||||
(caps, _capCtx) = requiredCaps (snd (r ^. robotCtx)) cmd
|
||||
(caps, _capCtx) = requiredCaps (r ^. robotContext . defCaps) cmd
|
||||
capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps
|
||||
|
||||
-- Note that _capCtx must be empty: at least at the
|
||||
|
@ -390,7 +390,7 @@ handleREPLEvent s (VtyEvent (V.EvKey (V.KChar 'c') [V.MCtrl])) =
|
||||
& gameState . robotMap . ix "base" . machine .~ idleMachine
|
||||
handleREPLEvent s (VtyEvent (V.EvKey V.KEnter [])) =
|
||||
if not $ s ^. gameState . replWorking
|
||||
then case processTerm' topCtx topCapCtx entry of
|
||||
then case processTerm' topTypeCtx topCapCtx entry of
|
||||
Right t@(ProcessedTerm _ (Module ty _) _ _) ->
|
||||
continue $
|
||||
s
|
||||
@ -400,7 +400,7 @@ handleREPLEvent s (VtyEvent (V.EvKey V.KEnter [])) =
|
||||
& uiState . uiReplHistIdx .~ (-1)
|
||||
& uiState . uiError .~ Nothing
|
||||
& gameState . replStatus .~ REPLWorking ty Nothing
|
||||
& gameState . robotMap . ix "base" . machine .~ initMachine t topEnv
|
||||
& gameState . robotMap . ix "base" . machine .~ initMachine t topValCtx
|
||||
& gameState %~ execState (activateRobot "base")
|
||||
Left err ->
|
||||
continue $
|
||||
@ -412,8 +412,9 @@ handleREPLEvent s (VtyEvent (V.EvKey V.KEnter [])) =
|
||||
-- program before even starting?
|
||||
|
||||
entry = formState (s ^. uiState . uiReplForm)
|
||||
(topCtx, topCapCtx) = s ^. gameState . robotMap . ix "base" . robotCtx
|
||||
topEnv = s ^. gameState . robotMap . ix "base" . robotEnv
|
||||
topTypeCtx = s ^. gameState . robotMap . ix "base" . robotContext . defTypes
|
||||
topCapCtx = s ^. gameState . robotMap . ix "base" . robotContext . defCaps
|
||||
topValCtx = s ^. gameState . robotMap . ix "base" . robotContext . defVals
|
||||
handleREPLEvent s (VtyEvent (V.EvKey V.KUp [])) =
|
||||
continue $ s & adjReplHistIndex (+)
|
||||
handleREPLEvent s (VtyEvent (V.EvKey V.KDown [])) =
|
||||
@ -430,8 +431,9 @@ validateREPLForm s =
|
||||
& uiState . uiReplForm %~ validate
|
||||
& uiState . uiReplType .~ theType
|
||||
where
|
||||
(topCtx, topCapCtx) = s ^. gameState . robotMap . ix "base" . robotCtx
|
||||
result = processTerm' topCtx topCapCtx (s ^. uiState . uiReplForm . to formState)
|
||||
topTypeCtx = s ^. gameState . robotMap . ix "base" . robotContext . defTypes
|
||||
topCapCtx = s ^. gameState . robotMap . ix "base" . robotContext . defCaps
|
||||
result = processTerm' topTypeCtx topCapCtx (s ^. uiState . uiReplForm . to formState)
|
||||
theType = case result of
|
||||
Right (ProcessedTerm _ (Module ty _) _ _) -> Just ty
|
||||
_ -> Nothing
|
||||
@ -566,7 +568,7 @@ handleRobotPanelEvent s _ = continueWithoutRedraw s
|
||||
-- base is not currently busy.
|
||||
makeEntity :: AppState -> Entity -> EventM Name (Next AppState)
|
||||
makeEntity s e = do
|
||||
let topEnv = s ^. gameState . robotMap . ix "base" . robotEnv
|
||||
let topDefCtx = s ^. gameState . robotMap . ix "base" . robotContext . defVals
|
||||
mkTy = Forall [] $ TyCmd TyUnit
|
||||
mkProg = TApp (TConst Make) (TString (e ^. entityName))
|
||||
mkPT = ProcessedTerm mkProg (Module mkTy empty) (S.singleton CMake) empty
|
||||
@ -575,7 +577,7 @@ makeEntity s e = do
|
||||
continue $
|
||||
s
|
||||
& gameState . replStatus .~ REPLWorking mkTy Nothing
|
||||
& gameState . robotMap . ix "base" . machine .~ initMachine mkPT topEnv
|
||||
& gameState . robotMap . ix "base" . machine .~ initMachine mkPT topDefCtx
|
||||
& gameState %~ execState (activateRobot "base")
|
||||
_ -> continueWithoutRedraw s
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user