swarm-0.5.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.

VDef :: Bool -> Var -> Term -> Env -> Value

A definition, which does not take effect until executed. The Bool indicates whether the definition is recursive.

VResult :: Value -> Env -> Value

The result of a command, consisting of the result of the command as well as an environment of bindings from TDef commands.

VBind :: Maybe Var -> 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.

VRcd :: Map Var Value -> Value

A record value.

VKey :: KeyCombo -> Value

A keyboard input.

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

A requirements command awaiting execution.

Instances

Instances details
FromJSON Value Source # 
Instance details

Defined in Swarm.Language.Value

ToJSON Value Source # 
Instance details

Defined in Swarm.Language.Value

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.5.0.0-6qXEbhCmuXA4wRndqqhBu" '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 "VDef" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: 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 "VResult" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Value) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Env)) :+: 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 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 "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))))))))

stripVResult :: Value -> Value Source #

Ensure that a value is not wrapped in VResult.

prettyValue :: Value -> Text Source #

Pretty-print a value.

valueToTerm :: Value -> Term Source #

Inject a value back into a term.

Environments

type Env = Ctx Value Source #

An environment is a mapping from variable names to values.