swarm-0.6.0.0: 2D resource gathering game with programmable robots
LicenseBSD-3-Clause
Safe HaskellSafe-Inferred
LanguageHaskell2010

Swarm.Language.Value

Description

Values and environments used for interpreting the Swarm language.

Synopsis

Values

data Value where Source #

A value is a term that cannot (or does not) take any more evaluation steps on its own.

Constructors

VUnit :: Value

The unit value.

VInt :: Integer -> Value

An integer.

VText :: Text -> Value

Literal text.

VDir :: Direction -> Value

A direction.

VBool :: Bool -> Value

A boolean.

VRobot :: Int -> Value

A reference to a robot.

VInj :: Bool -> Value -> Value

An injection into a sum type. False = left, True = right.

VPair :: Value -> Value -> Value

A pair.

VClo :: Var -> Term -> Env -> Value

A closure, representing a lambda term along with an environment containing bindings for any free variables in the body of the lambda.

VCApp :: Const -> [Value] -> Value

An application of a constant to some value arguments, potentially waiting for more arguments. If a constant application is fully saturated (as defined by its arity), whether it is a value or not depends on whether or not it represents a command (as defined by isCmd). If a command (e.g. Build), it is a value, and awaits an FExec frame which will cause it to execute. Otherwise (e.g. If), it is not a value, and will immediately reduce.

VBind :: Maybe Var -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Env -> Value

An unevaluated bind expression, waiting to be executed, of the form i.e. c1 ; c2 or x <- c1; c2. We also store an Env in which to interpret the commands.

VDelay :: Term -> Env -> Value

A (non-recursive) delayed term, along with its environment. If a term would otherwise be evaluated but we don't want it to be (e.g. as in the case of arguments to an 'if', or a recursive binding), we can stick a TDelay on it, which turns it into a value. Delayed terms won't be evaluated until Force is applied to them.

VRef :: Int -> Value

A reference to a memory cell in the store.

VIndir :: Int -> Value

An indirection to a value stored in a memory cell. The difference between VRef and VIndir is that VRef is a "real" value (of Ref type), whereas VIndir is just a placeholder. If a VRef is encountered during evaluation, it is the final result; if VIndir is encountered during evaluation, the value it points to should be looked up.

VRcd :: Map Var Value -> Value

A record value.

VKey :: KeyCombo -> Value

A keyboard input.

VRequirements :: Text -> Term -> Env -> Value

A requirements command awaiting execution.

VSuspend :: Term -> Env -> Value

A suspend command awaiting execution.

VExc :: Value

A special value representing a program that terminated with an exception.

VBlackhole :: Value

A special value used temporarily as the value for a variable bound by a recursive let, while its definition is being evaluated. If the variable is ever referenced again while its value is still VBlackhole, that means it depends on itself in a way that would trigger an infinite loop, and we can signal an error. (Of course, we <http://www.lel.ed.ac.uk/~gpullum/loopsnoop.html cannot detect all infinite loops this way>.)

Instances

Instances details
FromJSON Value Source # 
Instance details

Defined in Swarm.Language.JSON

ToJSON Value Source # 
Instance details

Defined in Swarm.Language.JSON

Generic Value Source # 
Instance details

Defined in Swarm.Language.Value

Associated Types

type Rep Value :: Type -> Type #

Methods

from :: Value -> Rep Value x #

to :: Rep Value x -> Value #

Show Value Source # 
Instance details

Defined in Swarm.Language.Value

Methods

showsPrec :: Int -> Value -> ShowS #

show :: Value -> String #

showList :: [Value] -> ShowS #

Eq Value Source # 
Instance details

Defined in Swarm.Language.Value

Methods

(==) :: Value -> Value -> Bool #

(/=) :: Value -> Value -> Bool #

type Rep Value Source # 
Instance details

Defined in Swarm.Language.Value

type Rep Value = D1 ('MetaData "Value" "Swarm.Language.Value" "swarm-0.6.0.0-ERx1HMcRMba59aI2b6aNrS-swarm-lang" 'False) ((((C1 ('MetaCons "VUnit" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "VInt" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer))) :+: (C1 ('MetaCons "VText" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text)) :+: (C1 ('MetaCons "VDir" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Direction)) :+: C1 ('MetaCons "VBool" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool))))) :+: ((C1 ('MetaCons "VRobot" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)) :+: C1 ('MetaCons "VInj" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value))) :+: (C1 ('MetaCons "VPair" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value)) :+: (C1 ('MetaCons "VClo" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env))) :+: C1 ('MetaCons "VCApp" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Const) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [Value])))))) :+: (((C1 ('MetaCons "VBind" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Var)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Polytype)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Requirements)))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)))) :+: C1 ('MetaCons "VDelay" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env))) :+: (C1 ('MetaCons "VRef" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)) :+: (C1 ('MetaCons "VIndir" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)) :+: C1 ('MetaCons "VRcd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Map Var Value)))))) :+: ((C1 ('MetaCons "VKey" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 KeyCombo)) :+: C1 ('MetaCons "VRequirements" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)))) :+: (C1 ('MetaCons "VSuspend" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: (C1 ('MetaCons "VExc" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "VBlackhole" 'PrefixI 'False) (U1 :: Type -> Type))))))

prettyValue :: Value -> Text Source #

Pretty-print a value.

valueToTerm :: Value -> Term Source #

Inject a value back into a term.

Environments

data Env Source #

An environment is a record that stores relevant information for all the variables currently in scope.

Instances

Instances details
FromJSON Env Source # 
Instance details

Defined in Swarm.Language.JSON

ToJSON Env Source # 
Instance details

Defined in Swarm.Language.JSON

Monoid Env Source # 
Instance details

Defined in Swarm.Language.Value

Methods

mempty :: Env #

mappend :: Env -> Env -> Env #

mconcat :: [Env] -> Env #

Semigroup Env Source # 
Instance details

Defined in Swarm.Language.Value

Methods

(<>) :: Env -> Env -> Env #

sconcat :: NonEmpty Env -> Env #

stimes :: Integral b => b -> Env -> Env #

Generic Env Source # 
Instance details

Defined in Swarm.Language.Value

Associated Types

type Rep Env :: Type -> Type #

Methods

from :: Env -> Rep Env x #

to :: Rep Env x -> Env #

Show Env Source # 
Instance details

Defined in Swarm.Language.Value

Methods

showsPrec :: Int -> Env -> ShowS #

show :: Env -> String #

showList :: [Env] -> ShowS #

Eq Env Source # 
Instance details

Defined in Swarm.Language.Value

Methods

(==) :: Env -> Env -> Bool #

(/=) :: Env -> Env -> Bool #

At Env Source # 
Instance details

Defined in Swarm.Language.Value

Methods

at :: Index Env -> Lens' Env (Maybe (IxValue Env)) #

Ixed Env Source # 
Instance details

Defined in Swarm.Language.Value

AsEmpty Env Source # 
Instance details

Defined in Swarm.Language.Value

Methods

_Empty :: Prism' Env () #

type Rep Env Source # 
Instance details

Defined in Swarm.Language.Value

type Rep Env
type Index Env Source # 
Instance details

Defined in Swarm.Language.Value

type Index Env = Var
type IxValue Env Source # 
Instance details

Defined in Swarm.Language.Value

addValueBinding :: Var -> Value -> Env -> Env Source #

Add a binding of a variable to a value *only* (no type and requirements). NOTE that if we then try to look up the variable name using the At instance for Env, it will report Nothing! lookupValue will work though.