{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Abstract syntax for terms of the Swarm programming language.
module Swarm.Language.Syntax (
  -- * Directions
  Direction (..),
  AbsoluteDir (..),
  RelativeDir (..),
  PlanarRelativeDir (..),
  directionSyntax,
  isCardinal,
  allDirs,

  -- * Constants
  Const (..),
  allConst,
  ConstInfo (..),
  ConstDoc (..),
  ConstMeta (..),
  MBinAssoc (..),
  MUnAssoc (..),
  constInfo,
  arity,
  isCmd,
  isUserFunc,
  isOperator,
  isBuiltinFunction,
  isTangible,
  isLong,
  maxSniffRange,
  maxScoutRange,
  maxStrideRange,
  maxPathRange,

  -- * Syntax
  Syntax' (..),
  sLoc,
  sTerm,
  sType,
  Syntax,
  pattern Syntax,
  LocVar (..),
  SrcLoc (..),
  noLoc,
  pattern STerm,
  pattern TRequirements,
  pattern TPair,
  pattern TLam,
  pattern TApp,
  pattern (:$:),
  pattern TLet,
  pattern TDef,
  pattern TBind,
  pattern TDelay,
  pattern TRcd,
  pattern TProj,
  pattern TAnnotate,

  -- * Terms
  Var,
  DelayType (..),
  Term' (..),
  Term,
  mkOp,
  mkOp',
  unfoldApps,

  -- * Erasure
  eraseS,

  -- * Term traversal
  freeVarsS,
  freeVarsT,
  freeVarsV,
  mapFreeS,
  locVarToSyntax',
  asTree,
  measureAstSize,
) where

import Control.Lens (Plated (..), Traversal', makeLenses, para, universe, (%~), (^.))
import Control.Monad (void)
import Data.Aeson.Types hiding (Key)
import Data.Data (Data)
import Data.Data.Lens (uniplate)
import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Strict (Map)
import Data.Set qualified as S
import Data.String (IsString (fromString))
import Data.Text hiding (filter, length, map)
import Data.Text qualified as T
import Data.Tree
import GHC.Generics (Generic)
import Swarm.Language.Direction
import Swarm.Language.Types
import Swarm.Util qualified as Util
import Witch.From (from)

-- | Maximum perception distance for
-- 'Chirp' and 'Sniff' commands
maxSniffRange :: Int32
maxSniffRange :: Int32
maxSniffRange = Int32
256

maxScoutRange :: Int
maxScoutRange :: Int
maxScoutRange = Int
64

maxStrideRange :: Int
maxStrideRange :: Int
maxStrideRange = Int
64

maxPathRange :: Integer
maxPathRange :: Integer
maxPathRange = Integer
128

------------------------------------------------------------
-- 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'.
data Const
  = -- Trivial actions

    -- | Do nothing.  This is different than 'Wait'
    --   in that it does not take up a time step.
    Noop
  | -- | Wait for a number of time steps without doing anything.
    Wait
  | -- | Self-destruct.
    Selfdestruct
  | -- Basic actions

    -- | Move forward one step.
    Move
  | -- | Move backward one step.
    Backup
  | -- | Describe a path to the destination.
    Path
  | -- | Push an entity forward one step.
    Push
  | -- | Move forward multiple steps.
    Stride
  | -- | Turn in some direction.
    Turn
  | -- | Grab an item from the current location.
    Grab
  | -- | Harvest an item from the current location.
    Harvest
  | -- | Ignite a combustible item
    Ignite
  | -- | Try to place an item at the current location.
    Place
  | -- | Obtain the relative location of another robot.
    Ping
  | -- | Give an item to another robot at the current location.
    Give
  | -- | Equip a device on oneself.
    Equip
  | -- | Unequip an equipped device, returning to inventory.
    Unequip
  | -- | Make an item.
    Make
  | -- | Sense whether we have a certain item.
    Has
  | -- | Sense whether we have a certain device equipped.
    Equipped
  | -- | Sense how many of a certain item we have.
    Count
  | -- | Drill through an entity.
    Drill
  | -- | Use an entity with another.
    Use
  | -- | Construct a new robot.
    Build
  | -- | Deconstruct an old robot.
    Salvage
  | -- | Reprogram a robot that has executed it's command
    --   with a new command
    Reprogram
  | -- | Emit a message.
    Say
  | -- | Listen for a message from other robots.
    Listen
  | -- | Emit a log message.
    Log
  | -- | View a certain robot.
    View
  | -- | Set what characters are used for display.
    Appear
  | -- | Create an entity out of thin air. Only
    --   available in creative mode.
    Create
  | -- | Tell a robot to halt.
    Halt
  | -- Sensing / generation

    -- | Get current time
    Time
  | -- Detect whether a robot is within line-of-sight in a direction
    Scout
  | -- | Get the current x, y coordinates
    Whereami
  | -- | Get the x, y coordinates of a named waypoint, by index
    Waypoint
  | -- | Locate the closest instance of a given entity within the rectangle
    -- specified by opposite corners, relative to the current location.
    Detect
  | -- | Count the number of a given entity within the rectangle
    -- specified by opposite corners, relative to the current location.
    Resonate
  | -- | Count the number entities within the rectangle
    -- specified by opposite corners, relative to the current location.
    Density
  | -- | Get the distance to the closest instance of the specified entity.
    Sniff
  | -- | Get the direction to the closest instance of the specified entity.
    Chirp
  | -- | Register a location to interrupt a `wait` upon changes
    Watch
  | -- | Register a (remote) location to interrupt a `wait` upon changes
    Surveil
  | -- | Get the current heading.
    Heading
  | -- | See if we can move forward or not.
    Blocked
  | -- | Scan a nearby cell
    Scan
  | -- | Upload knowledge to another robot
    Upload
  | -- | See if a specific entity is here.
    Ishere
  | -- | Check whether the current cell is empty
    Isempty
  | -- | Get a reference to oneself
    Self
  | -- | Get the robot's parent
    Parent
  | -- | Get a reference to the base
    Base
  | -- | Meet a nearby robot
    Meet
  | -- | Meet all nearby robots
    MeetAll
  | -- | Get the robot's display name
    Whoami
  | -- | Set the robot's display name
    Setname
  | -- | Get a uniformly random integer.
    Random
  | -- Modules

    -- | Run a program loaded from a file.
    Run
  | -- Language built-ins

    -- | If-expressions.
    If
  | -- | Left injection.
    Inl
  | -- | Right injection.
    Inr
  | -- | Case analysis on a sum type.
    Case
  | -- | First projection.
    Fst
  | -- | Second projection.
    Snd
  | -- | Force a delayed evaluation.
    Force
  | -- | Return for the cmd monad.
    Return
  | -- | Try/catch block
    Try
  | -- | Undefined
    Undefined
  | -- | User error
    Fail
  | -- Arithmetic unary operators

    -- | Logical negation.
    Not
  | -- | Arithmetic negation.
    Neg
  | -- Comparison operators

    -- | Logical equality comparison
    Eq
  | -- | Logical unequality comparison
    Neq
  | -- | Logical lesser-then comparison
    Lt
  | -- | Logical greater-then comparison
    Gt
  | -- | Logical lesser-or-equal comparison
    Leq
  | -- | Logical greater-or-equal comparison
    Geq
  | -- Arithmetic binary operators

    -- | Logical or.
    Or
  | -- | Logical and.
    And
  | -- | Arithmetic addition operator
    Add
  | -- | Arithmetic subtraction operator
    Sub
  | -- | Arithmetic multiplication operator
    Mul
  | -- | Arithmetic division operator
    Div
  | -- | Arithmetic exponentiation operator
    Exp
  | -- String operators

    -- | Turn an arbitrary value into a string
    Format
  | -- | Concatenate string values
    Concat
  | -- | Count number of characters.
    Chars
  | -- | Split string into two parts.
    Split
  | -- | Get the character at an index.
    CharAt
  | -- | Create a singleton text value with the given character code.
    ToChar
  | -- Function composition with nice operators

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

    -- | Swap placed entity with one in inventory. Essentially atomic grab and place.
    Swap
  | -- | 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@.
    Atomic
  | -- | Like @atomic@, but with no restriction on program size.
    Instant
  | -- Keyboard input

    -- | Create `key` values.
    Key
  | -- | Install a new keyboard input handler.
    InstallKeyHandler
  | -- God-like commands that are omnipresent or omniscient.

    -- | Teleport a robot to the given position.
    Teleport
  | -- | Run a command as if you were another robot.
    As
  | -- | Find an actor by name.
    RobotNamed
  | -- | Find an actor by number.
    RobotNumbered
  | -- | Check if an entity is known.
    Knows
  deriving (Const -> Const -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Const -> Const -> Bool
$c/= :: Const -> Const -> Bool
== :: Const -> Const -> Bool
$c== :: Const -> Const -> Bool
Eq, Eq Const
Const -> Const -> Bool
Const -> Const -> Ordering
Const -> Const -> Const
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Const -> Const -> Const
$cmin :: Const -> Const -> Const
max :: Const -> Const -> Const
$cmax :: Const -> Const -> Const
>= :: Const -> Const -> Bool
$c>= :: Const -> Const -> Bool
> :: Const -> Const -> Bool
$c> :: Const -> Const -> Bool
<= :: Const -> Const -> Bool
$c<= :: Const -> Const -> Bool
< :: Const -> Const -> Bool
$c< :: Const -> Const -> Bool
compare :: Const -> Const -> Ordering
$ccompare :: Const -> Const -> Ordering
Ord, Int -> Const
Const -> Int
Const -> [Const]
Const -> Const
Const -> Const -> [Const]
Const -> Const -> Const -> [Const]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Const -> Const -> Const -> [Const]
$cenumFromThenTo :: Const -> Const -> Const -> [Const]
enumFromTo :: Const -> Const -> [Const]
$cenumFromTo :: Const -> Const -> [Const]
enumFromThen :: Const -> Const -> [Const]
$cenumFromThen :: Const -> Const -> [Const]
enumFrom :: Const -> [Const]
$cenumFrom :: Const -> [Const]
fromEnum :: Const -> Int
$cfromEnum :: Const -> Int
toEnum :: Int -> Const
$ctoEnum :: Int -> Const
pred :: Const -> Const
$cpred :: Const -> Const
succ :: Const -> Const
$csucc :: Const -> Const
Enum, Const
forall a. a -> a -> Bounded a
maxBound :: Const
$cmaxBound :: Const
minBound :: Const
$cminBound :: Const
Bounded, Typeable Const
Const -> DataType
Const -> Constr
(forall b. Data b => b -> b) -> Const -> Const
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Const -> u
forall u. (forall d. Data d => d -> u) -> Const -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Const -> m Const
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Const
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const -> c Const
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Const)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Const -> m Const
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Const -> m Const
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Const -> m Const
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Const -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Const -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Const -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Const -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Const -> r
gmapT :: (forall b. Data b => b -> b) -> Const -> Const
$cgmapT :: (forall b. Data b => b -> b) -> Const -> Const
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Const)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Const)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Const)
dataTypeOf :: Const -> DataType
$cdataTypeOf :: Const -> DataType
toConstr :: Const -> Constr
$ctoConstr :: Const -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Const
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Const
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const -> c Const
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const -> c Const
Data, Int -> Const -> ShowS
[Const] -> ShowS
Const -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Const] -> ShowS
$cshowList :: [Const] -> ShowS
show :: Const -> [Char]
$cshow :: Const -> [Char]
showsPrec :: Int -> Const -> ShowS
$cshowsPrec :: Int -> Const -> ShowS
Show, forall x. Rep Const x -> Const
forall x. Const -> Rep Const x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Const x -> Const
$cfrom :: forall x. Const -> Rep Const x
Generic, Value -> Parser [Const]
Value -> Parser Const
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Const]
$cparseJSONList :: Value -> Parser [Const]
parseJSON :: Value -> Parser Const
$cparseJSON :: Value -> Parser Const
FromJSON, [Const] -> Encoding
[Const] -> Value
Const -> Encoding
Const -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Const] -> Encoding
$ctoEncodingList :: [Const] -> Encoding
toJSONList :: [Const] -> Value
$ctoJSONList :: [Const] -> Value
toEncoding :: Const -> Encoding
$ctoEncoding :: Const -> Encoding
toJSON :: Const -> Value
$ctoJSON :: Const -> Value
ToJSON, FromJSONKeyFunction [Const]
FromJSONKeyFunction Const
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Const]
$cfromJSONKeyList :: FromJSONKeyFunction [Const]
fromJSONKey :: FromJSONKeyFunction Const
$cfromJSONKey :: FromJSONKeyFunction Const
FromJSONKey, ToJSONKeyFunction [Const]
ToJSONKeyFunction Const
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Const]
$ctoJSONKeyList :: ToJSONKeyFunction [Const]
toJSONKey :: ToJSONKeyFunction Const
$ctoJSONKey :: ToJSONKeyFunction Const
ToJSONKey)

