swarm-0.2.0.0: 2D resource gathering game with programmable robots
CopyrightBrent Yorgey
LicenseBSD-3-Clause
Maintainerbyorgey@gmail.com
Safe HaskellSafe-Inferred
LanguageHaskell2010

Swarm.Language.Syntax

Description

Abstract syntax for terms of the Swarm programming language.

Synopsis

Directions

data Direction Source #

The type of directions. Used e.g. to indicate which way a robot will turn.

Instances

Instances details
FromJSON Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

FromJSONKey Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

ToJSON Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

ToJSONKey Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Data Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Direction -> c Direction #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Direction #

toConstr :: Direction -> Constr #

dataTypeOf :: Direction -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Direction) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction) #

gmapT :: (forall b. Data b => b -> b) -> Direction -> Direction #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Direction -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Direction -> r #

gmapQ :: (forall d. Data d => d -> u) -> Direction -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Direction -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Direction -> m Direction #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Direction -> m Direction #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Direction -> m Direction #

Bounded Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Enum Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Generic Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Associated Types

type Rep Direction :: Type -> Type #

Read Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Show Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Ord Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

Hashable Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

PrettyPrec Direction Source # 
Instance details

Defined in Swarm.Language.Pretty

Methods

prettyPrec :: Int -> Direction -> Doc ann Source #

type Rep Direction Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep Direction = D1 ('MetaData "Direction" "Swarm.Language.Syntax" "swarm-0.2.0.0-D1mAmWsUEjoFqpCaq9DHG0" 'False) (((C1 ('MetaCons "DLeft" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DRight" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "DBack" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DForward" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "DNorth" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DSouth" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "DEast" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "DWest" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DDown" 'PrefixI 'False) (U1 :: Type -> Type)))))

data DirInfo Source #

Constructors

DirInfo 

applyTurn :: Direction -> V2 Int64 -> V2 Int64 Source #

The applyTurn function gives the meaning of each Direction by turning relative to the given vector or by turning to an absolute direction vector.

toDirection :: V2 Int64 -> Maybe Direction Source #

Possibly convert a vector into a Direction---that is, if the vector happens to be a unit vector in one of the cardinal directions.

fromDirection :: Direction -> V2 Int64 Source #

Convert a Direction into a corresponding vector. Note that this only does something reasonable for DNorth, DSouth, DEast, and DWest---other Directions return the zero vector.

isCardinal :: Direction -> Bool Source #

Check if the direction is absolute (e.g. north or south).

dirInfo :: Direction -> DirInfo Source #

Information about all directions

north :: V2 Int64 Source #

The cardinal direction north = V2 0 1.

south :: V2 Int64 Source #

The cardinal direction south = V2 0 (-1).

east :: V2 Int64 Source #

The cardinal direction east = V2 1 0.

west :: V2 Int64 Source #

The cardinal direction west = V2 (-1) 0.

Constants

data Const Source #

Constants, representing various built-in functions and commands.

IF YOU ADD A NEW CONSTANT, be sure to also update: 1. the constInfo function (below) 2. the capability checker (Swarm.Language.Capability) 3. the type checker (Swarm.Language.Typecheck) 4. the runtime (Swarm.Game.Step) 5. the emacs mode syntax highlighter (contribs/swarm-mode.el)

GHC will warn you about incomplete pattern matches for the first four, so it's not really possible to forget. Note you do not need to update the parser or pretty-printer, since they are auto-generated from constInfo.

Constructors

Noop

Do nothing. This is different than Wait in that it does not take up a time step.

Wait

Wait for a number of time steps without doing anything.

Selfdestruct

Self-destruct.

Move

Move forward one step.

Turn

Turn in some direction.

Grab

Grab an item from the current location.

Harvest

Harvest an item from the current location.

Place

Try to place an item at the current location.

Give

Give an item to another robot at the current location.

Install

Install a device on a robot.

Make

Make an item.

Has

Sense whether we have a certain item.

Installed

Sense whether we have a certain device installed.

Count

Sense how many of a certain item we have.

Drill

Drill through an entity.

Build

Construct a new robot.

Salvage

Deconstruct an old robot.

Reprogram

Reprogram a robot that has executed it's command with a new command

Say

Emit a message.

Listen

Listen for a message from other robots.

Log

Emit a log message.

View

View a certain robot.

Appear

Set what characters are used for display.

Create

Create an entity out of thin air. Only available in creative mode.

Time

Get current time

Whereami

Get the current x, y coordinates

Blocked

See if we can move forward or not.

Scan

Scan a nearby cell

Upload

Upload knowledge to another robot

Ishere

See if a specific entity is here. (This may be removed.)

Self

Get a reference to oneself

Parent

Get the robot's parent

Base

Get a reference to the base

Whoami

Get the robot's display name

Setname

Set the robot's display name

Random

Get a uniformly random integer.

Run

Run a program loaded from a file.

If

If-expressions.

Inl

Left injection.

Inr

Right injection.

Case

Case analysis on a sum type.

Fst

First projection.

Snd

Second projection.

Force

Force a delayed evaluation.

Return

Return for the cmd monad.

Try

Try/catch block

Undefined

Undefined

Fail

User error

Not

Logical negation.

Neg

Arithmetic negation.

Eq

Logical equality comparison

Neq

Logical unequality comparison

Lt

Logical lesser-then comparison

Gt

Logical greater-then comparison

Leq

Logical lesser-or-equal comparison

Geq

Logical greater-or-equal comparison

Or

Logical or.

And

Logical and.

Add

Arithmetic addition operator

Sub

Arithmetic subtraction operator

Mul

Arithmetic multiplication operator

Div

Arithmetic division operator

Exp

Arithmetic exponentiation operator

Format

Turn an arbitrary value into a string

Concat

Concatenate string values

Chars

Count number of characters.

Split

Split string into two parts.

AppF

Application operator - helps to avoid parentheses: f $ g $ h x = f (g (h x))

Swap

Swap placed entity with one in inventory. Essentially atomic grab and place.

Atomic

When executing atomic c, a robot will not be interrupted, that is, no other robots will execute any commands while the robot is executing c.

Teleport

Teleport a robot to the given position.

As

Run a command as if you were another robot.

RobotNamed

Find a robot by name.

RobotNumbered

Find a robot by number.

Knows

Check if an entity is known.

Instances

Instances details
FromJSON Const Source # 
Instance details

Defined in Swarm.Language.Syntax

ToJSON Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Data Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Const -> c Const #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Const #

toConstr :: Const -> Constr #

dataTypeOf :: Const -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Const) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const) #

gmapT :: (forall b. Data b => b -> b) -> Const -> Const #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r #

gmapQ :: (forall d. Data d => d -> u) -> Const -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Const -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Const -> m Const #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Const -> m Const #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Const -> m Const #

Bounded Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Enum Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Generic Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Associated Types

type Rep Const :: Type -> Type #

Methods

from :: Const -> Rep Const x #

to :: Rep Const x -> Const #

Show Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

showsPrec :: Int -> Const -> ShowS #

show :: Const -> String #

showList :: [Const] -> ShowS #

Eq Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

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

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

Ord Const Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

compare :: Const -> Const -> Ordering #

(<) :: Const -> Const -> Bool #

(<=) :: Const -> Const -> Bool #

(>) :: Const -> Const -> Bool #

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

max :: Const -> Const -> Const #

min :: Const -> Const -> Const #

PrettyPrec Const Source # 
Instance details

Defined in Swarm.Language.Pretty

Methods

prettyPrec :: Int -> Const -> Doc ann Source #

type Rep Const Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep Const = D1 ('MetaData "Const" "Swarm.Language.Syntax" "swarm-0.2.0.0-D1mAmWsUEjoFqpCaq9DHG0" 'False) ((((((C1 ('MetaCons "Noop" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Wait" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Selfdestruct" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Move" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Turn" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Grab" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Harvest" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Place" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Give" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "Install" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Make" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Has" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Installed" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Count" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Drill" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Build" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Salvage" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Reprogram" 'PrefixI 'False) (U1 :: Type -> Type)))))) :+: ((((C1 ('MetaCons "Say" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Listen" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Log" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "View" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Appear" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Create" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Time" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Whereami" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Blocked" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "Scan" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Upload" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Ishere" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Self" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Parent" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "Base" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Whoami" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Setname" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Random" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Run" 'PrefixI 'False) (U1 :: Type -> Type))))))) :+: (((((C1 ('MetaCons "If" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Inl" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Inr" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Case" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Fst" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Snd" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Force" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Return" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Try" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "Undefined" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Fail" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Not" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Neg" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Eq" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "Neq" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Lt" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Gt" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Leq" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Geq" 'PrefixI 'False) (U1 :: Type -> Type)))))) :+: ((((C1 ('MetaCons "Or" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "And" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Add" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Sub" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Mul" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Div" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Exp" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Format" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Concat" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "Chars" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Split" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "AppF" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Swap" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Atomic" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "Teleport" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "As" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "RobotNamed" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "RobotNumbered" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Knows" 'PrefixI 'False) (U1 :: Type -> Type))))))))

data ConstInfo Source #

Constructors

ConstInfo 

Fields

Instances

Instances details
Show ConstInfo Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq ConstInfo Source # 
Instance details

Defined in Swarm.Language.Syntax

Ord ConstInfo Source # 
Instance details

Defined in Swarm.Language.Syntax

data ConstDoc Source #

Constructors

ConstDoc 

Fields

Instances

Instances details
IsString ConstDoc Source # 
Instance details

Defined in Swarm.Language.Syntax

Show ConstDoc Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq ConstDoc Source # 
Instance details

Defined in Swarm.Language.Syntax

Ord ConstDoc Source # 
Instance details

Defined in Swarm.Language.Syntax

data ConstMeta Source #

Constructors

ConstMFunc Int Bool

Function with arity of which some are commands

ConstMUnOp MUnAssoc

Unary operator with fixity and associativity.

ConstMBinOp MBinAssoc

Binary operator with fixity and associativity.

Instances

Instances details
Show ConstMeta Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq ConstMeta Source # 
Instance details

Defined in Swarm.Language.Syntax

Ord ConstMeta Source # 
Instance details

Defined in Swarm.Language.Syntax

data MBinAssoc Source #

The meta type representing associativity of binary operator.

Constructors

L

Left associative binary operator (see InfixL)

N

Non-associative binary operator (see InfixN)

R

Right associative binary operator (see InfixR)

Instances

Instances details
Show MBinAssoc Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq MBinAssoc Source # 
Instance details

Defined in Swarm.Language.Syntax

Ord MBinAssoc Source # 
Instance details

Defined in Swarm.Language.Syntax

data MUnAssoc Source #

The meta type representing associativity of unary operator.

Constructors

P

Prefix unary operator (see Prefix)

S

Suffix unary operator (see Suffix)

Instances

Instances details
Show MUnAssoc Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq MUnAssoc Source # 
Instance details

Defined in Swarm.Language.Syntax

Ord MUnAssoc Source # 
Instance details

Defined in Swarm.Language.Syntax

constInfo :: Const -> ConstInfo Source #

Information about constants used in parsing and pretty printing.

It would be more compact to represent the information by testing whether the constants are in certain sets, but using pattern matching gives us warning if we add more constants.

arity :: Const -> Int Source #

The arity of a constant, i.e. how many arguments it expects. The runtime system will collect arguments to a constant (see VCApp) until it has enough, then dispatch the constant's behavior.

isCmd :: Const -> Bool Source #

Whether a constant represents a command. Constants which are not commands are functions which are interpreted as soon as they are evaluated. Commands, on the other hand, are not interpreted until being executed, that is, when meeting an FExec frame. When evaluated, commands simply turn into a VCApp.

isUserFunc :: Const -> Bool Source #

Function constants user can call with reserved words (wait,...).

isOperator :: Const -> Bool Source #

Whether the constant is an operator. Useful predicate for documentation.

isBuiltinFunction :: Const -> Bool Source #

Whether the constant is a function which is interpreted as soon as it is evaluated, but *not* including operators.

Note: This is used for documentation purposes and complements isCmd and isOperator in that exactly one will accept a given constant.

isTangible :: Const -> Bool Source #

Whether the constant is a tangible command, that has an external effect on the world. At most one tangible command may be executed per tick.

isLong :: Const -> Bool Source #

Whether the constant is a long command, that is, a tangible command which could require multiple ticks to execute. Such commands cannot be allowed in atomic blocks.

Syntax

data Syntax Source #

The surface syntax for the language

Constructors

Syntax 

Fields

Instances

Instances details
FromJSON Syntax Source # 
Instance details

Defined in Swarm.Language.Syntax

ToJSON Syntax Source # 
Instance details

Defined in Swarm.Language.Syntax

Data Syntax Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Syntax -> c Syntax #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Syntax #

toConstr :: Syntax -> Constr #

dataTypeOf :: Syntax -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Syntax) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Syntax) #

