License | BSD-3-Clause |
---|---|
Safe Haskell | None |
Language | Haskell2010 |
Swarm.Game.CESK
Description
The Swarm interpreter uses a technique known as a CESK machine (if you want to read up on them, you may want to start by reading about CEK machines first). Execution happens simply by iterating a step function, sending one state of the CESK machine to the next. In addition to being relatively efficient, this means we can easily run a bunch of robots synchronously, in parallel, without resorting to any threads (by stepping their machines in a round-robin fashion); pause and single-step the game; save and resume, and so on.
Essentially, a CESK machine state has four components:
- The Control is the thing we are currently focused on:
either a
Term
to evaluate, or aValue
that we have just finished evaluating. - The Environment (
Env
) is a mapping from variables that might occur free in the Control to their values. - The Store (
Store
) is a mapping from abstract integer locations to values. We use it to store delayed (lazy) values, so they will be computed at most once. - The Kontinuation (
Cont
) is a stack ofFrame
s, representing the evaluation context, i.e. what we are supposed to do after we finish with the currently focused thing. When we reduce the currently focused term to a value, the top frame on the stack tells us how to proceed.
You can think of a CESK machine as a defunctionalization of a recursive big-step interpreter, where we explicitly keep track of the call stack and the environments that would be in effect at various places in the recursion. One could probably even derive this mechanically, by writing a recursive big-step interpreter, then converting it to CPS, then defunctionalizing the continuations.
The slightly confusing thing about CESK machines is how we have to pass around environments everywhere. Basically, anywhere there can be unevaluated terms containing free variables (in values, in continuation stack frames, ...), we have to store the proper environment alongside so that when we eventually get around to evaluating it, we will be able to pull out the environment to use.
Synopsis
- data Frame
- = FSnd Term Env
- | FFst Value
- | FArg Term Env
- | FVArg Value
- | FApp Value
- | FLet Var (Maybe (Polytype, Requirements)) Term Env
- | FTry Value
- | FExec
- | FBind (Maybe Var) (Maybe (Polytype, Requirements)) Term Env
- | FImmediate Const [WorldUpdate Entity] [RobotUpdate]
- | FUpdate Addr
- | FFinishAtomic
- | FRcd Env [(Var, Value)] Var [(Var, Maybe Term)]
- | FProj Var
- | FSuspend Env
- | FRestoreEnv Env
- type Cont = [Frame]
- data WorldUpdate e = ReplaceEntity {
- updatedLoc :: Cosmic Location
- originalEntity :: e
- newEntity :: Maybe e
- data RobotUpdate
- data Store
- type Addr = Int
- emptyStore :: Store
- allocate :: Value -> Store -> (Addr, Store)
- resolveValue :: Store -> Value -> Either Addr Value
- lookupStore :: Store -> Addr -> Either Addr Value
- setStore :: Addr -> Value -> Store -> Store
- data CESK
- initMachine :: TSyntax -> CESK
- continue :: TSyntax -> CESK -> CESK
- cancel :: CESK -> CESK
- prepareTerm :: Env -> TSyntax -> Term
- finalValue :: CESK -> Maybe Value
- suspendedEnv :: Traversal' CESK Env
- store :: Lens' CESK Store
- cont :: Lens' CESK Cont
Frames and continuations
A frame is a single component of a continuation stack, explaining what to do next after we finish evaluating the currently focused term.
Constructors
FSnd Term Env | We were evaluating the first component of a pair; next, we
should evaluate the second component which was saved in this
frame (and push a |
FFst Value | We were evaluating the second component of a pair; when done, we should combine it with the value of the first component saved in this frame to construct a fully evaluated pair. |
FArg Term Env |
|
FVArg Value |
|
FApp Value |
|
FLet Var (Maybe (Polytype, Requirements)) Term Env |
|
FTry Value | We are executing inside a |
FExec | An |
FBind (Maybe Var) (Maybe (Polytype, Requirements)) Term Env | We are in the process of executing the first component of a bind; once done, we should also execute the second component in the given environment (extended by binding the variable, if there is one, to the output of the first command). |
FImmediate Const [WorldUpdate Entity] [RobotUpdate] | Apply specific updates to the world and current robot. The |
FUpdate Addr | Update the cell at a certain location in the store with the computed value. |
FFinishAtomic | Signal that we are done with an atomic computation. |
FRcd Env [(Var, Value)] Var [(Var, Maybe Term)] | We are in the middle of evaluating a record: some fields have already been evaluated; we are focusing on evaluating one field; and some fields have yet to be evaluated. |
FProj Var | We are in the middle of evaluating a record field projection. |
FSuspend Env | We should suspend with the given environment once we finish the current evaluation. |
FRestoreEnv Env | If an exception bubbles all the way up to this frame, then switch to Suspended mode with this saved top-level context. |
Instances
Wrappers for creating delayed change of state
data WorldUpdate e #
Enumeration of world updates. This type is used for changes by
e.g. the drill
command which must be carried out at a later
tick. Using a first-order representation (as opposed to e.g.
just a World -> World
function) allows us to serialize and
inspect the updates.
Constructors
ReplaceEntity | |
Fields
|
Instances
FromJSON e => FromJSON (WorldUpdate e) | |||||
Defined in Swarm.Game.World Methods parseJSON :: Value -> Parser (WorldUpdate e) # parseJSONList :: Value -> Parser [WorldUpdate e] # omittedField :: Maybe (WorldUpdate e) # | |||||
ToJSON e => ToJSON (WorldUpdate e) | |||||
Defined in Swarm.Game.World Methods toJSON :: WorldUpdate e -> Value # toEncoding :: WorldUpdate e -> Encoding # toJSONList :: [WorldUpdate e] -> Value # toEncodingList :: [WorldUpdate e] -> Encoding # omitField :: WorldUpdate e -> Bool # | |||||
Generic (WorldUpdate e) | |||||
Defined in Swarm.Game.World Associated Types
Methods from :: WorldUpdate e -> Rep (WorldUpdate e) x # to :: Rep (WorldUpdate e) x -> WorldUpdate e # | |||||
Show e => Show (WorldUpdate e) | |||||
Defined in Swarm.Game.World Methods showsPrec :: Int -> WorldUpdate e -> ShowS # show :: WorldUpdate e -> String # showList :: [WorldUpdate e] -> ShowS # | |||||
Eq e => Eq (WorldUpdate e) | |||||
Defined in Swarm.Game.World Methods (==) :: WorldUpdate e -> WorldUpdate e -> Bool # (/=) :: WorldUpdate e -> WorldUpdate e -> Bool # | |||||
Ord e => Ord (WorldUpdate e) | |||||
Defined in Swarm.Game.World Methods compare :: WorldUpdate e -> WorldUpdate e -> Ordering # (<) :: WorldUpdate e -> WorldUpdate e -> Bool # (<=) :: WorldUpdate e -> WorldUpdate e -> Bool # (>) :: WorldUpdate e -> WorldUpdate e -> Bool # (>=) :: WorldUpdate e -> WorldUpdate e -> Bool # max :: WorldUpdate e -> WorldUpdate e -> WorldUpdate e # min :: WorldUpdate e -> WorldUpdate e -> WorldUpdate e # | |||||
type Rep (WorldUpdate e) | |||||
Defined in Swarm.Game.World type Rep (WorldUpdate e) = D1 ('MetaData "WorldUpdate" "Swarm.Game.World" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-scenario" 'False) (C1 ('MetaCons "ReplaceEntity" 'PrefixI 'True) (S1 ('MetaSel ('Just "updatedLoc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Cosmic Location)) :*: (S1 ('MetaSel ('Just "originalEntity") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 e) :*: S1 ('MetaSel ('Just "newEntity") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe e))))) |
data RobotUpdate Source #
Enumeration of robot updates. This type is used for changes by
e.g. the drill
command which must be carried out at a later
tick. Using a first-order representation (as opposed to e.g.
just a Robot -> Robot
function) allows us to serialize and
inspect the updates.
Note that this can not be in Robot
as it would create
a cyclic dependency.
Constructors
AddEntity Count Entity | Add copies of an entity to the robot's inventory. |
LearnEntity Entity | Make the robot learn about an entity. |
Instances
FromJSON RobotUpdate Source # | |||||
Defined in Swarm.Game.CESK | |||||
ToJSON RobotUpdate Source # | |||||
Defined in Swarm.Game.CESK Methods toJSON :: RobotUpdate -> Value # toEncoding :: RobotUpdate -> Encoding # toJSONList :: [RobotUpdate] -> Value # toEncodingList :: [RobotUpdate] -> Encoding # omitField :: RobotUpdate -> Bool # | |||||
Generic RobotUpdate Source # | |||||
Defined in Swarm.Game.CESK Associated Types
| |||||
Show RobotUpdate Source # | |||||
Defined in Swarm.Game.CESK Methods showsPrec :: Int -> RobotUpdate -> ShowS # show :: RobotUpdate -> String # showList :: [RobotUpdate] -> ShowS # | |||||
Eq RobotUpdate Source # | |||||
Defined in Swarm.Game.CESK | |||||
Ord RobotUpdate Source # | |||||
Defined in Swarm.Game.CESK Methods compare :: RobotUpdate -> RobotUpdate -> Ordering # (<) :: RobotUpdate -> RobotUpdate -> Bool # (<=) :: RobotUpdate -> RobotUpdate -> Bool # (>) :: RobotUpdate -> RobotUpdate -> Bool # (>=) :: RobotUpdate -> RobotUpdate -> Bool # max :: RobotUpdate -> RobotUpdate -> RobotUpdate # min :: RobotUpdate -> RobotUpdate -> RobotUpdate # | |||||
type Rep RobotUpdate Source # | |||||
Defined in Swarm.Game.CESK type Rep RobotUpdate = D1 ('MetaData "RobotUpdate" "Swarm.Game.CESK" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "AddEntity" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Count) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Entity)) :+: C1 ('MetaCons "LearnEntity" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Entity))) |
Store
Store
represents a store, i.e. memory, indexing integer
locations to Value
s.
Instances
ToJSON Store Source # | |||||
Generic Store Source # | |||||
Defined in Swarm.Game.CESK Associated Types
| |||||
type Rep Store Source # | |||||
Defined in Swarm.Game.CESK type Rep Store = D1 ('MetaData "Store" "Swarm.Game.CESK" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) (C1 ('MetaCons "Store" 'PrefixI 'True) (S1 ('MetaSel ('Just "next") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Addr) :*: S1 ('MetaSel ('Just "mu") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (IntMap Value)))) |
emptyStore :: Store Source #
allocate :: Value -> Store -> (Addr, Store) Source #
Allocate a new memory cell containing a given value. Return the index of the allocated cell.
resolveValue :: Store -> Value -> Either Addr Value Source #
Resolve a value, recursively looking up any indirections in the store.
lookupStore :: Store -> Addr -> Either Addr Value Source #
Look up the value at a given index, but keep following
indirections until encountering a value that is not a VIndir
.
CESK machine states
The overall state of a CESK machine, which can actually be one of four kinds of states. The CESK machine is named after the first kind of state, and it would probably be possible to inline a bunch of things and get rid of the second state, but I find it much more natural and elegant this way. Most tutorial presentations of CEK/CESK machines only have one kind of state, but then again, most tutorial presentations only deal with the bare lambda calculus, so one can tell whether a term is a value just by seeing whether it is syntactically a lambda. I learned this approach from Harper's Practical Foundations of Programming Languages.
Constructors
In Term Env Store Cont | When we are on our way "in/down" into a term, we have a
currently focused term to evaluate in the environment, a store,
and a continuation. In this mode we generally pattern-match on the
|
Out Value Store Cont | Once we finish evaluating a term, we end up with a Note that there is no |
Up Exn Store Cont | An exception has been raised. Keep unwinding the
continuation stack (until finding an enclosing |
Waiting TickNumber CESK | The machine is waiting for the game to reach a certain time to resume its execution. |
Suspended Value Env Store Cont | The machine is suspended, i.e. waiting for another term to
evaluate. This happens after we have evaluated whatever the
user entered at the REPL and we are waiting for them to type
something else. Conceptually, this is like a combination of
|
Instances
ToJSON CESK Source # | |||||
Generic CESK Source # | |||||
Defined in Swarm.Game.CESK Associated Types
| |||||
PrettyPrec CESK Source # | |||||
Defined in Swarm.Game.CESK Methods prettyPrec :: Int -> CESK -> Doc ann | |||||
type Rep CESK Source # | |||||
Defined in Swarm.Game.CESK type Rep CESK = D1 ('MetaData "CESK" "Swarm.Game.CESK" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) ((C1 ('MetaCons "In" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Store) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Cont))) :+: C1 ('MetaCons "Out" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Store) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Cont)))) :+: (C1 ('MetaCons "Up" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Exn) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Store) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Cont))) :+: (C1 ('MetaCons "Waiting" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 TickNumber) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 CESK)) :+: C1 ('MetaCons "Suspended" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Store) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Cont)))))) |
Construction
initMachine :: TSyntax -> CESK Source #
Create a brand new CESK machine, with empty environment and
store, to evaluate a given term. We always initialize the
machine with a single FExec frame as the continuation; if the
given term does not have a command type, we wrap it in pure
.
continue :: TSyntax -> CESK -> CESK Source #
Load a program into an existing robot CESK machine: either continue from a suspended state, or, as a fallback, start from scratch with an empty environment but the same store.
Also insert a suspend
primitive at the end, so the resulting
term is suitable for execution by the base (REPL) robot.
prepareTerm :: Env -> TSyntax -> Term Source #
Prepare a term for evaluation by a CESK machine in the given
environment: erase all type annotations, and optionally wrap it
in pure
if it does not have a command type. Note that since
the environment might contain type aliases, we have to be careful
to expand them before concluding whether the term has a command
type or not.
Extracting information
finalValue :: CESK -> Maybe Value Source #
Is the CESK machine in a final (finished) state? If so, extract the final value and store.
suspendedEnv :: Traversal' CESK Env Source #
Extract the environment from a suspended CESK machine (e.g. to use for typechecking).