allConst :: [Const]
allConst :: [Const]
allConst = forall e. (Enum e, Bounded e) => [e]
Util.listEnums

data ConstInfo = ConstInfo
  { ConstInfo -> Text
syntax :: Text
  , ConstInfo -> Int
fixity :: Int
  , ConstInfo -> ConstMeta
constMeta :: ConstMeta
  , ConstInfo -> ConstDoc
constDoc :: ConstDoc
  , ConstInfo -> Tangibility
tangibility :: Tangibility
  }
  deriving (ConstInfo -> ConstInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstInfo -> ConstInfo -> Bool
$c/= :: ConstInfo -> ConstInfo -> Bool
== :: ConstInfo -> ConstInfo -> Bool
$c== :: ConstInfo -> ConstInfo -> Bool
Eq, Eq ConstInfo
ConstInfo -> ConstInfo -> Bool
ConstInfo -> ConstInfo -> Ordering
ConstInfo -> ConstInfo -> ConstInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConstInfo -> ConstInfo -> ConstInfo
$cmin :: ConstInfo -> ConstInfo -> ConstInfo
max :: ConstInfo -> ConstInfo -> ConstInfo
$cmax :: ConstInfo -> ConstInfo -> ConstInfo
>= :: ConstInfo -> ConstInfo -> Bool
$c>= :: ConstInfo -> ConstInfo -> Bool
> :: ConstInfo -> ConstInfo -> Bool
$c> :: ConstInfo -> ConstInfo -> Bool
<= :: ConstInfo -> ConstInfo -> Bool
$c<= :: ConstInfo -> ConstInfo -> Bool
< :: ConstInfo -> ConstInfo -> Bool
$c< :: ConstInfo -> ConstInfo -> Bool
compare :: ConstInfo -> ConstInfo -> Ordering
$ccompare :: ConstInfo -> ConstInfo -> Ordering
Ord, Int -> ConstInfo -> ShowS
[ConstInfo] -> ShowS
ConstInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstInfo] -> ShowS
$cshowList :: [ConstInfo] -> ShowS
show :: ConstInfo -> [Char]
$cshow :: ConstInfo -> [Char]
showsPrec :: Int -> ConstInfo -> ShowS
$cshowsPrec :: Int -> ConstInfo -> ShowS
Show)

data ConstDoc = ConstDoc {ConstDoc -> Text
briefDoc :: Text, ConstDoc -> Text
longDoc :: Text}
  deriving (ConstDoc -> ConstDoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstDoc -> ConstDoc -> Bool
$c/= :: ConstDoc -> ConstDoc -> Bool
== :: ConstDoc -> ConstDoc -> Bool
$c== :: ConstDoc -> ConstDoc -> Bool
Eq, Eq ConstDoc
ConstDoc -> ConstDoc -> Bool
ConstDoc -> ConstDoc -> Ordering
ConstDoc -> ConstDoc -> ConstDoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConstDoc -> ConstDoc -> ConstDoc
$cmin :: ConstDoc -> ConstDoc -> ConstDoc
max :: ConstDoc -> ConstDoc -> ConstDoc
$cmax :: ConstDoc -> ConstDoc -> ConstDoc
>= :: ConstDoc -> ConstDoc -> Bool
$c>= :: ConstDoc -> ConstDoc -> Bool
> :: ConstDoc -> ConstDoc -> Bool
$c> :: ConstDoc -> ConstDoc -> Bool
<= :: ConstDoc -> ConstDoc -> Bool
$c<= :: ConstDoc -> ConstDoc -> Bool
< :: ConstDoc -> ConstDoc -> Bool
$c< :: ConstDoc -> ConstDoc -> Bool
compare :: ConstDoc -> ConstDoc -> Ordering
$ccompare :: ConstDoc -> ConstDoc -> Ordering
Ord, Int -> ConstDoc -> ShowS
[ConstDoc] -> ShowS
ConstDoc -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstDoc] -> ShowS
$cshowList :: [ConstDoc] -> ShowS
show :: ConstDoc -> [Char]
$cshow :: ConstDoc -> [Char]
showsPrec :: Int -> ConstDoc -> ShowS
$cshowsPrec :: Int -> ConstDoc -> ShowS
Show)

instance IsString ConstDoc where
  fromString :: [Char] -> ConstDoc
fromString = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> ConstDoc
ConstDoc Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

data ConstMeta
  = -- | Function with arity of which some are commands
    ConstMFunc Int Bool
  | -- | Unary operator with fixity and associativity.
    ConstMUnOp MUnAssoc
  | -- | Binary operator with fixity and associativity.
    ConstMBinOp MBinAssoc
  deriving (ConstMeta -> ConstMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstMeta -> ConstMeta -> Bool
$c/= :: ConstMeta -> ConstMeta -> Bool
== :: ConstMeta -> ConstMeta -> Bool
$c== :: ConstMeta -> ConstMeta -> Bool
Eq, Eq ConstMeta
ConstMeta -> ConstMeta -> Bool
ConstMeta -> ConstMeta -> Ordering
ConstMeta -> ConstMeta -> ConstMeta
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConstMeta -> ConstMeta -> ConstMeta
$cmin :: ConstMeta -> ConstMeta -> ConstMeta
max :: ConstMeta -> ConstMeta -> ConstMeta
$cmax :: ConstMeta -> ConstMeta -> ConstMeta
>= :: ConstMeta -> ConstMeta -> Bool
$c>= :: ConstMeta -> ConstMeta -> Bool
> :: ConstMeta -> ConstMeta -> Bool
$c> :: ConstMeta -> ConstMeta -> Bool
<= :: ConstMeta -> ConstMeta -> Bool
$c<= :: ConstMeta -> ConstMeta -> Bool
< :: ConstMeta -> ConstMeta -> Bool
$c< :: ConstMeta -> ConstMeta -> Bool
compare :: ConstMeta -> ConstMeta -> Ordering
$ccompare :: ConstMeta -> ConstMeta -> Ordering
Ord, Int -> ConstMeta -> ShowS
[ConstMeta] -> ShowS
ConstMeta -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstMeta] -> ShowS
$cshowList :: [ConstMeta] -> ShowS
show :: ConstMeta -> [Char]
$cshow :: ConstMeta -> [Char]
showsPrec :: Int -> ConstMeta -> ShowS
$cshowsPrec :: Int -> ConstMeta -> ShowS
Show)

-- | The meta type representing associativity of binary operator.
data MBinAssoc
  = -- |  Left associative binary operator (see 'Control.Monad.Combinators.Expr.InfixL')
    L
  | -- |   Non-associative binary operator (see 'Control.Monad.Combinators.Expr.InfixN')
    N
  | -- | Right associative binary operator (see 'Control.Monad.Combinators.Expr.InfixR')
    R
  deriving (MBinAssoc -> MBinAssoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MBinAssoc -> MBinAssoc -> Bool
$c/= :: MBinAssoc -> MBinAssoc -> Bool
== :: MBinAssoc -> MBinAssoc -> Bool
$c== :: MBinAssoc -> MBinAssoc -> Bool
Eq, Eq MBinAssoc
MBinAssoc -> MBinAssoc -> Bool
MBinAssoc -> MBinAssoc -> Ordering
MBinAssoc -> MBinAssoc -> MBinAssoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MBinAssoc -> MBinAssoc -> MBinAssoc
$cmin :: MBinAssoc -> MBinAssoc -> MBinAssoc
max :: MBinAssoc -> MBinAssoc -> MBinAssoc
$cmax :: MBinAssoc -> MBinAssoc -> MBinAssoc
>= :: MBinAssoc -> MBinAssoc -> Bool
$c>= :: MBinAssoc -> MBinAssoc -> Bool
> :: MBinAssoc -> MBinAssoc -> Bool
$c> :: MBinAssoc -> MBinAssoc -> Bool
<= :: MBinAssoc -> MBinAssoc -> Bool
$c<= :: MBinAssoc -> MBinAssoc -> Bool
< :: MBinAssoc -> MBinAssoc -> Bool
$c< :: MBinAssoc -> MBinAssoc -> Bool
compare :: MBinAssoc -> MBinAssoc -> Ordering
$ccompare :: MBinAssoc -> MBinAssoc -> Ordering
Ord, Int -> MBinAssoc -> ShowS
[MBinAssoc] -> ShowS
MBinAssoc -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MBinAssoc] -> ShowS
$cshowList :: [MBinAssoc] -> ShowS
show :: MBinAssoc -> [Char]
$cshow :: MBinAssoc -> [Char]
showsPrec :: Int -> MBinAssoc -> ShowS
$cshowsPrec :: Int -> MBinAssoc -> ShowS
Show)

-- | The meta type representing associativity of unary operator.
data MUnAssoc
  = -- |  Prefix unary operator (see 'Control.Monad.Combinators.Expr.Prefix')
    P
  | -- |  Suffix unary operator (see 'Control.Monad.Combinators.Expr.Suffix')
    S
  deriving (MUnAssoc -> MUnAssoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MUnAssoc -> MUnAssoc -> Bool
$c/= :: MUnAssoc -> MUnAssoc -> Bool
== :: MUnAssoc -> MUnAssoc -> Bool
$c== :: MUnAssoc -> MUnAssoc -> Bool
Eq, Eq MUnAssoc
MUnAssoc -> MUnAssoc -> Bool
MUnAssoc -> MUnAssoc -> Ordering
MUnAssoc -> MUnAssoc -> MUnAssoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MUnAssoc -> MUnAssoc -> MUnAssoc
$cmin :: MUnAssoc -> MUnAssoc -> MUnAssoc
max :: MUnAssoc -> MUnAssoc -> MUnAssoc
$cmax :: MUnAssoc -> MUnAssoc -> MUnAssoc
>= :: MUnAssoc -> MUnAssoc -> Bool
$c>= :: MUnAssoc -> MUnAssoc -> Bool
> :: MUnAssoc -> MUnAssoc -> Bool
$c> :: MUnAssoc -> MUnAssoc -> Bool
<= :: MUnAssoc -> MUnAssoc -> Bool
$c<= :: MUnAssoc -> MUnAssoc -> Bool
< :: MUnAssoc -> MUnAssoc -> Bool
$c< :: MUnAssoc -> MUnAssoc -> Bool
compare :: MUnAssoc -> MUnAssoc -> Ordering
$ccompare :: MUnAssoc -> MUnAssoc -> Ordering
Ord, Int -> MUnAssoc -> ShowS
[MUnAssoc] -> ShowS
MUnAssoc -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MUnAssoc] -> ShowS
$cshowList :: [MUnAssoc] -> ShowS
show :: MUnAssoc -> [Char]
$cshow :: MUnAssoc -> [Char]
showsPrec :: Int -> MUnAssoc -> ShowS
$cshowsPrec :: Int -> MUnAssoc -> ShowS
Show)

