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