{-# 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,

  -- * 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
  erase,
  eraseS,

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

import Control.Lens (Plated (..), Traversal', makeLenses, para, universe, (%~), (^.))
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

------------------------------------------------------------
-- 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
  | -- | 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
  | -- | Try to place an item at the current location.
    Place
  | -- | 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)

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
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
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
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, 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, 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.

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 @SrcLoc@ and 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 ty. Term' ty -> Term
erase Term' ty
t

-- | Erase a type-annotated term to a bare term.
erase :: Term' ty -> Term
erase :: forall ty. Term' ty -> Term
erase Term' ty
TUnit = forall ty. Term' ty
TUnit
erase (TConst Const
c) = forall ty. Const -> Term' ty
TConst Const
c
erase (TDir Direction
d) = forall ty. Direction -> Term' ty
TDir Direction
d
erase (TInt Integer
n) = forall ty. Integer -> Term' ty
TInt Integer
n
erase (TAntiInt Text
v) = forall ty. Text -> Term' ty
TAntiInt Text
v
erase (TText Text
t) = forall ty. Text -> Term' ty
TText Text
t
erase (TAntiText Text
v) = forall ty. Text -> Term' ty
TAntiText Text
v
erase (TBool Bool
b) = forall ty. Bool -> Term' ty
TBool Bool
b
erase (TRobot Int
r) = forall ty. Int -> Term' ty
TRobot Int
r
erase (TRef Int
r) = forall ty. Int -> Term' ty
TRef Int
r
erase (TRequireDevice Text
d) = forall ty. Text -> Term' ty
TRequireDevice Text
d
erase (TRequire Int
n Text
e) = forall ty. Int -> Text -> Term' ty
TRequire Int
n Text
e
erase (SRequirements Text
x Syntax' ty
s) = Text -> Term -> Term
TRequirements Text
x (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s)
erase (TVar Text
s) = forall ty. Text -> Term' ty
TVar Text
s
erase (SDelay DelayType
x Syntax' ty
s) = DelayType -> Term -> Term
TDelay DelayType
x (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s)
erase (SPair Syntax' ty
s1 Syntax' ty
s2) = Term -> Term -> Term
TPair (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s1) (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s2)
erase (SLam LocVar
x Maybe Type
mty Syntax' ty
body) = Text -> Maybe Type -> Term -> Term
TLam (LocVar -> Text
lvVar LocVar
x) Maybe Type
mty (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
body)
erase (SApp Syntax' ty
s1 Syntax' ty
s2) = Term -> Term -> Term
TApp (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s1) (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s2)
erase (SLet Bool
r LocVar
x Maybe Polytype
mty Syntax' ty
s1 Syntax' ty
s2) = Bool -> Text -> Maybe Polytype -> Term -> Term -> Term
TLet Bool
r (LocVar -> Text
lvVar LocVar
x) Maybe Polytype
mty (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s1) (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s2)
erase (SDef Bool
r LocVar
x Maybe Polytype
mty Syntax' ty
s) = Bool -> Text -> Maybe Polytype -> Term -> Term
TDef Bool
r (LocVar -> Text
lvVar LocVar
x) Maybe Polytype
mty (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s)
erase (SBind Maybe LocVar
mx Syntax' ty
s1 Syntax' ty
s2) = Maybe Text -> Term -> Term -> Term
TBind (LocVar -> Text
lvVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocVar
mx) (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s1) (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s2)
erase (SRcd Map Text (Maybe (Syntax' ty))
m) = Map Text (Maybe Term) -> Term
TRcd ((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) forall ty. Syntax' ty -> Term
eraseS Map Text (Maybe (Syntax' ty))
m)
erase (SProj Syntax' ty
s Text
x) = Term -> Text -> Term
TProj (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s) Text
x
erase (SAnnotate Syntax' ty
s Polytype
pty) = Term -> Polytype -> Term
TAnnotate (forall ty. Syntax' ty -> Term
eraseS Syntax' ty
s) Polytype
pty

------------------------------------------------------------
-- 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