-- | Whether a command is tangible or not.  Tangible commands have
--   some kind of effect on the external world; at most one tangible
--   command can be executed per tick.  Intangible commands are things
--   like sensing commands, or commands that solely modify a robot's
--   internal state; multiple intangible commands may be executed per
--   tick.  In addition, tangible commands can have a 'Length' (either
--   'Short' or 'Long') indicating whether they require only one, or
--   possibly more than one, tick to execute.  Long commands are
--   excluded from @atomic@ blocks to avoid freezing the game.
data Tangibility = Intangible | Tangible Length
  deriving (Tangibility -> Tangibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tangibility -> Tangibility -> Bool
$c/= :: Tangibility -> Tangibility -> Bool
== :: Tangibility -> Tangibility -> Bool
$c== :: Tangibility -> Tangibility -> Bool
Eq, Eq Tangibility
Tangibility -> Tangibility -> Bool
Tangibility -> Tangibility -> Ordering
Tangibility -> Tangibility -> Tangibility
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tangibility -> Tangibility -> Tangibility
$cmin :: Tangibility -> Tangibility -> Tangibility
max :: Tangibility -> Tangibility -> Tangibility
$cmax :: Tangibility -> Tangibility -> Tangibility
>= :: Tangibility -> Tangibility -> Bool
$c>= :: Tangibility -> Tangibility -> Bool
> :: Tangibility -> Tangibility -> Bool
$c> :: Tangibility -> Tangibility -> Bool
<= :: Tangibility -> Tangibility -> Bool
$c<= :: Tangibility -> Tangibility -> Bool
< :: Tangibility -> Tangibility -> Bool
$c< :: Tangibility -> Tangibility -> Bool
compare :: Tangibility -> Tangibility -> Ordering
$ccompare :: Tangibility -> Tangibility -> Ordering
Ord, Int -> Tangibility -> ShowS
[Tangibility] -> ShowS
Tangibility -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Tangibility] -> ShowS
$cshowList :: [Tangibility] -> ShowS
show :: Tangibility -> [Char]
$cshow :: Tangibility -> [Char]
showsPrec :: Int -> Tangibility -> ShowS
$cshowsPrec :: Int -> Tangibility -> ShowS
Show, ReadPrec [Tangibility]
ReadPrec Tangibility
Int -> ReadS Tangibility
ReadS [Tangibility]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tangibility]
$creadListPrec :: ReadPrec [Tangibility]
readPrec :: ReadPrec Tangibility
$creadPrec :: ReadPrec Tangibility
readList :: ReadS [Tangibility]
$creadList :: ReadS [Tangibility]
readsPrec :: Int -> ReadS Tangibility
$creadsPrec :: Int -> ReadS Tangibility
Read)

-- | For convenience, @short = Tangible Short@.
short :: Tangibility
short :: Tangibility
short = Length -> Tangibility
Tangible Length
Short

-- | For convenience, @long = Tangible Long@.
long :: Tangibility
long :: Tangibility
long = Length -> Tangibility
Tangible Length
Long

-- | The length of a tangible command.  Short commands take exactly
--   one tick to execute.  Long commands may require multiple ticks.
data Length = Short | Long
  deriving (Length -> Length -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq, Eq Length
Length -> Length -> Bool
Length -> Length -> Ordering
Length -> Length -> Length
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Length -> Length -> Length
$cmin :: Length -> Length -> Length
max :: Length -> Length -> Length
$cmax :: Length -> Length -> Length
>= :: Length -> Length -> Bool
$c>= :: Length -> Length -> Bool
> :: Length -> Length -> Bool
$c> :: Length -> Length -> Bool
<= :: Length -> Length -> Bool
$c<= :: Length -> Length -> Bool
< :: Length -> Length -> Bool
$c< :: Length -> Length -> Bool
compare :: Length -> Length -> Ordering
$ccompare :: Length -> Length -> Ordering
Ord, Int -> Length -> ShowS
[Length] -> ShowS
Length -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Length] -> ShowS
$cshowList :: [Length] -> ShowS
show :: Length -> [Char]
$cshow :: Length -> [Char]
showsPrec :: Int -> Length -> ShowS
$cshowsPrec :: Int -> Length -> ShowS
Show, ReadPrec [Length]
ReadPrec Length
Int -> ReadS Length
ReadS [Length]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Length]
$creadListPrec :: ReadPrec [Length]
readPrec :: ReadPrec Length
$creadPrec :: ReadPrec Length
readList :: ReadS [Length]
$creadList :: ReadS [Length]
readsPrec :: Int -> ReadS Length
$creadsPrec :: Int -> ReadS Length
Read, Length
forall a. a -> a -> Bounded a
maxBound :: Length
$cmaxBound :: Length
minBound :: Length
$cminBound :: Length
Bounded, Int -> Length
Length -> Int
Length -> [Length]
Length -> Length
Length -> Length -> [Length]
Length -> Length -> Length -> [Length]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Length -> Length -> Length -> [Length]
$cenumFromThenTo :: Length -> Length -> Length -> [Length]
enumFromTo :: Length -> Length -> [Length]
$cenumFromTo :: Length -> Length -> [Length]
enumFromThen :: Length -> Length -> [Length]
$cenumFromThen :: Length -> Length -> [Length]
enumFrom :: Length -> [Length]
$cenumFrom :: Length -> [Length]
fromEnum :: Length -> Int
$cfromEnum :: Length -> Int
toEnum :: Int -> Length
$ctoEnum :: Int -> Length
pred :: Length -> Length
$cpred :: Length -> Length
succ :: Length -> Length
$csucc :: Length -> Length
Enum)

-- | The arity of a constant, /i.e./ how many arguments it expects.
--   The runtime system will collect arguments to a constant (see
--   'Swarm.Language.Value.VCApp') until it has enough, then dispatch
--   the constant's behavior.
arity :: Const -> Int
arity :: Const -> Int
arity Const
c = case ConstInfo -> ConstMeta
constMeta forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
c of
  ConstMUnOp {} -> Int
1
  ConstMBinOp {} -> Int
2
  ConstMFunc Int
a Bool
_ -> Int
a

-- | 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'.
isCmd :: Const -> Bool
isCmd :: Const -> Bool
isCmd Const
c = case ConstInfo -> ConstMeta
constMeta forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
c of
  ConstMFunc Int
_ Bool
cmd -> Bool
cmd
  ConstMeta
_ -> Bool
False

-- | Function constants user can call with reserved words ('wait',...).
isUserFunc :: Const -> Bool
isUserFunc :: Const -> Bool
isUserFunc Const
c = case ConstInfo -> ConstMeta
constMeta forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
c of
  ConstMFunc {} -> Bool
True
  ConstMeta
_ -> Bool
False

-- | Whether the constant is an operator. Useful predicate for documentation.
isOperator :: Const -> Bool
isOperator :: Const -> Bool
isOperator Const
c = case ConstInfo -> ConstMeta
constMeta forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
c of
  ConstMUnOp {} -> Bool
True
  ConstMBinOp {} -> Bool
True
  ConstMFunc {} -> Bool
False

-- | 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.
isBuiltinFunction :: Const -> Bool
isBuiltinFunction :: Const -> Bool
isBuiltinFunction Const
c = case ConstInfo -> ConstMeta
constMeta forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
c of
  ConstMFunc Int
_ Bool
cmd -> Bool -> Bool
not Bool
cmd
  ConstMeta
_ -> Bool
False

-- | 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.
isTangible :: Const -> Bool
isTangible :: Const -> Bool
isTangible Const
c = case ConstInfo -> Tangibility
tangibility (Const -> ConstInfo
constInfo Const
c) of
  Tangible {} -> Bool
True
  Tangibility
_ -> Bool
False

-- | 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.
isLong :: Const -> Bool
isLong :: Const -> Bool
isLong Const
c = case ConstInfo -> Tangibility
tangibility (Const -> ConstInfo
constInfo Const
c) of
  Tangible Length
Long -> Bool
True
  Tangibility
_ -> Bool
False

-- | 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.
constInfo :: Const -> ConstInfo
constInfo :: Const -> ConstInfo
constInfo Const
c = case Const
c of
  Const
Wait -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
long ConstDoc
"Wait for a number of time steps."
  Const
Noop ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Do nothing." forall a b. (a -> b) -> a -> b
$
      [ Text
"This is different than `Wait` in that it does not take up a time step."
      , Text
"It is useful for commands like if, which requires you to provide both branches."
      , Text
"Usually it is automatically inserted where needed, so you do not have to worry about it."
      ]
  Const
Selfdestruct ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Self-destruct a robot." forall a b. (a -> b) -> a -> b
$
      [ Text
"Useful to not clutter the world."
      , Text
"This destroys the robot's inventory, so consider `salvage` as an alternative."
      ]
  Const
Move -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
short ConstDoc
"Move forward one step."
  Const
Backup -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
short ConstDoc
"Move backward one step."
  Const
Path ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Obtain shortest path to the destination." forall a b. (a -> b) -> a -> b
$
      [ Text
"Optionally supply a distance limit as the first argument."
      , Text
"Supply either a location (`inL`) or an entity (`inR`) as the second argument."
      , Text
"If a path exists, returns the direction to proceed along."
      ]
  Const
Push ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Push an entity forward one step." forall a b. (a -> b) -> a -> b
$
      [ Text
"Both entity and robot moves forward one step."
      , Text
"Destination must not contain an entity."
      ]
  Const
