swarm-0.7.0.0: 2D resource gathering game with programmable robots
LicenseBSD-3-Clause
Safe HaskellNone
LanguageHaskell2010

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 a Value 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 of Frames, 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

Frames and continuations

data Frame Source #

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 frame on the stack to save the first component).

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

FArg t e says that we were evaluating the left-hand side of an application, so the next thing we should do is evaluate the term t (the right-hand side, i.e. argument of the application) in environment e. We will also push an FApp frame on the stack.

FVArg Value

FVArg v says that we were evaluating the left-hand side of an application, and the next thing we should do is apply it to the given value. This does not normally occur as part of the usual evaluation process for applications, which instead uses FArg. However, it is sometimes useful when reducing other constructs---for example, the pair eliminator match.

FApp Value

FApp v says that we were evaluating the right-hand side of an application; once we are done, we should pass the resulting value as an argument to v.

FLet Var (Maybe (Polytype, Requirements)) Term Env

FLet x ty t2 e says that we were evaluating a term t1 of type ty in an expression of the form let x = t1 in t2, that is, we were evaluating the definition of x; the next thing we should do is evaluate t2 in the environment e extended with a binding for x.

FTry Value

We are executing inside a Try block. If an exception is raised, we will execute the stored term (the "catch" block).

FExec

An FExec frame means the focused value is a command, which we should now execute.

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 Const is used to track the original command for error messages.

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

Instances details
ToJSON Frame Source # 
Instance details

Defined in Swarm.Game.CESK

Generic Frame Source # 
Instance details

Defined in Swarm.Game.CESK

Associated Types

type Rep Frame 
Instance details

Defined in Swarm.Game.CESK

type Rep Frame = D1 ('MetaData "Frame" "Swarm.Game.CESK" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) ((((C1 ('MetaCons "FSnd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: C1 ('MetaCons "FFst" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value))) :+: (C1 ('MetaCons "FArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: C1 ('MetaCons "FVArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value)))) :+: ((C1 ('MetaCons "FApp" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value)) :+: C1 ('MetaCons "FLet" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe (Polytype, Requirements)))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)))) :+: (C1 ('MetaCons "FTry" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value)) :+: C1 ('MetaCons "FExec" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "FBind" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Var)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe (Polytype, Requirements)))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env))) :+: C1 ('MetaCons "FImmediate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Const) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [WorldUpdate Entity]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [RobotUpdate])))) :+: (C1 ('MetaCons "FUpdate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Addr)) :+: C1 ('MetaCons "FFinishAtomic" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "FRcd" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [(Var, Value)])) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [(Var, Maybe Term)]))) :+: C1 ('MetaCons "FProj" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var))) :+: (C1 ('MetaCons "FSuspend" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: C1 ('MetaCons "FRestoreEnv" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env))))))

Methods

from :: Frame -> Rep Frame x #

to :: Rep Frame x -> Frame #

type Rep Frame Source # 
Instance details

Defined in Swarm.Game.CESK

type Rep Frame = D1 ('MetaData "Frame" "Swarm.Game.CESK" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-engine" 'False) ((((C1 ('MetaCons "FSnd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: C1 ('MetaCons "FFst" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value))) :+: (C1 ('MetaCons "FArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: C1 ('MetaCons "FVArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value)))) :+: ((C1 ('MetaCons "FApp" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value)) :+: C1 ('MetaCons "FLet" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe (Polytype, Requirements)))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)))) :+: (C1 ('MetaCons "FTry" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value)) :+: C1 ('MetaCons "FExec" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "FBind" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Var)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe (Polytype, Requirements)))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env))) :+: C1 ('MetaCons "FImmediate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Const) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [WorldUpdate Entity]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [RobotUpdate])))) :+: (C1 ('MetaCons "FUpdate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Addr)) :+: C1 ('MetaCons "FFinishAtomic" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "FRcd" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [(Var, Value)])) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [(Var, Maybe Term)]))) :+: C1 ('MetaCons "FProj" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var))) :+: (C1 ('MetaCons "FSuspend" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: C1 ('MetaCons "FRestoreEnv" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env))))))

type Cont = [Frame] Source #

A continuation is just a stack of frames.

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

Instances details
FromJSON e => FromJSON (WorldUpdate e) 
Instance details

Defined in Swarm.Game.World

ToJSON e => ToJSON (WorldUpdate e) 
Instance details

Defined in Swarm.Game.World

Generic (WorldUpdate e) 
Instance details

Defined in Swarm.Game.World

Associated Types

type Rep (WorldUpdate e) 
Instance details

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)))))

Methods

from :: WorldUpdate e -> Rep (WorldUpdate e) x #

to :: Rep (WorldUpdate e) x -> WorldUpdate e #

Show e => Show (WorldUpdate e) 
Instance details

Defined in Swarm.Game.World

Eq e => Eq (WorldUpdate e) 
Instance details

Defined in Swarm.Game.World

Ord e => Ord (WorldUpdate e) 
Instance details

Defined in Swarm.Game.World

type Rep (WorldUpdate e) 
Instance details

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

Instances details
FromJSON RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

ToJSON RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Generic RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Associated Types

type Rep RobotUpdate 
Instance details

Defined in Swarm.Game.CESK

Show RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Eq RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Ord RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

type Rep RobotUpdate Source # 
Instance details

Defined in Swarm.Game.CESK

Store

data Store Source #

Store represents a store, i.e. memory, indexing integer locations to Values.

Instances

Instances details
ToJSON Store Source # 
Instance details

Defined in Swarm.Game.CESK

Generic Store Source # 
Instance details

Defined in Swarm.Game.CESK

Associated Types

type Rep Store 
Instance details

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))))

Methods

from :: Store -> Rep Store x #

to :: Rep Store x -> Store #

type Rep Store Source # 
Instance details

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))))

type Addr = Int 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.

setStore :: Addr -> Value -> Store -> Store Source #

Set the value at a given index.

CESK machine states

data CESK Source #

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 Term to decide what to do next.

Out Value Store Cont

Once we finish evaluating a term, we end up with a Value and we switch into "out" mode, bringing the value back up out of the depths to the context that was expecting it. In this mode we generally pattern-match on the Cont to decide what to do next.

Note that there is no Env, because we don't have anything with variables to evaluate at the moment, and we maintain the invariant that any unevaluated terms buried inside a Value or Cont must carry along their environment with them.

Up Exn Store Cont

An exception has been raised. Keep unwinding the continuation stack (until finding an enclosing Try in the case of a command failure or a user-generated exception, or until the stack is empty in the case of a fatal exception).

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 Out and In: we store a Value that was just yielded by evaluation, and otherwise it is just like In with a hole for the Term we are going to evaluate.

Instances

Instances details
ToJSON CESK Source # 
Instance details

Defined in Swarm.Game.CESK

Generic CESK Source # 
Instance details

Defined in Swarm.Game.CESK

Associated Types

type Rep CESK 
Instance details

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))))))

Methods

from :: CESK -> Rep CESK x #

to :: Rep CESK x -> CESK #

PrettyPrec CESK Source # 
Instance details

Defined in Swarm.Game.CESK

Methods

prettyPrec :: Int -> CESK -> Doc ann

type Rep CESK Source # 
Instance details

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.

cancel :: CESK -> CESK Source #

Cancel the currently running computation.

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).

store :: Lens' CESK Store Source #

Lens focusing on the store of a CESK machine.

cont :: Lens' CESK Cont Source #

Lens focusing on the continuation of a CESK machine.