gmapT :: (forall b. Data b => b -> b) -> Syntax -> Syntax #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r #

gmapQ :: (forall d. Data d => d -> u) -> Syntax -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Syntax -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Syntax -> m Syntax #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Syntax -> m Syntax #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Syntax -> m Syntax #

Generic Syntax Source # 
Instance details

Defined in Swarm.Language.Syntax

Associated Types

type Rep Syntax :: Type -> Type #

Methods

from :: Syntax -> Rep Syntax x #

to :: Rep Syntax x -> Syntax #

Show Syntax Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq Syntax Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

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

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

type Rep Syntax Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep Syntax = D1 ('MetaData "Syntax" "Swarm.Language.Syntax" "swarm-0.2.0.0-D1mAmWsUEjoFqpCaq9DHG0" 'False) (C1 ('MetaCons "Syntax" 'PrefixI 'True) (S1 ('MetaSel ('Just "sLoc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Location) :*: S1 ('MetaSel ('Just "sTerm") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Term)))

data Location Source #

Constructors

NoLoc 
Location Int Int 

Instances

Instances details
FromJSON Location Source # 
Instance details

Defined in Swarm.Language.Syntax

ToJSON Location Source # 
Instance details

Defined in Swarm.Language.Syntax

Data Location Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Location -> c Location #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Location #

toConstr :: Location -> Constr #

dataTypeOf :: Location -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Location) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Location) #

gmapT :: (forall b. Data b => b -> b) -> Location -> Location #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Location -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Location -> r #

gmapQ :: (forall d. Data d => d -> u) -> Location -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Location -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Location -> m Location #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Location -> m Location #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Location -> m Location #

Monoid Location Source # 
Instance details

Defined in Swarm.Language.Syntax

Semigroup Location Source # 
Instance details

Defined in Swarm.Language.Syntax

Generic Location Source # 
Instance details

Defined in Swarm.Language.Syntax

Associated Types

type Rep Location :: Type -> Type #

Methods

from :: Location -> Rep Location x #

to :: Rep Location x -> Location #

Show Location Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq Location Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep Location Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep Location = D1 ('MetaData "Location" "Swarm.Language.Syntax" "swarm-0.2.0.0-D1mAmWsUEjoFqpCaq9DHG0" 'False) (C1 ('MetaCons "NoLoc" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Location" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)))

pattern STerm :: Term -> Syntax Source #

Match a term without its a syntax

pattern TPair :: Term -> Term -> Term Source #

Match a TPair without syntax

pattern TLam :: Var -> Maybe Type -> Term -> Term Source #

Match a TLam without syntax

pattern TApp :: Term -> Term -> Term Source #

Match a TApp without syntax

pattern (:$:) :: Term -> Syntax -> Term infixl 0 Source #

Convenient infix pattern synonym for application.

pattern TLet :: Bool -> Var -> Maybe Polytype -> Term -> Term -> Term Source #

Match a TLet without syntax

pattern TDef :: Bool -> Var -> Maybe Polytype -> Term -> Term Source #

Match a TDef without syntax

pattern TBind :: Maybe Var -> Term -> Term -> Term Source #

Match a TBind without syntax

pattern TDelay :: DelayType -> Term -> Term Source #

Match a TDelay without syntax

Terms

type Var = Text Source #

We use Text values to represent variables.

data DelayType Source #

COMPLETE pragma tells GHC using this set of pattern is complete for Term

Different runtime behaviors for delayed expressions.

Constructors

SimpleDelay

A simple delay, implemented via a (non-memoized) VDelay holding the delayed expression.

MemoizedDelay (Maybe Var)

A memoized delay, implemented by allocating a mutable cell with the delayed expression and returning a reference to it. When the Maybe Var is Just, a recursive binding of the variable with a reference to the delayed expression will be provided while evaluating the delayed expression itself. Note that there is no surface syntax for binding a variable within a recursive delayed expression; the only way we can get Just here is when we automatically generate a delayed expression while interpreting a recursive let or def.

Instances

Instances details
FromJSON DelayType Source # 
Instance details

Defined in Swarm.Language.Syntax

ToJSON DelayType Source # 
Instance details

Defined in Swarm.Language.Syntax

Data DelayType Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DelayType -> c DelayType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DelayType #

toConstr :: DelayType -> Constr #

dataTypeOf :: DelayType -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c DelayType) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelayType) #

gmapT :: (forall b. Data b => b -> b) -> DelayType -> DelayType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DelayType -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DelayType -> r #

gmapQ :: (forall d. Data d => d -> u) -> DelayType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DelayType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DelayType -> m DelayType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DelayType -> m DelayType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DelayType -> m DelayType #

Generic DelayType Source # 
Instance details

Defined in Swarm.Language.Syntax

Associated Types

type Rep DelayType :: Type -> Type #

Show DelayType Source # 
Instance details

Defined in Swarm.Language.Syntax

Eq DelayType Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep DelayType Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep DelayType = D1 ('MetaData "DelayType" "Swarm.Language.Syntax" "swarm-0.2.0.0-D1mAmWsUEjoFqpCaq9DHG0" 'False) (C1 ('MetaCons "SimpleDelay" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MemoizedDelay" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Var))))

data Term Source #

Terms of the Swarm language.

Constructors

TUnit

The unit value.

TConst Const

A constant.

TDir Direction

A direction literal.

TInt Integer

An integer literal.

TAntiInt Text

An antiquoted Haskell variable name of type Integer.

TText Text

A text literal.

TAntiText Text

An antiquoted Haskell variable name of type Text.

TBool Bool

A Boolean literal.

TRobot Int

A robot value. These never show up in surface syntax, but are here so we can factor pretty-printing for Values through pretty-printing for Terms.

TRef Int

A memory reference. These likewise never show up in surface syntax, but are here to facilitate pretty-printing.

TRequireDevice Text

Require a specific device to be installed.

TRequire Int Text

Require a certain number of an entity.

TVar Var

A variable.

SPair Syntax Syntax

A pair.

SLam Var (Maybe Type) Syntax

A lambda expression, with or without a type annotation on the binder.

SApp Syntax Syntax

Function application.

SLet Bool Var (Maybe Polytype) Syntax Syntax

A (recursive) let expression, with or without a type annotation on the variable. The Bool indicates whether it is known to be recursive.

SDef Bool Var (Maybe Polytype) Syntax

A (recursive) definition command, which binds a variable to a value in subsequent commands. The Bool indicates whether the definition is known to be recursive.

SBind (Maybe Var) Syntax Syntax

A monadic bind for commands, of the form c1 ; c2 or x <- c1; c2.

SDelay DelayType Syntax

Delay evaluation of a term, written {...}. Swarm is an eager language, but in some cases (e.g. for if statements and recursive bindings) we need to delay evaluation. The counterpart to {...} is force, where force {t} = t. Note that Force is just a constant, whereas SDelay has to be a special syntactic form so its argument can get special treatment during evaluation.

Instances

Instances details
FromJSON Term Source # 
Instance details

Defined in Swarm.Language.Syntax

ToJSON Term Source # 
Instance details

Defined in Swarm.Language.Syntax

Data Term Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Term -> c Term #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Term #

toConstr :: Term -> Constr #

dataTypeOf :: Term -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Term) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Term) #

gmapT :: (forall b. Data b => b -> b) -> Term -> Term #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r #

gmapQ :: (forall d. Data d => d -> u) -> Term -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Term -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Term -> m Term #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Term -> m Term #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Term -> m Term #

Generic Term Source # 
Instance details

Defined in Swarm.Language.Syntax

Associated Types

type Rep Term :: Type -> Type #

Methods

from :: Term -> Rep Term x #

to :: Rep Term x -> Term #

Show Term Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

showsPrec :: Int -> Term -> ShowS #

show :: Term -> String #

showList :: [Term] -> ShowS #

Eq Term Source # 
Instance details

Defined in Swarm.Language.Syntax

Methods

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

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

Plated Term Source # 
Instance details

Defined in Swarm.Language.Syntax

PrettyPrec Term Source # 
Instance details

Defined in Swarm.Language.Pretty

Methods

prettyPrec :: Int -> Term -> Doc ann Source #

type Rep Term Source # 
Instance details

Defined in Swarm.Language.Syntax

type Rep Term = D1 ('MetaData "Term" "Swarm.Language.Syntax" "swarm-0.2.0.0-D1mAmWsUEjoFqpCaq9DHG0" 'False) ((((C1 ('MetaCons "TUnit" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TConst" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Const))) :+: (C1 ('MetaCons "TDir" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Direction)) :+: (C1 ('MetaCons "TInt" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer)) :+: C1 ('MetaCons "TAntiInt" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text))))) :+: ((C1 ('MetaCons "TText" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text)) :+: C1 ('MetaCons "TAntiText" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text))) :+: (C1 ('MetaCons "TBool" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool)) :+: (C1 ('MetaCons "TRobot" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)) :+: C1 ('MetaCons "TRef" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)))))) :+: (((C1 ('MetaCons "TRequireDevice" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text)) :+: C1 ('MetaCons "TRequire" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text))) :+: (C1 ('MetaCons "TVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var)) :+: (C1 ('MetaCons "SPair" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax)) :+: C1 ('MetaCons "SLam" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Type)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax)))))) :+: ((C1 ('MetaCons "SApp" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax)) :+: C1 ('MetaCons "SLet" '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 (Maybe Polytype)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax))))) :+: (C1 ('MetaCons "SDef" '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 (Maybe Polytype)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax))) :+: (C1 ('MetaCons "SBind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Var)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax))) :+: C1 ('MetaCons "SDelay" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 DelayType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Syntax)))))))

mkOp :: Const -> Syntax -> Syntax -> Syntax Source #

Make infix operation (e.g. 2 + 3) a curried function application (((+) 2) 3).

mkOp' :: Const -> Term -> Term -> Term Source #

Make infix operation, discarding any syntax related location

Term traversal

fvT :: Traversal' Term Term Source #

Traversal over those subterms of a term which represent free variables.

fv :: Traversal' Term Var Source #

Traversal over the free variables of a term. Note that if you want to get the set of all free variables, you can do so via setOf fv.

mapFree1 :: Var -> (Term -> Term) -> Term -> Term Source #

Apply a function to all free occurrences of a particular variable.