Stride ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Move forward multiple steps." forall a b. (a -> b) -> a -> b
$
      [ [Text] -> Text
T.unwords [Text
"Has a max range of", [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
maxStrideRange, Text
"units."]
      ]
  Const
Turn -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"Turn in some direction."
  Const
Grab -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
short ConstDoc
"Grab an item from the current location."
  Const
Harvest ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Harvest an item from the current location." forall a b. (a -> b) -> a -> b
$
      [ Text
"Leaves behind a growing seed if the harvested item is growable."
      , Text
"Otherwise it works exactly like `grab`."
      ]
  Const
Ignite ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Ignite a combustible item in the specified direction." forall a b. (a -> b) -> a -> b
$
      [ Text
"Combustion persists for a random duration and may spread."
      ]
  Const
Place ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Place an item at the current location." forall a b. (a -> b) -> a -> b
$
      [Text
"The current location has to be empty for this to work."]
  Const
Ping ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Obtain the relative location of another robot." forall a b. (a -> b) -> a -> b
$
      [ Text
"The other robot must be within transmission range, accounting for antennas installed on either end, and the invoking robot must be oriented in a cardinal direction."
      , Text
"The location (x, y) is given relative to one's current orientation:"
      , Text
"Positive x value is to the right, negative left. Likewise, positive y value is forward, negative back."
      ]
  Const
Give -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
short ConstDoc
"Give an item to another actor nearby."
  Const
Equip -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"Equip a device on oneself."
  Const
Unequip -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"Unequip an equipped device, returning to inventory."
  Const
Make -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
long ConstDoc
"Make an item using a recipe."
  Const
Has -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Sense whether the robot has a given item in its inventory."
  Const
Equipped -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Sense whether the robot has a specific device equipped."
  Const
Count -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Get the count of a given item in a robot's inventory."
  Const
Reprogram ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
long forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Reprogram another robot with a new command." forall a b. (a -> b) -> a -> b
$
      [Text
"The other robot has to be nearby and idle."]
  Const
Drill ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
long forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Drill through an entity." forall a b. (a -> b) -> a -> b
$
      [ Text
"Usually you want to `drill forward` when exploring to clear out obstacles."
      , Text
"When you have found a source to drill, you can stand on it and `drill down`."
      , Text
"See what recipes with drill you have available."
      , Text
"The `drill` command may return the name of an entity added to your inventory."
      ]
  Const
Use ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
long forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Use one entity upon another." forall a b. (a -> b) -> a -> b
$
      [ Text
"Which entities you can `use` with others depends on the available recipes."
      , Text
"The object being used must be a 'required' entity in a recipe."
      ]
  Const
Build ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
long forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Construct a new robot." forall a b. (a -> b) -> a -> b
$
      [ Text
"You can specify a command for the robot to execute."
      , Text
"If the command requires devices they will be taken from your inventory and "
          forall a. Semigroup a => a -> a -> a
<> Text
"equipped on the new robot."
      ]
  Const
Salvage ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
long forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Deconstruct an old robot." forall a b. (a -> b) -> a -> b
$
      [Text
"Salvaging a robot will give you its inventory, equipped devices and log."]
  Const
Say ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Emit a message." forall a b. (a -> b) -> a -> b
$
      [ Text
"The message will be in the robot's log (if it has one) and the global log."
      , Text
"You can view the message that would be picked by `listen` from the global log "
          forall a. Semigroup a => a -> a -> a
<> Text
"in the messages panel, along with your own messages and logs."
      , Text
"This means that to see messages from other robots you have to be able to listen for them, "
          forall a. Semigroup a => a -> a -> a
<> Text
"so once you have a listening device equipped messages will be added to your log."
      , Text
"In creative mode, there is of course no such limitation."
      ]
  Const
Listen ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
long forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Listen for a message from other actors." forall a b. (a -> b) -> a -> b
$
      [ Text
"It will take the first message said by the closest actor."
      , Text
"You do not need to actively listen for the message to be logged though, "
          forall a. Semigroup a => a -> a -> a
<> Text
"that is done automatically once you have a listening device equipped."
      , Text
"Note that you can see the messages either in your logger device or the message panel."
      ]
  Const
Log -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"Log the string in the robot's logger."
  Const
View ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"View the given actor." forall a b. (a -> b) -> a -> b
$
      [ Text
"This will recenter the map on the target robot and allow its inventory and logs to be inspected."
      ]
  Const
Appear ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Set how the robot is displayed." forall a b. (a -> b) -> a -> b
$
      [ Text
"You can either specify one character or five (for each direction)."
      , Text
"The default is \"X^>v<\"."
      ]
  Const
Create ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Create an item out of thin air." forall a b. (a -> b) -> a -> b
$
      [Text
"Only available in creative mode."]
  Const
Halt -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"Tell a robot to halt."
  Const
Time -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"Get the current time."
  Const
Scout ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Detect whether a robot is within line-of-sight in a direction." forall a b. (a -> b) -> a -> b
$
      [ Text
"Perception is blocked by 'Opaque' entities."
      , [Text] -> Text
T.unwords [Text
"Has a max range of", [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
maxScoutRange, Text
"units."]
      ]
  Const
Whereami -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"Get the current x and y coordinates."
  Const
Waypoint ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Get the x, y coordinates of a named waypoint, by index" forall a b. (a -> b) -> a -> b
$
      [ Text
"Return only the waypoints in the same subworld as the calling robot."
      , Text
"Since waypoint names can have plural multiplicity, returns a tuple of (count, (x, y))."
      , Text
"The supplied index will be wrapped automatically, modulo the waypoint count."
      , Text
"A robot can use the count to know whether they have iterated over the full waypoint circuit."
      ]
  Const
Detect ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Detect an entity within a rectangle." forall a b. (a -> b) -> a -> b
$
      [Text
"Locate the closest instance of a given entity within the rectangle specified by opposite corners, relative to the current location."]
  Const
Resonate ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Count specific entities within a rectangle." forall a b. (a -> b) -> a -> b
$
      [ Text
"Applies a strong magnetic field over a given area and stimulates the matter within, generating a non-directional radio signal. A receiver tuned to the resonant frequency of the target entity is able to measure its quantity."
      , Text
"Counts the entities within the rectangle specified by opposite corners, relative to the current location."
      ]
  Const
Density ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Count all entities within a rectangle." forall a b. (a -> b) -> a -> b
$
      [ Text
"Applies a strong magnetic field over a given area and stimulates the matter within, generating a non-directional radio signal. A receiver measured the signal intensity to measure the quantity."
      , Text
"Counts the entities within the rectangle specified by opposite corners, relative to the current location."
      ]
  Const
Sniff ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Determine distance to entity." forall a b. (a -> b) -> a -> b
$
      [ Text
"Measures concentration of airborne particles to infer distance to a certain kind of entity."
      , Text
"If none is detected, returns (-1)."
      , [Text] -> Text
T.unwords [Text
"Has a max range of", [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int32
maxSniffRange, Text
"units."]
      ]
  Const
Chirp ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Determine direction to entity." forall a b. (a -> b) -> a -> b
$
      [ Text
"Uses a directional sonic emitter and microphone tuned to the acoustic signature of a specific entity to determine its direction."
      , Text
"Returns 'down' if out of range or the direction is indeterminate."
      , Text
"Provides absolute directions if \"compass\" equipped, relative directions otherwise."
      , [Text] -> Text
T.unwords [Text
"Has a max range of", [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int32
maxSniffRange, Text
"units."]
      ]
  Const
Watch ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Interrupt `wait` upon location changes." forall a b. (a -> b) -> a -> b
$
      [ Text
"Place seismic detectors to alert upon entity changes to the specified location."
      , Text
"Supply a direction, as with the `scan` command, to specify a nearby location."
      , Text
"Can be invoked more than once until the next `wait` command, at which time the only the registered locations that are currently nearby are preserved."
      , Text
"Any change to entities at the monitored locations will cause the robot to wake up before the `wait` timeout."
      ]
  Const
Surveil ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Interrupt `wait` upon (remote) location changes." forall a b. (a -> b) -> a -> b
$
      [ Text
"Like `watch`, but with no restriction on distance."
      ]
  Const
Heading -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"Get the current heading."
  Const
Blocked -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"See if the robot can move forward."
  Const
Scan ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Scan a nearby location for entities." forall a b. (a -> b) -> a -> b
$
      [ Text
"Adds the entity (not actor) to your inventory with count 0 if there is any."
      , Text
"If you can use sum types, you can also inspect the result directly."
      ]
  Const
Upload -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"Upload a robot's known entities and log to another robot."
  Const
Ishere -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"See if a specific entity is in the current location."
  Const
Isempty ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Check if the current location is empty." forall a b. (a -> b) -> a -> b
$
      [ Text
"Detects whether or not the current location contains an entity."
      , Text
"Does not detect robots or other actors."
      ]
  Const
Self -> Int -> ConstDoc -> ConstInfo
function Int
0 ConstDoc
"Get a reference to the current robot."
  Const
Parent -> Int -> ConstDoc -> ConstInfo
function Int
0 ConstDoc
"Get a reference to the robot's parent."
  Const
Base -> Int -> ConstDoc -> ConstInfo
function Int
0 ConstDoc
"Get a reference to the base."
  Const
Meet -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"Get a reference to a nearby actor, if there is one."
  Const
MeetAll -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
long ConstDoc
"Run a command for each nearby actor."
  Const
Whoami -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"Get the robot's display name."
  Const
Setname -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"Set the robot's display name."
  Const
Random ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Get a uniformly random integer." forall a b. (a -> b) -> a -> b
$
      [Text
"The random integer will be chosen from the range 0 to n-1, exclusive of the argument."]
  Const
Run -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
long ConstDoc
"Run a program loaded from a file."
  Const
Return -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Make the value a result in `cmd`."
  Const
Try -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
Intangible ConstDoc
"Execute a command, catching errors."
  Const
Undefined -> Int -> ConstDoc -> ConstInfo
function Int
0 ConstDoc
"A value of any type, that is evaluated as error."
  Const
Fail -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"A value of any type, that is evaluated as error with message."
  Const
If ->
    Int -> ConstDoc -> ConstInfo
function Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"If-Then-Else function." forall a b. (a -> b) -> a -> b
$
      [Text
"If the bool predicate is true then evaluate the first expression, otherwise the second."]
  Const
Inl -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Put the value into the left component of a sum type."
  Const
Inr -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Put the value into the right component of a sum type."
  Const
Case -> Int -> ConstDoc -> ConstInfo
function Int
3 ConstDoc
"Evaluate one of the given functions on a value of sum type."
  Const
Fst -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Get the first value of a pair."
  Const
Snd -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Get the second value of a pair."
  Const
Force -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Force the evaluation of a delayed value."
  Const
Not -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Negate the boolean value."
  Const
Neg -> Text -> Int -> MUnAssoc -> ConstDoc -> ConstInfo
unaryOp Text
"-" Int
7 MUnAssoc
P ConstDoc
"Negate the given integer value."
  Const
Add -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"+" Int
6 MBinAssoc
L ConstDoc
"Add the given integer values."
  Const
And -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"&&" Int
3 MBinAssoc
R ConstDoc
"Logical and (true if both values are true)."
  Const
Or -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"||" Int
2 MBinAssoc
R ConstDoc
"Logical or (true if either value is true)."
  Const
Sub -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"-" Int
6 MBinAssoc
L ConstDoc
"Subtract the given integer values."
  Const
Mul -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"*" Int
7 MBinAssoc
L ConstDoc
"Multiply the given integer values."
  Const
Div -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"/" Int
7 MBinAssoc
L ConstDoc
"Divide the left integer value by the right one, rounding down."
  Const
Exp -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"^" Int
8 MBinAssoc
R ConstDoc
"Raise the left integer value to the power of the right one."
  Const
Eq -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"==" Int
4 MBinAssoc
N ConstDoc
"Check that the left value is equal to the right one."
  Const
Neq -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"!=" Int
4 MBinAssoc
N ConstDoc
"Check that the left value is not equal to the right one."
  Const
Lt -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"<" Int
4 MBinAssoc
N ConstDoc
"Check that the left value is lesser than the right one."
  Const
Gt -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
">" Int
4 MBinAssoc
N ConstDoc
"Check that the left value is greater than the right one."
  Const
Leq -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"<=" Int
4 MBinAssoc
N ConstDoc
"Check that the left value is lesser or equal to the right one."
  Const
Geq -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
">=" Int
4 MBinAssoc
N ConstDoc
"Check that the left value is greater or equal to the right one."
  Const
Format -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Turn an arbitrary value into a string."
  Const
Concat -> Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"++" Int
6 MBinAssoc
R ConstDoc
"Concatenate the given strings."
  Const
Chars -> Int -> ConstDoc -> ConstInfo
function Int
1 ConstDoc
"Counts the number of characters in the text."
  Const
Split ->
    Int -> ConstDoc -> ConstInfo
function Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Split the text into two at given position." forall a b. (a -> b) -> a -> b
$
      [ Text
"To be more specific, the following holds for all `text` values `s1` and `s2`:"
      , Text
"`(s1,s2) == split (chars s1) (s1 ++ s2)`"
      , Text
"So split can be used to undo concatenation if you know the length of the original string."
      ]
  Const
CharAt ->
    Int -> ConstDoc -> ConstInfo
function Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Get the character at a given index." forall a b. (a -> b) -> a -> b
$
      [ Text
"Gets the character (as an `int` representing a Unicode codepoint) at a specific index in a `text` value.  Valid indices are 0 through `chars t - 1`."
      , Text
"Throws an exception if given an out-of-bounds index."
      ]
  Const
ToChar ->
    Int -> ConstDoc -> ConstInfo
function Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Create a singleton `text` value from the given character code." forall a b. (a -> b) -> a -> b
$
      [ Text
"That is, `chars (toChar c) == 1` and `charAt 0 (toChar c) == c`."
      ]
  Const
AppF ->
    Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
"$" Int
0 MBinAssoc
R forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Apply the function on the left to the value on the right." forall a b. (a -> b) -> a -> b
$
      [ Text
"This operator is useful to avoid nesting parentheses."
      , Text
"For exaple:"
      , Text
"`f $ g $ h x = f (g (h x))`"
      ]
  Const
Swap ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Swap placed entity with one in inventory." forall a b. (a -> b) -> a -> b
$
      [ Text
"This essentially works like atomic grab and place."
      , Text
"Use this to avoid race conditions where more robots grab, scan or place in one location."
      ]
  Const
Atomic ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Execute a block of commands atomically." forall a b. (a -> b) -> a -> b
$
      [ Text
"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@."
      ]
  Const
Instant ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Execute a block of commands instantly." forall a b. (a -> b) -> a -> b
$
      [ Text
"Like `atomic`, but with no restriction on program size."
      ]
  Const
Key ->
    Int -> ConstDoc -> ConstInfo
function Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Create a key value from a text description." forall a b. (a -> b) -> a -> b
$
      [ Text
"The key description can optionally start with modifiers like 'C-', 'M-', 'A-', or 'S-', followed by either a regular key, or a special key name like 'Down' or 'End'"
      , Text
"For example, 'M-C-x', 'Down', or 'S-4'."
      , Text
"Which key combinations are actually possible to type may vary by keyboard and terminal program."
      ]
  Const
InstallKeyHandler ->
    Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
Intangible forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> ConstDoc
doc Text
"Install a keyboard input handler." forall a b. (a -> b) -> a -> b
$
      [ Text
"The first argument is a hint line that will be displayed when the input handler is active."
      , Text
"The second argument is a function to handle keyboard inputs."
      ]
  Const
Teleport -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
short ConstDoc
"Teleport a robot to the given location."
  Const
As -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
Intangible ConstDoc
"Hypothetically run a command as if you were another robot."
  Const
RobotNamed -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Find an actor by name."
  Const
RobotNumbered -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Find an actor by number."
  Const
Knows -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Check if the robot knows about an entity."
 where
  doc :: Text -> [Text] -> ConstDoc
doc Text
b [Text]
ls = Text -> Text -> ConstDoc
ConstDoc Text
b ([Text] -> Text
T.unlines [Text]
ls)
  unaryOp :: Text -> Int -> MUnAssoc -> ConstDoc -> ConstInfo
unaryOp Text
s Int
p MUnAssoc
side ConstDoc
d =
    ConstInfo
      { syntax :: Text
syntax = Text
s
      , fixity :: Int
fixity = Int
p
      , constMeta :: ConstMeta
constMeta = MUnAssoc -> ConstMeta
ConstMUnOp MUnAssoc
side
      , constDoc :: ConstDoc
constDoc = ConstDoc
d
      , tangibility :: Tangibility
tangibility = Tangibility
Intangible
      }
  binaryOp :: Text -> Int -> MBinAssoc -> ConstDoc -> ConstInfo
binaryOp Text
s Int
p MBinAssoc
side ConstDoc
d =
    ConstInfo
      { syntax :: Text
syntax = Text
s
      , fixity :: Int
fixity = Int
p
      , constMeta :: ConstMeta
constMeta = MBinAssoc -> ConstMeta
ConstMBinOp MBinAssoc
side
      , constDoc :: ConstDoc
constDoc = ConstDoc
d
      , tangibility :: Tangibility
tangibility = Tangibility
Intangible
      }
  command :: Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
a Tangibility
f ConstDoc
d =
    ConstInfo
      { syntax :: Text
syntax = forall a. Show a => a -> Text
lowShow Const
c
      , fixity :: Int
fixity = Int
11
      , constMeta :: ConstMeta
constMeta = Int -> Bool -> ConstMeta
ConstMFunc Int
a Bool
True
      , constDoc :: ConstDoc
constDoc = ConstDoc
d
      , tangibility :: Tangibility
tangibility = Tangibility
f
      }
  function :: Int -> ConstDoc -> ConstInfo
function Int
a ConstDoc
d =
    ConstInfo
      { syntax :: Text
syntax = forall a. Show a => a -> Text
lowShow Const
c
      , fixity :: Int
fixity = Int
11
      , constMeta :: ConstMeta
constMeta = Int -> Bool -> ConstMeta
ConstMFunc Int
a Bool
False
      , constDoc :: ConstDoc
constDoc = ConstDoc
d
      , tangibility :: Tangibility
tangibility = Tangibility
Intangible
      }

  lowShow :: Show a => a -> Text
  lowShow :: forall a. Show a => a -> Text
lowShow a
a = Text -> Text
toLower (forall source target. From source target => source -> target
from (forall a. Show a => a -> [Char]
show a
a))

------------------------------------------------------------
-- Basic terms
------------------------------------------------------------

-- | Different runtime behaviors for delayed expressions.
data DelayType
  = -- | A simple delay, implemented via a (non-memoized) @VDelay@
    --   holding the delayed expression.
    SimpleDelay
  | -- | 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@.
    MemoizedDelay (Maybe Var)
  deriving (DelayType -> DelayType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelayType -> DelayType -> Bool
$c/= :: DelayType -> DelayType -> Bool
== :: DelayType -> DelayType -> Bool
$c== :: DelayType -> DelayType -> Bool
Eq, Int -> DelayType -> ShowS
[DelayType] -> ShowS
DelayType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DelayType] -> ShowS
$cshowList :: [DelayType] -> ShowS
show :: DelayType -> [Char]
$cshow :: DelayType -> [Char]
showsPrec :: Int -> DelayType -> ShowS
$cshowsPrec :: Int -> DelayType -> ShowS
Show, Typeable DelayType
DelayType -> DataType
DelayType -> Constr
(forall b. Data b => b -> b) -> DelayType -> DelayType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DelayType -> u
forall u. (forall d. Data d => d -> u) -> DelayType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelayType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelayType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelayType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelayType -> c DelayType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelayType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelayType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelayType -> m DelayType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DelayType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DelayType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DelayType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DelayType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelayType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelayType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelayType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelayType -> r
gmapT :: (forall b. Data b => b -> b) -> DelayType -> DelayType
$cgmapT :: (forall b. Data b => b -> b) -> DelayType -> DelayType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelayType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelayType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelayType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelayType)
dataTypeOf :: DelayType -> DataType
$cdataTypeOf :: DelayType -> DataType
toConstr :: DelayType -> Constr
$ctoConstr :: DelayType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelayType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelayType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelayType -> c DelayType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelayType -> c DelayType
Data, forall x. Rep DelayType x -> DelayType
forall x. DelayType -> Rep DelayType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DelayType x -> DelayType
$cfrom :: forall x. DelayType -> Rep DelayType x
Generic, Value -> Parser [DelayType]
Value -> Parser DelayType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DelayType]
$cparseJSONList :: Value -> Parser [DelayType]
parseJSON :: Value -> Parser DelayType
$cparseJSON :: Value -> Parser DelayType
FromJSON, [DelayType] -> Encoding
[DelayType] -> Value
DelayType -> Encoding
DelayType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DelayType] -> Encoding
$ctoEncodingList :: [DelayType] -> Encoding
toJSONList :: [DelayType] -> Value
$ctoJSONList :: [DelayType] -> Value
toEncoding :: DelayType -> Encoding
$ctoEncoding :: DelayType -> Encoding
toJSON :: DelayType -> Value
$ctoJSON :: DelayType -> Value
ToJSON)

