License | BSD-3-Clause |
---|---|
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Swarm.Language.Syntax
Description
Abstract syntax for terms of the Swarm programming language.
Synopsis
- data Const
- = Noop
- | Wait
- | Selfdestruct
- | Move
- | Backup
- | Volume
- | Path
- | Push
- | Stride
- | Turn
- | Grab
- | Harvest
- | Sow
- | Ignite
- | Place
- | Ping
- | Give
- | Equip
- | Unequip
- | Make
- | Has
- | Equipped
- | Count
- | Drill
- | Use
- | Build
- | Salvage
- | Reprogram
- | Say
- | Listen
- | Log
- | View
- | Appear
- | Create
- | Halt
- | Time
- | Scout
- | Whereami
- | Waypoint
- | Structure
- | Floorplan
- | HasTag
- | TagMembers
- | Detect
- | Resonate
- | Density
- | Sniff
- | Chirp
- | Watch
- | Surveil
- | Heading
- | Blocked
- | Scan
- | Upload
- | Ishere
- | Isempty
- | Self
- | Parent
- | Base
- | Meet
- | MeetAll
- | Whoami
- | Setname
- | Random
- | Run
- | If
- | Inl
- | Inr
- | Case
- | Fst
- | Snd
- | Force
- | Return
- | Try
- | Undefined
- | Fail
- | Not
- | Neg
- | Eq
- | Neq
- | Lt
- | Gt
- | Leq
- | Geq
- | Or
- | And
- | Add
- | Sub
- | Mul
- | Div
- | Exp
- | Format
- | Concat
- | Chars
- | Split
- | CharAt
- | ToChar
- | AppF
- | Swap
- | Atomic
- | Instant
- | Key
- | InstallKeyHandler
- | Teleport
- | As
- | RobotNamed
- | RobotNumbered
- | Knows
- allConst :: [Const]
- data ConstInfo = ConstInfo {}
- data ConstDoc = ConstDoc {
- effectInfo :: Set CommandEffect
- briefDoc :: Text
- longDoc :: Text
- data ConstMeta
- data MBinAssoc
- data MUnAssoc
- constInfo :: Const -> ConstInfo
- arity :: Const -> Int
- isCmd :: Const -> Bool
- isUserFunc :: Const -> Bool
- isOperator :: Const -> Bool
- isBuiltinFunction :: Const -> Bool
- isTangible :: Const -> Bool
- isLong :: Const -> Bool
- maxSniffRange :: Int32
- maxScoutRange :: Int
- maxStrideRange :: Int
- maxPathRange :: Integer
- globalMaxVolume :: Integer
- data SrcLoc
- srcLocBefore :: SrcLoc -> SrcLoc -> Bool
- noLoc :: Term -> Syntax
- data CommentType
- data CommentSituation
- isStandalone :: Comment -> Bool
- data Comment = Comment {}
- data Comments = Comments {}
- beforeComments :: Lens' Comments (Seq Comment)
- afterComments :: Lens' Comments (Seq Comment)
- data Syntax' ty = Syntax' {}
- sLoc :: forall ty. Lens' (Syntax' ty) SrcLoc
- sTerm :: forall ty. Lens' (Syntax' ty) (Term' ty)
- sType :: forall ty. Lens' (Syntax' ty) ty
- sComments :: forall ty. Lens' (Syntax' ty) Comments
- type Syntax = Syntax' ()
- type TSyntax = Syntax' Polytype
- type USyntax = Syntax' UType
- pattern Syntax :: SrcLoc -> Term -> Syntax
- pattern CSyntax :: SrcLoc -> Term -> Comments -> Syntax
- data LocVar = LV {}
- data LetSyntax
- pattern STerm :: Term -> Syntax
- pattern TRequirements :: Text -> Term -> Term
- pattern TPair :: Term -> Term -> Term
- pattern TLam :: Var -> Maybe Type -> Term -> Term
- pattern TApp :: Term -> Term -> Term
- pattern (:$:) :: Term -> Syntax -> Term
- pattern TLet :: LetSyntax -> Bool -> Var -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term
- pattern TTydef :: Var -> Polytype -> Maybe TydefInfo -> Term -> Term
- pattern TBind :: Maybe Var -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term
- pattern TDelay :: Term -> Term
- pattern TRcd :: Map Var (Maybe Term) -> Term
- pattern TProj :: Term -> Var -> Term
- pattern TAnnotate :: Term -> Polytype -> Term
- pattern TSuspend :: Term -> Term
- type Var = Text
- data DelayType
- = SimpleDelay
- | MemoizedDelay (Maybe Var)
- data Term' ty
- = TUnit
- | TConst Const
- | TDir Direction
- | TInt Integer
- | TAntiInt Text
- | TText Text
- | TAntiText Text
- | TBool Bool
- | TRobot Int
- | TRef Int
- | TRequireDevice Text
- | TRequire Int Text
- | SRequirements Text (Syntax' ty)
- | TVar Var
- | SPair (Syntax' ty) (Syntax' ty)
- | SLam LocVar (Maybe Type) (Syntax' ty)
- | SApp (Syntax' ty) (Syntax' ty)
- | SLet LetSyntax Bool LocVar (Maybe Polytype) (Maybe Requirements) (Syntax' ty) (Syntax' ty)
- | STydef LocVar Polytype (Maybe TydefInfo) (Syntax' ty)
- | SBind (Maybe LocVar) (Maybe ty) (Maybe Polytype) (Maybe Requirements) (Syntax' ty) (Syntax' ty)
- | SDelay (Syntax' ty)
- | SRcd (Map Var (Maybe (Syntax' ty)))
- | SProj (Syntax' ty) Var
- | SAnnotate (Syntax' ty) Polytype
- | SSuspend (Syntax' ty)
- type Term = Term' ()
- type TTerm = Term' Polytype
- type UTerm = Term' UType
- mkOp :: Const -> Syntax -> Syntax -> Syntax
- mkOp' :: Const -> Term -> Term -> Term
- unfoldApps :: Syntax' ty -> NonEmpty (Syntax' ty)
- mkTuple :: [Syntax] -> Syntax
- unTuple :: Syntax' ty -> [Syntax' ty]
- erase :: Functor t => t ty -> t ()
- eraseS :: Syntax' ty -> Term
- freeVarsS :: forall ty. Traversal' (Syntax' ty) (Syntax' ty)
- freeVarsT :: forall ty. Traversal' (Syntax' ty) (Term' ty)
- freeVarsV :: Traversal' (Syntax' ty) Var
- mapFreeS :: Var -> (Syntax' ty -> Syntax' ty) -> Syntax' ty -> Syntax' ty
- locVarToSyntax' :: LocVar -> ty -> Syntax' ty
- asTree :: Data a => Syntax' a -> Tree (Syntax' a)
- measureAstSize :: Data a => Syntax' a -> Int
Constants
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, and CI will warn you about the last, so in theory 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 | Wait for a number of time steps without doing anything. |
Selfdestruct | Self-destruct. |
Move | Move forward one step. |
Backup | Move backward one step. |
Volume | Measure the size of the enclosed volume |
Path | Describe a path to the destination. |
Push | Push an entity forward one step. |
Stride | Move forward multiple steps. |
Turn | Turn in some direction. |
Grab | Grab an item from the current location. |
Harvest | Harvest an item from the current location. |
Sow | Scatter seeds of a plant |
Ignite | Ignite a combustible item |
Place | Try to place an item at the current location. |
Ping | Obtain the relative location of another robot. |
Give | Give an item to another robot at the current location. |
Equip | Equip a device on oneself. |
Unequip | Unequip an equipped device, returning to inventory. |
Make | Make an item. |
Has | Sense whether we have a certain item. |
Equipped | Sense whether we have a certain device equipped. |
Count | Sense how many of a certain item we have. |
Drill | Drill through an entity. |
Use | Use an entity with another. |
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 color and what characters are used for display. |
Create | Create an entity out of thin air. Only available in creative mode. |
Halt | Tell a robot to halt. |
Time | Get current time |
Scout | |
Whereami | Get the current x, y coordinates |
Waypoint | Get the x, y coordinates of a named waypoint, by index |
Structure | Get the x, y coordinates of southwest corner of a constructed structure, by index |
Floorplan | Get the width and height of a structure template |
HasTag | Answer whether a given entity has the given tag |
TagMembers | Cycle through the entity names that are labeled with a given tag |
Detect | Locate the closest instance of a given entity within the rectangle specified by opposite corners, relative to the current location. |
Resonate | Count the number of a given entity within the rectangle specified by opposite corners, relative to the current location. |
Density | Count the number entities within the rectangle specified by opposite corners, relative to the current location. |
Sniff | Get the distance to the closest instance of the specified entity. |
Chirp | Get the direction to the closest instance of the specified entity. |
Watch | Register a location to interrupt a |
Surveil | Register a (remote) location to interrupt a |
Heading | Get the current heading. |
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. |
Isempty | Check whether the current cell is empty |
Self | Get a reference to oneself |
Parent | Get the robot's parent |
Base | Get a reference to the base |
Meet | Meet a nearby robot |
MeetAll | Meet all nearby robots |
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 inequality 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. |
CharAt | Get the character at an index. |
ToChar | Create a singleton text value with the given character code. |
AppF | Application operator - helps to avoid parentheses:
|
Swap | Swap placed entity with one in inventory. Essentially atomic grab and place. |
Atomic | When executing |
Instant | Like |
Key | Create |
InstallKeyHandler | Install a new keyboard input handler. |
Teleport | Teleport a robot to the given position. |
As | Run a command as if you were another robot. |
RobotNamed | Find an actor by name. |
RobotNumbered | Find an actor by number. |
Knows | Check if an entity is known. |
Instances
Constructors
ConstInfo | |
Instances
Show ConstInfo Source # | |
Eq ConstInfo Source # | |
Ord ConstInfo Source # | |
Constructors
ConstDoc | |
Fields
|
Constructors
ConstMFunc | 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
Show ConstMeta Source # | |
Eq ConstMeta Source # | |
Ord ConstMeta Source # | |
The meta type representing associativity of binary operator.
Constructors
L | Left associative binary operator (see |
N | Non-associative binary operator (see |
R | Right associative binary operator (see |
Instances
Show MBinAssoc Source # | |
Eq MBinAssoc Source # | |
Ord MBinAssoc Source # | |
The meta type representing associativity of unary operator.
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.
Size limits
maxScoutRange :: Int Source #
maxStrideRange :: Int Source #
globalMaxVolume :: Integer Source #
Checked upon invocation of the command, before flood fill computation, to ensure the search has a reasonable bound.
The user is warned in the failure message that there exists a global limit.
SrcLoc
The location of something in the textual source code (recorded as an interval measured in terms of indices into the input stream).
Instances
FromJSON SrcLoc Source # | |
Defined in Swarm.Language.Syntax.Loc | |
ToJSON SrcLoc Source # | |
Data SrcLoc Source # | |
Defined in Swarm.Language.Syntax.Loc Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SrcLoc -> c SrcLoc # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SrcLoc # toConstr :: SrcLoc -> Constr # dataTypeOf :: SrcLoc -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c SrcLoc) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc) # gmapT :: (forall b. Data b => b -> b) -> SrcLoc -> SrcLoc # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r # gmapQ :: (forall d. Data d => d -> u) -> SrcLoc -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SrcLoc -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc # | |
Monoid SrcLoc Source # |
|
Semigroup SrcLoc Source # |
|
Generic SrcLoc Source # | |
Show SrcLoc Source # | |
Eq SrcLoc Source # | |
Ord SrcLoc Source # | |
type Rep SrcLoc Source # | |
Defined in Swarm.Language.Syntax.Loc type Rep SrcLoc = D1 ('MetaData "SrcLoc" "Swarm.Language.Syntax.Loc" "swarm-0.6.0.0-ERx1HMcRMba59aI2b6aNrS-swarm-lang" 'False) (C1 ('MetaCons "NoLoc" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SrcLoc" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int))) |
srcLocBefore :: SrcLoc -> SrcLoc -> Bool Source #
Check whether one SrcLoc
starts at or before another one,
i.e. compare their starting indices to see if the first is <=
the second.
Comments
data CommentType Source #
Line vs block comments.
Constructors
LineComment | |
BlockComment |
Instances
data CommentSituation Source #
Was a comment all by itself on a line, or did it occur after some other tokens on a line?
Constructors
StandaloneComment | |
SuffixComment |
Instances
isStandalone :: Comment -> Bool Source #
Test whether a comment is a standalone comment or not.
A comment is retained as some text plus metadata (source location, comment type, + comment situation). While parsing we record all comments out-of-band, for later re-insertion into the AST.
Constructors
Comment | |
Fields |
Instances
FromJSON Comment Source # | |
Defined in Swarm.Language.Syntax.Comments | |
ToJSON Comment Source # | |
Data Comment Source # | |
Defined in Swarm.Language.Syntax.Comments Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Comment -> c Comment # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Comment # toConstr :: Comment -> Constr # dataTypeOf :: Comment -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Comment) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment) # gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Comment -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Comment -> r # gmapQ :: (forall d. Data d => d -> u) -> Comment -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Comment -> m Comment # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment -> m Comment # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment -> m Comment # | |
Generic Comment Source # | |
Show Comment Source # | |
Eq Comment Source # | |
PrettyPrec Comment Source # | |
Defined in Swarm.Language.Pretty | |
type Rep Comment Source # | |
Defined in Swarm.Language.Syntax.Comments type Rep Comment = D1 ('MetaData "Comment" "Swarm.Language.Syntax.Comments" "swarm-0.6.0.0-ERx1HMcRMba59aI2b6aNrS-swarm-lang" 'False) (C1 ('MetaCons "Comment" 'PrefixI 'True) ((S1 ('MetaSel ('Just "commentSrcLoc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SrcLoc) :*: S1 ('MetaSel ('Just "commentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 CommentType)) :*: (S1 ('MetaSel ('Just "commentSituation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 CommentSituation) :*: S1 ('MetaSel ('Just "commentText") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text)))) |
Comments which can be attached to a particular AST node. Some comments come textually before the node and some come after.
Constructors
Comments | |
Fields |
Instances
FromJSON Comments Source # | |
Defined in Swarm.Language.Syntax.Comments | |
ToJSON Comments Source # | |
Data Comments Source # | |
Defined in Swarm.Language.Syntax.Comments Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Comments -> c Comments # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Comments # toConstr :: Comments -> Constr # dataTypeOf :: Comments -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Comments) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comments) # gmapT :: (forall b. Data b => b -> b) -> Comments -> Comments # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Comments -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Comments -> r # gmapQ :: (forall d. Data d => d -> u) -> Comments -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Comments -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Comments -> m Comments # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Comments -> m Comments # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Comments -> m Comments # | |
Monoid Comments Source # | |
Semigroup Comments Source # | |
Generic Comments Source # | |
Show Comments Source # | |
Eq Comments Source # | |
AsEmpty Comments Source # | |
Defined in Swarm.Language.Syntax.Comments | |
type Rep Comments Source # | |
Defined in Swarm.Language.Syntax.Comments type Rep Comments = D1 ('MetaData "Comments" "Swarm.Language.Syntax.Comments" "swarm-0.6.0.0-ERx1HMcRMba59aI2b6aNrS-swarm-lang" 'False) (C1 ('MetaCons "Comments" 'PrefixI 'True) (S1 ('MetaSel ('Just "_beforeComments") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Seq Comment)) :*: S1 ('MetaSel ('Just "_afterComments") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Seq Comment)))) |
Syntax
The surface syntax for the language, with location and type annotations.
Instances
FromJSON Syntax Source # | |
Defined in Swarm.Language.JSON | |
FromJSON TSyntax Source # | |
Defined in Swarm.Language.JSON | |
ToJSON Syntax Source # | |
ToJSON TSyntax Source # | |
Foldable Syntax' Source # | |
Defined in Swarm.Language.Syntax.AST Methods fold :: Monoid m => Syntax' m -> m # foldMap :: Monoid m => (a -> m) -> Syntax' a -> m # foldMap' :: Monoid m => (a -> m) -> Syntax' a -> m # foldr :: (a -> b -> b) -> b -> Syntax' a -> b # foldr' :: (a -> b -> b) -> b -> Syntax' a -> b # foldl :: (b -> a -> b) -> b -> Syntax' a -> b # foldl' :: (b -> a -> b) -> b -> Syntax' a -> b # foldr1 :: (a -> a -> a) -> Syntax' a -> a # foldl1 :: (a -> a -> a) -> Syntax' a -> a # elem :: Eq a => a -> Syntax' a -> Bool # maximum :: Ord a => Syntax' a -> a # minimum :: Ord a => Syntax' a -> a # | |
Traversable Syntax' Source # | |
Functor Syntax' Source # | |
FromJSON (Document Syntax) Source # | |
ToJSON (Document Syntax) Source # | |
ToJSON (Paragraph Syntax) Source # | |
Data ty => Data (Syntax' ty) Source # | |
Defined in Swarm.Language.Syntax.AST Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Syntax' ty -> c (Syntax' ty) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Syntax' ty) # toConstr :: Syntax' ty -> Constr # dataTypeOf :: Syntax' ty -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Syntax' ty)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Syntax' ty)) # gmapT :: (forall b. Data b => b -> b) -> Syntax' ty -> Syntax' ty # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r # gmapQ :: (forall d. Data d => d -> u) -> Syntax' ty -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Syntax' ty -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty) # | |
IsString (Document Syntax) Source # | |
Defined in Swarm.Language.Text.Markdown Methods fromString :: String -> Document Syntax # | |
IsString (Paragraph Syntax) Source # | |
Defined in Swarm.Language.Text.Markdown Methods fromString :: String -> Paragraph Syntax # | |
Generic (Syntax' ty) Source # | |
Show ty => Show (Syntax' ty) Source # | |
Eq ty => Eq (Syntax' ty) Source # | |
Data ty => Plated (Syntax' ty) Source # | |
Defined in Swarm.Language.Syntax.AST Methods plate :: Traversal' (Syntax' ty) (Syntax' ty) # | |
PrettyPrec (Syntax' ty) Source # | Pretty-print a syntax node with comments. |
Defined in Swarm.Language.Pretty | |
type Rep (Syntax' ty) Source # | |
Defined in Swarm.Language.Syntax.AST type Rep (Syntax' ty) = D1 ('MetaData "Syntax'" "Swarm.Language.Syntax.AST" "swarm-0.6.0.0-ERx1HMcRMba59aI2b6aNrS-swarm-lang" 'False) (C1 ('MetaCons "Syntax'" 'PrefixI 'True) ((S1 ('MetaSel ('Just "_sLoc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SrcLoc) :*: S1 ('MetaSel ('Just "_sTerm") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Term' ty))) :*: (S1 ('MetaSel ('Just "_sComments") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Comments) :*: S1 ('MetaSel ('Just "_sType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ty)))) |
pattern Syntax :: SrcLoc -> Term -> Syntax Source #
Raw parsed syntax, without comments or type annotations.
pattern CSyntax :: SrcLoc -> Term -> Comments -> Syntax Source #
Untyped syntax with assocated comments.
A variable with associated source location, used for variable binding sites. (Variable occurrences are a bare TVar which gets wrapped in a Syntax node, so we don't need LocVar for those.)
Instances
FromJSON LocVar Source # | |
Defined in Swarm.Language.Syntax.Loc | |
ToJSON LocVar Source # | |
Data LocVar Source # | |
Defined in Swarm.Language.Syntax.Loc Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> LocVar -> c LocVar # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c LocVar # toConstr :: LocVar -> Constr # dataTypeOf :: LocVar -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c LocVar) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LocVar) # gmapT :: (forall b. Data b => b -> b) -> LocVar -> LocVar # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r # gmapQ :: (forall d. Data d => d -> u) -> LocVar -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> LocVar -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> LocVar -> m LocVar # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> LocVar -> m LocVar # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> LocVar -> m LocVar # | |
Generic LocVar Source # | |
Show LocVar Source # | |
Eq LocVar Source # | |
Ord LocVar Source # | |
type Rep LocVar Source # | |
Defined in Swarm.Language.Syntax.Loc type Rep LocVar = D1 ('MetaData "LocVar" "Swarm.Language.Syntax.Loc" "swarm-0.6.0.0-ERx1HMcRMba59aI2b6aNrS-swarm-lang" 'False) (C1 ('MetaCons "LV" 'PrefixI 'True) (S1 ('MetaSel ('Just "lvSrcLoc") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SrcLoc) :*: S1 ('MetaSel ('Just "lvVar") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Var))) |
A let
expression can be written either as let x = e1 in e2
or
as def x = e1 end; e2
. This enumeration simply records which it
was so that we can pretty-print appropriatly.
Instances
pattern (:$:) :: Term -> Syntax -> Term infixl 0 Source #
Convenient infix pattern synonym for application.
pattern TLet :: LetSyntax -> Bool -> Var -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term Source #
Match a TLet without annotations.
pattern TTydef :: Var -> Polytype -> Maybe TydefInfo -> Term -> Term Source #
Match a STydef without annotations.
pattern TBind :: Maybe Var -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term Source #
Match a TBind without annotations.
Terms
Different runtime behaviors for delayed expressions.
Constructors
SimpleDelay | A simple delay, implemented via a (non-memoized) |
MemoizedDelay (Maybe Var) | A memoized delay, implemented by allocating a mutable cell
with the delayed expression and returning a reference to it.
When the |
Instances
FromJSON DelayType Source # | |
Defined in Swarm.Language.Syntax.AST | |
ToJSON DelayType Source # | |
Data DelayType Source # | |
Defined in Swarm.Language.Syntax.AST 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 # | |
Show DelayType Source # | |
Eq DelayType Source # | |
type Rep DelayType Source # | |
Defined in Swarm.Language.Syntax.AST type Rep DelayType = D1 ('MetaData "DelayType" "Swarm.Language.Syntax.AST" "swarm-0.6.0.0-ERx1HMcRMba59aI2b6aNrS-swarm-lang" '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)))) |
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 reference. 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. |
SRequirements Text (Syntax' ty) | Primitive command to log requirements of a term. The Text
field is to store the unaltered original text of the term, for use
in displaying the log message (since once we get to execution time the
original term may have been elaborated, e.g. |
TVar Var | A variable. |
SPair (Syntax' ty) (Syntax' ty) | A pair. |
SLam LocVar (Maybe Type) (Syntax' ty) | A lambda expression, with or without a type annotation on the binder. |
SApp (Syntax' ty) (Syntax' ty) | Function application. |
SLet LetSyntax Bool LocVar (Maybe Polytype) (Maybe Requirements) (Syntax' ty) (Syntax' ty) | A (recursive) let/def expression, with or without a type
annotation on the variable. The The |
STydef LocVar Polytype (Maybe TydefInfo) (Syntax' ty) | A type synonym definition. Note that this acts like a |
SBind (Maybe LocVar) (Maybe ty) (Maybe Polytype) (Maybe Requirements) (Syntax' ty) (Syntax' ty) | A monadic bind for commands, of the form The The |
SDelay (Syntax' ty) | Delay evaluation of a term, written |
SRcd (Map Var (Maybe (Syntax' ty))) | Record literals |
SProj (Syntax' ty) Var | Record projection |
SAnnotate (Syntax' ty) Polytype | Annotate a term with a type |
SSuspend (Syntax' ty) | Run the given command, then suspend and wait for a new REPL input. |
Instances
mkOp :: Const -> Syntax -> Syntax -> Syntax Source #
Make an infix operation (e.g. 2 + 3
) a curried function
application (e.g. ((+) 2) 3
).
mkOp' :: Const -> Term -> Term -> Term Source #
Make an infix operation, discarding any location information
unfoldApps :: Syntax' ty -> NonEmpty (Syntax' ty) Source #
Turn function application chain into a list.
>>>
syntaxWrap f = fmap (^. sTerm) . f . Syntax NoLoc
>>>
syntaxWrap unfoldApps (mkOp' Mul (TInt 1) (TInt 2)) -- 1 * 2
TConst Mul :| [TInt 1,TInt 2]
Erasure
Term traversal
freeVarsS :: forall ty. Traversal' (Syntax' ty) (Syntax' ty) Source #
Traversal over those subterms of a term which represent free
variables. The S suffix indicates that it is a Traversal
over
the Syntax
nodes (which contain type and source location info)
containing free variables inside a larger Syntax
value. Note
that if you want to get the list of all Syntax
nodes
representing free variables, you can do so via
.toListOf
freeVarsS
mapFreeS :: Var -> (Syntax' ty -> Syntax' ty) -> Syntax' ty -> Syntax' ty Source #
Apply a function to all free occurrences of a particular variable.
locVarToSyntax' :: LocVar -> ty -> Syntax' ty Source #