-- | 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.)
data LocVar = LV {LocVar -> SrcLoc
lvSrcLoc :: SrcLoc, LocVar -> Text
lvVar :: Var}
  deriving (LocVar -> LocVar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocVar -> LocVar -> Bool
$c/= :: LocVar -> LocVar -> Bool
== :: LocVar -> LocVar -> Bool
$c== :: LocVar -> LocVar -> Bool
Eq, Eq LocVar
LocVar -> LocVar -> Bool
LocVar -> LocVar -> Ordering
LocVar -> LocVar -> LocVar
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LocVar -> LocVar -> LocVar
$cmin :: LocVar -> LocVar -> LocVar
max :: LocVar -> LocVar -> LocVar
$cmax :: LocVar -> LocVar -> LocVar
>= :: LocVar -> LocVar -> Bool
$c>= :: LocVar -> LocVar -> Bool
> :: LocVar -> LocVar -> Bool
$c> :: LocVar -> LocVar -> Bool
<= :: LocVar -> LocVar -> Bool
$c<= :: LocVar -> LocVar -> Bool
< :: LocVar -> LocVar -> Bool
$c< :: LocVar -> LocVar -> Bool
compare :: LocVar -> LocVar -> Ordering
$ccompare :: LocVar -> LocVar -> Ordering
Ord, Int -> LocVar -> ShowS
[LocVar] -> ShowS
LocVar -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LocVar] -> ShowS
$cshowList :: [LocVar] -> ShowS
show :: LocVar -> [Char]
$cshow :: LocVar -> [Char]
showsPrec :: Int -> LocVar -> ShowS
$cshowsPrec :: Int -> LocVar -> ShowS
Show, Typeable LocVar
LocVar -> DataType
LocVar -> Constr
(forall b. Data b => b -> b) -> LocVar -> LocVar
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LocVar -> u
forall u. (forall d. Data d => d -> u) -> LocVar -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LocVar
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LocVar -> c LocVar
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LocVar)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LocVar)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LocVar -> m LocVar
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LocVar -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LocVar -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LocVar -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LocVar -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LocVar -> r
gmapT :: (forall b. Data b => b -> b) -> LocVar -> LocVar
$cgmapT :: (forall b. Data b => b -> b) -> LocVar -> LocVar
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LocVar)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LocVar)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LocVar)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LocVar)
dataTypeOf :: LocVar -> DataType
$cdataTypeOf :: LocVar -> DataType
toConstr :: LocVar -> Constr
$ctoConstr :: LocVar -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LocVar
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LocVar
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LocVar -> c LocVar
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LocVar -> c LocVar
Data, forall x. Rep LocVar x -> LocVar
forall x. LocVar -> Rep LocVar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocVar x -> LocVar
$cfrom :: forall x. LocVar -> Rep LocVar x
Generic, Value -> Parser [LocVar]
Value -> Parser LocVar
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LocVar]
$cparseJSONList :: Value -> Parser [LocVar]
parseJSON :: Value -> Parser LocVar
$cparseJSON :: Value -> Parser LocVar
FromJSON, [LocVar] -> Encoding
[LocVar] -> Value
LocVar -> Encoding
LocVar -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LocVar] -> Encoding
$ctoEncodingList :: [LocVar] -> Encoding
toJSONList :: [LocVar] -> Value
$ctoJSONList :: [LocVar] -> Value
toEncoding :: LocVar -> Encoding
$ctoEncoding :: LocVar -> Encoding
toJSON :: LocVar -> Value
$ctoJSON :: LocVar -> Value
ToJSON)

locVarToSyntax' :: LocVar -> ty -> Syntax' ty
locVarToSyntax' :: forall ty. LocVar -> ty -> Syntax' ty
locVarToSyntax' (LV SrcLoc
s Text
v) = forall ty. SrcLoc -> Term' ty -> ty -> Syntax' ty
Syntax' SrcLoc
s (forall ty. Text -> Term' ty
TVar Text
v)

-- | Terms of the Swarm language.
data Term' ty
  = -- | The unit value.
    TUnit
  | -- | A constant.
    TConst Const
  | -- | A direction literal.
    TDir Direction
  | -- | An integer literal.
    TInt Integer
  | -- | An antiquoted Haskell variable name of type Integer.
    TAntiInt Text
  | -- | A text literal.
    TText Text
  | -- | An antiquoted Haskell variable name of type Text.
    TAntiText Text
  | -- | A Boolean literal.
    TBool Bool
  | -- | 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.
    TRobot Int
  | -- | A memory reference.  These likewise never show up in surface syntax,
    --   but are here to facilitate pretty-printing.
    TRef Int
  | -- | Require a specific device to be installed.
    TRequireDevice Text
  | -- | Require a certain number of an entity.
    TRequire Int Text
  | -- | 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. `force` may have been added
    --   around some variables, etc.)
    SRequirements Text (Syntax' ty)
  | -- | A variable.
    TVar Var
  | -- | A pair.
    SPair (Syntax' ty) (Syntax' ty)
  | -- | A lambda expression, with or without a type annotation on the
    --   binder.
    SLam LocVar (Maybe Type) (Syntax' ty)
  | -- | Function application.
    SApp (Syntax' ty) (Syntax' ty)
  | -- | A (recursive) let expression, with or without a type
    --   annotation on the variable. The @Bool@ indicates whether
    --   it is known to be recursive.
    SLet Bool LocVar (Maybe Polytype) (Syntax' ty) (Syntax' ty)
  | -- | 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.
    SDef Bool LocVar (Maybe Polytype) (Syntax' ty)
  | -- | A monadic bind for commands, of the form @c1 ; c2@ or @x <- c1; c2@.
    SBind (Maybe LocVar) (Syntax' ty) (Syntax' ty)
  | -- | 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.
    SDelay DelayType (Syntax' ty)
  | -- | Record literals @[x1 = e1, x2 = e2, x3, ...]@ Names @x@
    --   without an accompanying definition are sugar for writing
    --   @x=x@.
    SRcd (Map Var (Maybe (Syntax' ty)))
  | -- | Record projection @e.x@
    SProj (Syntax' ty) Var
  | -- | Annotate a term with a type
    SAnnotate (Syntax' ty) Polytype
  deriving
    ( Term' ty -> Term' ty -> Bool
forall ty. Eq ty => Term' ty -> Term' ty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term' ty -> Term' ty -> Bool
$c/= :: forall ty. Eq ty => Term' ty -> Term' ty -> Bool
== :: Term' ty -> Term' ty -> Bool
$c== :: forall ty. Eq ty => Term' ty -> Term' ty -> Bool
Eq
    , Int -> Term' ty -> ShowS
forall ty. Show ty => Int -> Term' ty -> ShowS
forall ty. Show ty => [Term' ty] -> ShowS
forall ty. Show ty => Term' ty -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Term' ty] -> ShowS
$cshowList :: forall ty. Show ty => [Term' ty] -> ShowS
show :: Term' ty -> [Char]
$cshow :: forall ty. Show ty => Term' ty -> [Char]
showsPrec :: Int -> Term' ty -> ShowS
$cshowsPrec :: forall ty. Show ty => Int -> Term' ty -> ShowS
Show
    , forall a b. a -> Term' b -> Term' a
forall a b. (a -> b) -> Term' a -> Term' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Term' b -> Term' a
$c<$ :: forall a b. a -> Term' b -> Term' a
fmap :: forall a b. (a -> b) -> Term' a -> Term' b
$cfmap :: forall a b. (a -> b) -> Term' a -> Term' b
Functor
    , forall a. Eq a => a -> Term' a -> Bool
forall a. Num a => Term' a -> a
forall a. Ord a => Term' a -> a
forall m. Monoid m => Term' m -> m
forall a. Term' a -> Bool
forall a. Term' a -> Int
forall a. Term' a -> [a]
forall a. (a -> a -> a) -> Term' a -> a
forall m a. Monoid m => (a -> m) -> Term' a -> m
forall b a. (b -> a -> b) -> b -> Term' a -> b
forall a b. (a -> b -> b) -> b -> Term' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Term' a -> a
$cproduct :: forall a. Num a => Term' a -> a
sum :: forall a. Num a => Term' a -> a
$csum :: forall a. Num a => Term' a -> a
minimum :: forall a. Ord a => Term' a -> a
$cminimum :: forall a. Ord a => Term' a -> a
maximum :: forall a. Ord a => Term' a -> a
$cmaximum :: forall a. Ord a => Term' a -> a
elem :: forall a. Eq a => a -> Term' a -> Bool
$celem :: forall a. Eq a => a -> Term' a -> Bool
length :: forall a. Term' a -> Int
$clength :: forall a. Term' a -> Int
null :: forall a. Term' a -> Bool
$cnull :: forall a. Term' a -> Bool
toList :: forall a. Term' a -> [a]
$ctoList :: forall a. Term' a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Term' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Term' a -> a
foldr1 :: forall a. (a -> a -> a) -> Term' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Term' a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Term' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Term' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Term' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Term' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Term' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Term' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Term' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Term' a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Term' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Term' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Term' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Term' a -> m
fold :: forall m. Monoid m => Term' m -> m
$cfold :: forall m. Monoid m => Term' m -> m
Foldable
    , Term' ty -> DataType
Term' ty -> Constr
forall {ty}. Data ty => Typeable (Term' ty)
forall ty. Data ty => Term' ty -> DataType
forall ty. Data ty => Term' ty -> Constr
forall ty.
Data ty =>
(forall b. Data b => b -> b) -> Term' ty -> Term' ty
forall ty u.
Data ty =>
Int -> (forall d. Data d => d -> u) -> Term' ty -> u
forall ty u.
Data ty =>
(forall d. Data d => d -> u) -> Term' ty -> [u]
forall ty r r'.
Data ty =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Term' ty -> r
forall ty r r'.
Data ty =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Term' ty -> r
forall ty (m :: * -> *).
(Data ty, Monad m) =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
forall ty (c :: * -> *).
Data ty =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Term' ty)
forall ty (c :: * -> *).
Data ty =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Term' ty -> c (Term' ty)
forall ty (t :: * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Term' ty))
forall ty (t :: * -> * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Term' ty))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Term' ty)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Term' ty -> c (Term' ty)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Term' ty))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
$cgmapMo :: forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
$cgmapMp :: forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
$cgmapM :: forall ty (m :: * -> *).
(Data ty, Monad m) =>
(forall d. Data d => d -> m d) -> Term' ty -> m (Term' ty)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Term' ty -> u
$cgmapQi :: forall ty u.
Data ty =>
Int -> (forall d. Data d => d -> u) -> Term' ty -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Term' ty -> [u]
$cgmapQ :: forall ty u.
Data ty =>
(forall d. Data d => d -> u) -> Term' ty -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Term' ty -> r
$cgmapQr :: forall ty r r'.
Data ty =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Term' ty -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Term' ty -> r
$cgmapQl :: forall ty r r'.
Data ty =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Term' ty -> r
gmapT :: (forall b. Data b => b -> b) -> Term' ty -> Term' ty
$cgmapT :: forall ty.
Data ty =>
(forall b. Data b => b -> b) -> Term' ty -> Term' ty
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Term' ty))
$cdataCast2 :: forall ty (t :: * -> * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Term' ty))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Term' ty))
$cdataCast1 :: forall ty (t :: * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Term' ty))
dataTypeOf :: Term' ty -> DataType
$cdataTypeOf :: forall ty. Data ty => Term' ty -> DataType
toConstr :: Term' ty -> Constr
$ctoConstr :: forall ty. Data ty => Term' ty -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Term' ty)
$cgunfold :: forall ty (c :: * -> *).
Data ty =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Term' ty)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Term' ty -> c (Term' ty)
$cgfoldl :: forall ty (c :: * -> *).
Data ty =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Term' ty -> c (Term' ty)
Data
    , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ty x. Rep (Term' ty) x -> Term' ty
forall ty x. Term' ty -> Rep (Term' ty) x
$cto :: forall ty x. Rep (Term' ty) x -> Term' ty
$cfrom :: forall ty x. Term' ty -> Rep (Term' ty) x
Generic
    , forall ty. FromJSON ty => Value -> Parser [Term' ty]
forall ty. FromJSON ty => Value -> Parser (Term' ty)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Term' ty]
$cparseJSONList :: forall ty. FromJSON ty => Value -> Parser [Term' ty]
parseJSON :: Value -> Parser (Term' ty)
$cparseJSON :: forall ty. FromJSON ty => Value -> Parser (Term' ty)
FromJSON
    , forall ty. ToJSON ty => [Term' ty] -> Encoding
forall ty. ToJSON ty => [Term' ty] -> Value
forall ty. ToJSON ty => Term' ty -> Encoding
forall ty. ToJSON ty => Term' ty -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Term' ty] -> Encoding
$ctoEncodingList :: forall ty. ToJSON ty => [Term' ty] -> Encoding
toJSONList :: [Term' ty] -> Value
$ctoJSONList :: forall ty. ToJSON ty => [Term' ty] -> Value
toEncoding :: Term' ty -> Encoding
$ctoEncoding :: forall ty. ToJSON ty => Term' ty -> Encoding
toJSON :: Term' ty -> Value
$ctoJSON :: forall ty. ToJSON ty => Term' ty -> Value
ToJSON
    , -- | The Traversable instance for Term (and for Syntax') is used during
      -- typechecking: during intermediate type inference, many of the type
      -- annotations placed on AST nodes will have unification variables in
      -- them. Once we have finished solving everything we need to do a
      -- final traversal over all the types in the AST to substitute away
      -- all the unification variables (and generalize, i.e. stick 'forall'
      -- on, as appropriate).  See the call to 'mapM' in
      -- Swarm.Language.Typecheck.runInfer.
      Functor Term'
Foldable Term'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Term' (m a) -> m (Term' a)
forall (f :: * -> *) a. Applicative f => Term' (f a) -> f (Term' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Term' a -> m (Term' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Term' a -> f (Term' b)
sequence :: forall (m :: * -> *) a. Monad m => Term' (m a) -> m (Term' a)
$csequence :: forall (m :: * -> *) a. Monad m => Term' (m a) -> m (Term' a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Term' a -> m (Term' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Term' a -> m (Term' b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Term' (f a) -> f (Term' a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Term' (f a) -> f (Term' a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Term' a -> f (Term' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Term' a -> f (Term' b)
Traversable
    )

type Term = Term' ()

instance Data ty => Plated (Term' ty) where
  plate :: Traversal' (Term' ty) (Term' ty)
plate = forall a. Data a => Traversal' a a
uniplate

------------------------------------------------------------
-- Syntax: annotation on top of Terms with SrcLoc and type
------------------------------------------------------------

-- | The surface syntax for the language, with location and type annotations.
data Syntax' ty = Syntax'
  { forall ty. Syntax' ty -> SrcLoc
_sLoc :: SrcLoc
  , forall ty. Syntax' ty -> Term' ty
_sTerm :: Term' ty
  , forall ty. Syntax' ty -> ty
_sType :: ty
  }
  deriving (Syntax' ty -> Syntax' ty -> Bool
forall ty. Eq ty => Syntax' ty -> Syntax' ty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Syntax' ty -> Syntax' ty -> Bool
$c/= :: forall ty. Eq ty => Syntax' ty -> Syntax' ty -> Bool
== :: Syntax' ty -> Syntax' ty -> Bool
$c== :: forall ty. Eq ty => Syntax' ty -> Syntax' ty -> Bool
Eq, Int -> Syntax' ty -> ShowS
forall ty. Show ty => Int -> Syntax' ty -> ShowS
forall ty. Show ty => [Syntax' ty] -> ShowS
forall ty. Show ty => Syntax' ty -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Syntax' ty] -> ShowS
$cshowList :: forall ty. Show ty => [Syntax' ty] -> ShowS
show :: Syntax' ty -> [Char]
$cshow :: forall ty. Show ty => Syntax' ty -> [Char]
showsPrec :: Int -> Syntax' ty -> ShowS
$cshowsPrec :: forall ty. Show ty => Int -> Syntax' ty -> ShowS
Show, forall a b. a -> Syntax' b -> Syntax' a
forall a b. (a -> b) -> Syntax' a -> Syntax' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Syntax' b -> Syntax' a
$c<$ :: forall a b. a -> Syntax' b -> Syntax' a
fmap :: forall a b. (a -> b) -> Syntax' a -> Syntax' b
$cfmap :: forall a b. (a -> b) -> Syntax' a -> Syntax' b
Functor, forall a. Eq a => a -> Syntax' a -> Bool
forall a. Num a => Syntax' a -> a
forall a. Ord a => Syntax' a -> a
forall m. Monoid m => Syntax' m -> m
forall a. Syntax' a -> Bool
forall a. Syntax' a -> Int
forall a. Syntax' a -> [a]
forall a. (a -> a -> a) -> Syntax' a -> a
forall m a. Monoid m => (a -> m) -> Syntax' a -> m
forall b a. (b -> a -> b) -> b -> Syntax' a -> b
forall a b. (a -> b -> b) -> b -> Syntax' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Syntax' a -> a
$cproduct :: forall a. Num a => Syntax' a -> a
sum :: forall a. Num a => Syntax' a -> a
$csum :: forall a. Num a => Syntax' a -> a
minimum :: forall a. Ord a => Syntax' a -> a
$cminimum :: forall a. Ord a => Syntax' a -> a
maximum :: forall a. Ord a => Syntax' a -> a
$cmaximum :: forall a. Ord a => Syntax' a -> a
elem :: forall a. Eq a => a -> Syntax' a -> Bool
$celem :: forall a. Eq a => a -> Syntax' a -> Bool
length :: forall a. Syntax' a -> Int
$clength :: forall a. Syntax' a -> Int
null :: forall a. Syntax' a -> Bool
$cnull :: forall a. Syntax' a -> Bool
toList :: forall a. Syntax' a -> [a]
$ctoList :: forall a. Syntax' a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Syntax' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Syntax' a -> a
foldr1 :: forall a. (a -> a -> a) -> Syntax' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Syntax' a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Syntax' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Syntax' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Syntax' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Syntax' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Syntax' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Syntax' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Syntax' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Syntax' a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Syntax' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Syntax' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Syntax' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Syntax' a -> m
fold :: forall m. Monoid m => Syntax' m -> m
$cfold :: forall m. Monoid m => Syntax' m -> m
Foldable, Functor Syntax'
Foldable Syntax'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Syntax' (m a) -> m (Syntax' a)
forall (f :: * -> *) a.
Applicative f =>
Syntax' (f a) -> f (Syntax' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Syntax' a -> m (Syntax' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Syntax' a -> f (Syntax' b)
sequence :: forall (m :: * -> *) a. Monad m => Syntax' (m a) -> m (Syntax' a)
$csequence :: forall (m :: * -> *) a. Monad m => Syntax' (m a) -> m (Syntax' a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Syntax' a -> m (Syntax' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Syntax' a -> m (Syntax' b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Syntax' (f a) -> f (Syntax' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Syntax' (f a) -> f (Syntax' a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Syntax' a -> f (Syntax' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Syntax' a -> f (Syntax' b)
Traversable, Syntax' ty -> DataType
Syntax' ty -> Constr
forall {ty}. Data ty => Typeable (Syntax' ty)
forall ty. Data ty => Syntax' ty -> DataType
forall ty. Data ty => Syntax' ty -> Constr
forall ty.
Data ty =>
(forall b. Data b => b -> b) -> Syntax' ty -> Syntax' ty
forall ty u.
Data ty =>
Int -> (forall d. Data d => d -> u) -> Syntax' ty -> u
forall ty u.
Data ty =>
(forall d. Data d => d -> u) -> Syntax' ty -> [u]
forall ty r r'.
Data ty =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r
forall ty r r'.
Data ty =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r
forall ty (m :: * -> *).
(Data ty, Monad m) =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
forall ty (c :: * -> *).
Data ty =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Syntax' ty)
forall ty (c :: * -> *).
Data ty =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Syntax' ty -> c (Syntax' ty)
forall ty (t :: * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Syntax' ty))
forall ty (t :: * -> * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Syntax' ty))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Syntax' ty)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Syntax' ty -> c (Syntax' ty)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Syntax' ty))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
$cgmapMo :: forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
$cgmapMp :: forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
$cgmapM :: forall ty (m :: * -> *).
(Data ty, Monad m) =>
(forall d. Data d => d -> m d) -> Syntax' ty -> m (Syntax' ty)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Syntax' ty -> u
$cgmapQi :: forall ty u.
Data ty =>
Int -> (forall d. Data d => d -> u) -> Syntax' ty -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Syntax' ty -> [u]
$cgmapQ :: forall ty u.
Data ty =>
(forall d. Data d => d -> u) -> Syntax' ty -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r
$cgmapQr :: forall ty r r'.
Data ty =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r
$cgmapQl :: forall ty r r'.
Data ty =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Syntax' ty -> r
gmapT :: (forall b. Data b => b -> b) -> Syntax' ty -> Syntax' ty
$cgmapT :: forall ty.
Data ty =>
(forall b. Data b => b -> b) -> Syntax' ty -> Syntax' ty
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Syntax' ty))
$cdataCast2 :: forall ty (t :: * -> * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Syntax' ty))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Syntax' ty))
$cdataCast1 :: forall ty (t :: * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Syntax' ty))
dataTypeOf :: Syntax' ty -> DataType
$cdataTypeOf :: forall ty. Data ty => Syntax' ty -> DataType
toConstr :: Syntax' ty -> Constr
$ctoConstr :: forall ty. Data ty => Syntax' ty -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Syntax' ty)
$cgunfold :: forall ty (c :: * -> *).
Data ty =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Syntax' ty)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Syntax' ty -> c (Syntax' ty)
$cgfoldl :: forall ty (c :: * -> *).
Data ty =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Syntax' ty -> c (Syntax' ty)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ty x. Rep (Syntax' ty) x -> Syntax' ty
forall ty x. Syntax' ty -> Rep (Syntax' ty) x
$cto :: forall ty x. Rep (Syntax' ty) x -> Syntax' ty
$cfrom :: forall ty x. Syntax' ty -> Rep (Syntax' ty) x
Generic, forall ty. FromJSON ty => Value -> Parser [Syntax' ty]
forall ty. FromJSON ty => Value -> Parser (Syntax' ty)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Syntax' ty]
$cparseJSONList :: forall ty. FromJSON ty => Value -> Parser [Syntax' ty]
parseJSON :: Value -> Parser (Syntax' ty)
$cparseJSON :: forall ty. FromJSON ty => Value -> Parser (Syntax' ty)
FromJSON, forall ty. ToJSON ty => [Syntax' ty] -> Encoding
forall ty. ToJSON ty => [Syntax' ty] -> Value
forall ty. ToJSON ty => Syntax' ty -> Encoding
forall ty. ToJSON ty => Syntax' ty -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Syntax' ty] -> Encoding
$ctoEncodingList :: forall ty. ToJSON ty => [Syntax' ty] -> Encoding
toJSONList :: [Syntax' ty] -> Value
$ctoJSONList :: forall ty. ToJSON ty => [Syntax' ty] -> Value
toEncoding :: Syntax' ty -> Encoding
$ctoEncoding :: forall ty. ToJSON ty => Syntax' ty -> Encoding
toJSON :: Syntax' ty -> Value
$ctoJSON :: forall ty. ToJSON ty => Syntax' ty -> Value
ToJSON)

instance Data ty => Plated (Syntax' ty) where
  plate :: Traversal' (Syntax' ty) (Syntax' ty)
plate = forall a. Data a => Traversal' a a
uniplate

data SrcLoc
  = NoLoc
  | -- | Half-open interval from start (inclusive) to end (exclusive)
    SrcLoc Int Int
  deriving (SrcLoc -> SrcLoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcLoc -> SrcLoc -> Bool
$c/= :: SrcLoc -> SrcLoc -> Bool
== :: SrcLoc -> SrcLoc -> Bool
$c== :: SrcLoc -> SrcLoc -> Bool
Eq, Eq SrcLoc
SrcLoc -> SrcLoc -> Bool
SrcLoc -> SrcLoc -> Ordering
SrcLoc -> SrcLoc -> SrcLoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SrcLoc -> SrcLoc -> SrcLoc
$cmin :: SrcLoc -> SrcLoc -> SrcLoc
max :: SrcLoc -> SrcLoc -> SrcLoc
$cmax :: SrcLoc -> SrcLoc -> SrcLoc
>= :: SrcLoc -> SrcLoc -> Bool
$c>= :: SrcLoc -> SrcLoc -> Bool
> :: SrcLoc -> SrcLoc -> Bool
$c> :: SrcLoc -> SrcLoc -> Bool
<= :: SrcLoc -> SrcLoc -> Bool
$c<= :: SrcLoc -> SrcLoc -> Bool
< :: SrcLoc -> SrcLoc -> Bool
$c< :: SrcLoc -> SrcLoc -> Bool
compare :: SrcLoc -> SrcLoc -> Ordering
$ccompare :: SrcLoc -> SrcLoc -> Ordering
Ord, Int -> SrcLoc -> ShowS
[SrcLoc] -> ShowS
SrcLoc -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SrcLoc] -> ShowS
$cshowList :: [SrcLoc] -> ShowS
show :: SrcLoc -> [Char]
$cshow :: SrcLoc -> [Char]
showsPrec :: Int -> SrcLoc -> ShowS
$cshowsPrec :: Int -> SrcLoc -> ShowS
Show, Typeable SrcLoc
SrcLoc -> DataType
SrcLoc -> Constr
(forall b. Data b => b -> b) -> SrcLoc -> SrcLoc
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SrcLoc -> u
forall u. (forall d. Data d => d -> u) -> SrcLoc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLoc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLoc -> c SrcLoc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLoc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcLoc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcLoc -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcLoc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcLoc -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
gmapT :: (forall b. Data b => b -> b) -> SrcLoc -> SrcLoc
$cgmapT :: (forall b. Data b => b -> b) -> SrcLoc -> SrcLoc
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLoc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLoc)
dataTypeOf :: SrcLoc -> DataType
$cdataTypeOf :: SrcLoc -> DataType
toConstr :: SrcLoc -> Constr
$ctoConstr :: SrcLoc -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLoc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLoc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLoc -> c SrcLoc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLoc -> c SrcLoc
Data, forall x. Rep SrcLoc x -> SrcLoc
forall x. SrcLoc -> Rep SrcLoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrcLoc x -> SrcLoc
$cfrom :: forall x. SrcLoc -> Rep SrcLoc x
Generic, Value -> Parser [SrcLoc]
Value -> Parser SrcLoc
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SrcLoc]
$cparseJSONList :: Value -> Parser [SrcLoc]
parseJSON :: Value -> Parser SrcLoc
$cparseJSON :: Value -> Parser SrcLoc
FromJSON, [SrcLoc] -> Encoding
[SrcLoc] -> Value
SrcLoc -> Encoding
SrcLoc -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SrcLoc] -> Encoding
$ctoEncodingList :: [SrcLoc] -> Encoding
toJSONList :: [SrcLoc] -> Value
$ctoJSONList :: [SrcLoc] -> Value
toEncoding :: SrcLoc -> Encoding
$ctoEncoding :: SrcLoc -> Encoding
toJSON :: SrcLoc -> Value
$ctoJSON :: SrcLoc -> Value
ToJSON)

instance Semigroup SrcLoc where
  SrcLoc
NoLoc <> :: SrcLoc -> SrcLoc -> SrcLoc
<> SrcLoc
l = SrcLoc
l
  SrcLoc
l <> SrcLoc
NoLoc = SrcLoc
l
  SrcLoc Int
s1 Int
e1 <> SrcLoc Int
s2 Int
e2 = Int -> Int -> SrcLoc
SrcLoc (forall a. Ord a => a -> a -> a
min Int
s1 Int
s2) (forall a. Ord a => a -> a -> a
max Int
e1 Int
e2)

instance Monoid SrcLoc where
  mempty :: SrcLoc
mempty = SrcLoc
NoLoc

------------------------------------------------------------
-- Pattern synonyms for untyped terms
------------------------------------------------------------

type Syntax = Syntax' ()

pattern Syntax :: SrcLoc -> Term -> Syntax
pattern $bSyntax :: SrcLoc -> Term -> Syntax
$mSyntax :: forall {r}. Syntax -> (SrcLoc -> Term -> r) -> ((# #) -> r) -> r
Syntax l t = Syntax' l t ()

{-# COMPLETE Syntax #-}

makeLenses ''Syntax'

noLoc :: Term -> Syntax
noLoc :: Term -> Syntax
noLoc = SrcLoc -> Term -> Syntax
Syntax forall a. Monoid a => a
mempty

-- | Match an untyped term without its 'SrcLoc'.
pattern STerm :: Term -> Syntax
pattern $bSTerm :: Term -> Syntax
$mSTerm :: forall {r}. Syntax -> (Term -> r) -> ((# #) -> r) -> r
STerm t <-
  Syntax _ t
  where
    STerm Term
t = SrcLoc -> Term -> Syntax
Syntax forall a. Monoid a => a
mempty Term
t

pattern TRequirements :: Text -> Term -> Term
pattern $bTRequirements :: Text -> Term -> Term
$mTRequirements :: forall {r}. Term -> (Text -> Term -> r) -> ((# #) -> r) -> r
TRequirements x t = SRequirements x (STerm t)

-- | Match a TPair without syntax
pattern TPair :: Term -> Term -> Term
pattern $bTPair :: Term -> Term -> Term
$mTPair :: forall {r}. Term -> (Term -> Term -> r) -> ((# #) -> r) -> r
TPair t1 t2 = SPair (STerm t1) (STerm t2)

-- | Match a TLam without syntax
pattern TLam :: Var -> Maybe Type -> Term -> Term
pattern $bTLam :: Text -> Maybe Type -> Term -> Term
$mTLam :: forall {r}.
Term -> (Text -> Maybe Type -> Term -> r) -> ((# #) -> r) -> r
TLam v ty t <- SLam (lvVar -> v) ty (STerm t)
  where
    TLam Text
v Maybe Type
ty Term
t = forall ty. LocVar -> Maybe Type -> Syntax' ty -> Term' ty
SLam (SrcLoc -> Text -> LocVar
LV SrcLoc
NoLoc Text
v) Maybe Type
ty (Term -> Syntax
STerm Term
t)

-- | Match a TApp without syntax
pattern TApp :: Term -> Term -> Term
pattern $bTApp :: Term -> Term -> Term
$mTApp :: forall {r}. Term -> (Term -> Term -> r) -> ((# #) -> r) -> r
TApp t1 t2 = SApp (STerm t1) (STerm t2)

infixl 0 :$:

-- | Convenient infix pattern synonym for application.
pattern (:$:) :: Term -> Syntax -> Term
pattern $b:$: :: Term -> Syntax -> Term
$m:$: :: forall {r}. Term -> (Term -> Syntax -> r) -> ((# #) -> r) -> r
(:$:) t1 s2 = SApp (STerm t1) s2

-- | Match a TLet without syntax
pattern TLet :: Bool -> Var -> Maybe Polytype -> Term -> Term -> Term
pattern $bTLet :: Bool -> Text -> Maybe Polytype -> Term -> Term -> Term
$mTLet :: forall {r}.
Term
-> (Bool -> Text -> Maybe Polytype -> Term -> Term -> r)
-> ((# #) -> r)
-> r
TLet r v pt t1 t2 <- SLet r (lvVar -> v) pt (STerm t1) (STerm t2)
  where
    TLet Bool
r Text
v Maybe Polytype
pt Term
t1 Term
t2 = forall ty.
Bool
-> LocVar -> Maybe Polytype -> Syntax' ty -> Syntax' ty -> Term' ty
SLet Bool
r (SrcLoc -> Text -> LocVar
LV SrcLoc
NoLoc Text
v) Maybe Polytype
pt (Term -> Syntax
STerm Term
t1) (Term -> Syntax
STerm Term
t2)

-- | Match a TDef without syntax
pattern TDef :: Bool -> Var -> Maybe Polytype -> Term -> Term
pattern $bTDef :: Bool -> Text -> Maybe Polytype -> Term -> Term
$mTDef :: forall {r}.
Term
-> (Bool -> Text -> Maybe Polytype -> Term -> r)
-> ((# #) -> r)
-> r
TDef r v pt t <- SDef r (lvVar -> v) pt (STerm t)
  where
    TDef Bool
r Text
v Maybe Polytype
pt Term
t = forall ty.
Bool -> LocVar -> Maybe Polytype -> Syntax' ty -> Term' ty
SDef Bool
r (SrcLoc -> Text -> LocVar
LV SrcLoc
NoLoc Text
v) Maybe Polytype
pt (Term -> Syntax
STerm Term
t)

-- | Match a TBind without syntax
pattern TBind :: Maybe Var -> Term -> Term -> Term
pattern $bTBind :: Maybe Text -> Term -> Term -> Term
$mTBind :: forall {r}.
Term -> (Maybe Text -> Term -> Term -> r) -> ((# #) -> r) -> r
TBind mv t1 t2 <- SBind (fmap lvVar -> mv) (STerm t1) (STerm t2)
  where
    TBind Maybe Text
mv Term
t1 Term
t2 = forall ty. Maybe LocVar -> Syntax' ty -> Syntax' ty -> Term' ty
SBind (SrcLoc -> Text -> LocVar
LV SrcLoc
NoLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mv) (Term -> Syntax
STerm Term
t1) (Term -> Syntax
STerm Term
t2)

-- | Match a TDelay without syntax
pattern TDelay :: DelayType -> Term -> Term
pattern $bTDelay :: DelayType -> Term -> Term
$mTDelay :: forall {r}. Term -> (DelayType -> Term -> r) -> ((# #) -> r) -> r
TDelay m t = SDelay m (STerm t)

-- | Match a TRcd without syntax
pattern TRcd :: Map Var (Maybe Term) -> Term
pattern $bTRcd :: Map Text (Maybe Term) -> Term
$mTRcd :: forall {r}.
Term -> (Map Text (Maybe Term) -> r) -> ((# #) -> r) -> r
TRcd m <- SRcd ((fmap . fmap) _sTerm -> m)
  where
    TRcd Map Text (Maybe Term)
m = forall ty. Map Text (Maybe (Syntax' ty)) -> Term' ty
SRcd ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Term -> Syntax
STerm Map Text (Maybe Term)
m)

pattern TProj :: Term -> Var -> Term
pattern $bTProj :: Term -> Text -> Term
$mTProj :: forall {r}. Term -> (Term -> Text -> r) -> ((# #) -> r) -> r
TProj t x = SProj (STerm t) x

-- | Match a TAnnotate without syntax
pattern TAnnotate :: Term -> Polytype -> Term
pattern $bTAnnotate :: Term -> Polytype -> Term
$mTAnnotate :: forall {r}. Term -> (Term -> Polytype -> r) -> ((# #) -> r) -> r
TAnnotate t pt = SAnnotate (STerm t) pt

-- | COMPLETE pragma tells GHC using this set of pattern is complete for Term
{-# COMPLETE TUnit, TConst, TDir, TInt, TAntiInt, TText, TAntiText, TBool, TRequireDevice, TRequire, TRequirements, TVar, TPair, TLam, TApp, TLet, TDef, TBind, TDelay, TRcd, TProj, TAnnotate #-}

-- | Make infix operation (e.g. @2 + 3@) a curried function
--   application (@((+) 2) 3@).
mkOp :: Const -> Syntax -> Syntax -> Syntax
mkOp :: Const -> Syntax -> Syntax -> Syntax
mkOp Const
c s1 :: Syntax
s1@(Syntax SrcLoc
l1 Term
_) s2 :: Syntax
s2@(Syntax SrcLoc
l2 Term
_) = SrcLoc -> Term -> Syntax
Syntax SrcLoc
newLoc Term
newTerm
 where
  -- The new syntax span both terms
  newLoc :: SrcLoc
newLoc = SrcLoc
l1 forall a. Semigroup a => a -> a -> a
<> SrcLoc
l2
  -- We don't assign a source location for the operator since it is
  -- usually provided as-is and it is not likely to be useful.
  sop :: Syntax
sop = Term -> Syntax
noLoc (forall ty. Const -> Term' ty
TConst Const
c)
  newTerm :: Term
newTerm = forall ty. Syntax' ty -> Syntax' ty -> Term' ty
SApp (SrcLoc -> Term -> Syntax
Syntax SrcLoc
l1 forall a b. (a -> b) -> a -> b
$ forall ty. Syntax' ty -> Syntax' ty -> Term' ty
SApp Syntax
sop Syntax
s1) Syntax
s2

-- | Make infix operation, discarding any syntax related location
mkOp' :: Const -> Term -> Term -> Term
mkOp' :: Const -> Term -> Term -> Term
mkOp' Const
c Term
t1 = Term -> Term -> Term
TApp (Term -> Term -> Term
TApp (forall ty. Const -> Term' ty
TConst Const
c) Term
t1)

-- $setup
-- >>> import Control.Lens ((^.))

-- | 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]
unfoldApps :: Syntax' ty -> NonEmpty (Syntax' ty)
unfoldApps :: forall ty. Syntax' ty -> NonEmpty (Syntax' ty)
unfoldApps Syntax' ty
trm = forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> (b, Maybe a)) -> a -> NonEmpty b
NonEmpty.unfoldr Syntax' ty
trm forall a b. (a -> b) -> a -> b
$ \case
  Syntax' SrcLoc
_ (SApp Syntax' ty
s1 Syntax' ty
s2) ty
_ -> (Syntax' ty
s2, forall a. a -> Maybe a
Just Syntax' ty
s1)
  Syntax' ty
s -> (Syntax' ty
s, forall a. Maybe a
Nothing)

--------------------------------------------------
-- Erasure

-- | Erase a 'Syntax' tree annotated with type
--   information to a bare unannotated 'Term'.
eraseS :: Syntax' ty -> Term
eraseS :: forall ty. Syntax' ty -> Term
eraseS (Syntax' SrcLoc
_ Term' ty
t ty
_) = forall (f :: * -> *) a. Functor f => f a -> f ()
void Term' ty
t

------------------------------------------------------------
-- Free variable traversals
------------------------------------------------------------

-- | 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'@.
freeVarsS :: forall ty. Traversal' (Syntax' ty) (Syntax' ty)
freeVarsS :: forall ty. Traversal' (Syntax' ty) (Syntax' ty)
freeVarsS Syntax' ty -> f (Syntax' ty)
f = Set Text -> Syntax' ty -> f (Syntax' ty)
go forall a. Set a
S.empty
 where
  -- go :: Applicative f => Set Var -> Syntax' ty -> f (Syntax' ty)
  go :: Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound s :: Syntax' ty
s@(Syntax' SrcLoc
l Term' ty
t ty
ty) = case Term' ty
t of
    Term' ty
TUnit -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TConst {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TDir {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TInt {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TAntiInt {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TText {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TAntiText {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TBool {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TRobot {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TRef {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TRequireDevice {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    TRequire {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
    SRequirements Text
x Syntax' ty
s1 -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. Text -> Syntax' ty -> Term' ty
SRequirements Text
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s1
    TVar Text
x
      | Text
x forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
bound -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Syntax' ty
s
      | Bool
otherwise -> Syntax' ty -> f (Syntax' ty)
f Syntax' ty
s
    SLam LocVar
x Maybe Type
xty Syntax' ty
s1 -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. LocVar -> Maybe Type -> Syntax' ty -> Term' ty
SLam LocVar
x Maybe Type
xty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go (forall a. Ord a => a -> Set a -> Set a
S.insert (LocVar -> Text
lvVar LocVar
x) Set Text
bound) Syntax' ty
s1
    SApp Syntax' ty
s1 Syntax' ty
s2 -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. Syntax' ty -> Syntax' ty -> Term' ty
SApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s2
    SLet Bool
r LocVar
x Maybe Polytype
xty Syntax' ty
s1 Syntax' ty
s2 ->
      let bound' :: Set Text
bound' = forall a. Ord a => a -> Set a -> Set a
S.insert (LocVar -> Text
lvVar LocVar
x) Set Text
bound
       in forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty.
Bool
-> LocVar -> Maybe Polytype -> Syntax' ty -> Syntax' ty -> Term' ty
SLet Bool
r LocVar
x Maybe Polytype
xty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound' Syntax' ty
s1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound' Syntax' ty
s2
    SPair Syntax' ty
s1 Syntax' ty
s2 -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. Syntax' ty -> Syntax' ty -> Term' ty
SPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s2
    SDef Bool
r LocVar
x Maybe Polytype
xty Syntax' ty
s1 -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty.
Bool -> LocVar -> Maybe Polytype -> Syntax' ty -> Term' ty
SDef Bool
r LocVar
x Maybe Polytype
xty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go (forall a. Ord a => a -> Set a -> Set a
S.insert (LocVar -> Text
lvVar LocVar
x) Set Text
bound) Syntax' ty
s1
    SBind Maybe LocVar
mx Syntax' ty
s1 Syntax' ty
s2 -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. Maybe LocVar -> Syntax' ty -> Syntax' ty -> Term' ty
SBind Maybe LocVar
mx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Text -> Syntax' ty -> f (Syntax' ty)
go (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a. Ord a => a -> Set a -> Set a
S.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocVar -> Text
lvVar) Maybe LocVar
mx Set Text
bound) Syntax' ty
s2
    SDelay DelayType
m Syntax' ty
s1 -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. DelayType -> Syntax' ty -> Term' ty
SDelay DelayType
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s1
    SRcd Map Text (Maybe (Syntax' ty))
m -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. Map Text (Maybe (Syntax' ty)) -> Term' ty
SRcd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound) Map Text (Maybe (Syntax' ty))
m
    SProj Syntax' ty
s1 Text
x -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. Syntax' ty -> Text -> Term' ty
SProj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
    SAnnotate Syntax' ty
s1 Polytype
pty -> forall {f :: * -> *}.
Applicative f =>
f (Term' ty) -> f (Syntax' ty)
rewrap forall a b. (a -> b) -> a -> b
$ forall ty. Syntax' ty -> Polytype -> Term' ty
SAnnotate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Syntax' ty -> f (Syntax' ty)
go Set Text
bound Syntax' ty
s1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Polytype
pty
   where
    rewrap :: f (Term' ty) -> f (Syntax' ty)
rewrap f (Term' ty)
s' = forall ty. SrcLoc -> Term' ty -> ty -> Syntax' ty
Syntax' SrcLoc
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Term' ty)
s' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ty
ty

-- | Like 'freeVarsS', but traverse over the 'Term's containing free
--   variables.  More direct if you don't need to know the types or
--   source locations of the variables.  Note that if you want to get
--   the list of all `Term`s representing free variables, you can do so via
--   @'toListOf' 'freeVarsT'@.
freeVarsT :: forall ty. Traversal' (Syntax' ty) (Term' ty)
freeVarsT :: forall ty. Traversal' (Syntax' ty) (Term' ty)
freeVarsT = forall ty. Traversal' (Syntax' ty) (Syntax' ty)
freeVarsS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ty. Lens' (Syntax' ty) (Term' ty)
sTerm

-- | Traversal over the free variables of a term.  Like 'freeVarsS'
--   and 'freeVarsT', but traverse over the variable names
--   themselves.  Note that if you want to get the set of all free
--   variable names, you can do so via @'Data.Set.Lens.setOf'
--   'freeVarsV'@.
freeVarsV :: Traversal' (Syntax' ty) Var
freeVarsV :: forall ty. Traversal' (Syntax' ty) Text
freeVarsV = forall ty. Traversal' (Syntax' ty) (Term' ty)
freeVarsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text -> f Text
f -> \case TVar Text
x -> forall ty. Text -> Term' ty
TVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
x; Term' ty
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term' ty
t)

-- | Apply a function to all free occurrences of a particular variable.
mapFreeS :: Var -> (Syntax' ty -> Syntax' ty) -> Syntax' ty -> Syntax' ty
mapFreeS :: forall ty.
Text -> (Syntax' ty -> Syntax' ty) -> Syntax' ty -> Syntax' ty
mapFreeS Text
x Syntax' ty -> Syntax' ty
f = forall ty. Traversal' (Syntax' ty) (Syntax' ty)
freeVarsS forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Syntax' ty
t -> case Syntax' ty
t forall s a. s -> Getting a s a -> a
^. forall ty. Lens' (Syntax' ty) (Term' ty)
sTerm of TVar Text
y | Text
y forall a. Eq a => a -> a -> Bool
== Text
x -> Syntax' ty -> Syntax' ty
f Syntax' ty
t; Term' ty
_ -> Syntax' ty
t)

-- | Transform the AST into a Tree datatype.
-- Useful for pretty-printing (e.g. via "Data.Tree.drawTree").
asTree :: Data a => Syntax' a -> Tree (Syntax' a)
asTree :: forall a. Data a => Syntax' a -> Tree (Syntax' a)
asTree = forall a r. Plated a => (a -> [r] -> r) -> a -> r
para forall a. a -> [Tree a] -> Tree a
Node

-- | Each constructor is a assigned a value of 1, plus
-- any recursive syntax it entails.
measureAstSize :: Data a => Syntax' a -> Int
measureAstSize :: forall a. Data a => Syntax' a -> Int
measureAstSize = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Plated a => a -> [a]
universe