{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :  Swarm.Language.Syntax
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Abstract syntax for terms of the Swarm programming language.
module Swarm.Language.Syntax (
  -- * Directions
  Direction (..),
  DirInfo (..),
  applyTurn,
  toDirection,
  fromDirection,
  allDirs,
  isCardinal,
  dirInfo,
  north,
  south,
  east,
  west,

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

  -- * Syntax
  Syntax (..),
  Location (..),
  noLoc,
  pattern STerm,
  pattern TPair,
  pattern TLam,
  pattern TApp,
  pattern (:$:),
  pattern TLet,
  pattern TDef,
  pattern TBind,
  pattern TDelay,

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

  -- * Term traversal
  fvT,
  fv,
  mapFree1,
) where

import Control.Lens (Plated (..), Traversal', (%~))
import Data.Aeson.Types
import Data.Data (Data)
import Data.Data.Lens (uniplate)
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Set qualified as S
import Data.String (IsString (fromString))
import Data.Text hiding (filter, map)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Linear
import Swarm.Language.Types
import Witch.From (from)

------------------------------------------------------------
-- Constants
------------------------------------------------------------

-- | The type of directions. Used /e.g./ to indicate which way a robot
--   will turn.
data Direction = DLeft | DRight | DBack | DForward | DNorth | DSouth | DEast | DWest | DDown
  deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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 :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
Ord, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read, forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic, Typeable Direction
Direction -> DataType
Direction -> Constr
(forall b. Data b => b -> b) -> Direction -> Direction
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) -> Direction -> u
forall u. (forall d. Data d => d -> u) -> Direction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
$cgmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
dataTypeOf :: Direction -> DataType
$cdataTypeOf :: Direction -> DataType
toConstr :: Direction -> Constr
$ctoConstr :: Direction -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
Data, Eq Direction
Int -> Direction -> Int
Direction -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Direction -> Int
$chash :: Direction -> Int
hashWithSalt :: Int -> Direction -> Int
$chashWithSalt :: Int -> Direction -> Int
Hashable, [Direction] -> Encoding
[Direction] -> Value
Direction -> Encoding
Direction -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Direction] -> Encoding
$ctoEncodingList :: [Direction] -> Encoding
toJSONList :: [Direction] -> Value
$ctoJSONList :: [Direction] -> Value
toEncoding :: Direction -> Encoding
$ctoEncoding :: Direction -> Encoding
toJSON :: Direction -> Value
$ctoJSON :: Direction -> Value
ToJSON, Value -> Parser [Direction]
Value -> Parser Direction
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Direction]
$cparseJSONList :: Value -> Parser [Direction]
parseJSON :: Value -> Parser Direction
$cparseJSON :: Value -> Parser Direction
FromJSON, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
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 :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum, Direction
forall a. a -> a -> Bounded a
maxBound :: Direction
$cmaxBound :: Direction
minBound :: Direction
$cminBound :: Direction
Bounded)

instance ToJSONKey Direction where
  toJSONKey :: ToJSONKeyFunction Direction
toJSONKey = forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
defaultJSONKeyOptions

instance FromJSONKey Direction where
  fromJSONKey :: FromJSONKeyFunction Direction
fromJSONKey = forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
defaultJSONKeyOptions

data DirInfo = DirInfo
  { DirInfo -> Text
dirSyntax :: Text
  , -- absolute direction if it exists
    DirInfo -> Maybe (V2 Int64)
dirAbs :: Maybe (V2 Int64)
  , -- the turning for the direction
    DirInfo -> V2 Int64 -> V2 Int64
dirApplyTurn :: V2 Int64 -> V2 Int64
  }

allDirs :: [Direction]
allDirs :: [Direction]
allDirs = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

-- | Information about all directions
dirInfo :: Direction -> DirInfo
dirInfo :: Direction -> DirInfo
dirInfo Direction
d = case Direction
d of
  Direction
DLeft -> (V2 Int64 -> V2 Int64) -> DirInfo
relative (\(V2 Int64
x Int64
y) -> forall a. a -> a -> V2 a
V2 (-Int64
y) Int64
x)
  Direction
DRight -> (V2 Int64 -> V2 Int64) -> DirInfo
relative (\(V2 Int64
x Int64
y) -> forall a. a -> a -> V2 a
V2 Int64
y (-Int64
x))
  Direction
DBack -> (V2 Int64 -> V2 Int64) -> DirInfo
relative (\(V2 Int64
x Int64
y) -> forall a. a -> a -> V2 a
V2 (-Int64
x) (-Int64
y))
  Direction
DDown -> (V2 Int64 -> V2 Int64) -> DirInfo
relative (forall a b. a -> b -> a
const V2 Int64
down)
  Direction
DForward -> (V2 Int64 -> V2 Int64) -> DirInfo
relative forall a. a -> a
id
  Direction
DNorth -> V2 Int64 -> DirInfo
cardinal V2 Int64
north
  Direction
DSouth -> V2 Int64 -> DirInfo
cardinal V2 Int64
south
  Direction
DEast -> V2 Int64 -> DirInfo
cardinal V2 Int64
east
  Direction
DWest -> V2 Int64 -> DirInfo
cardinal V2 Int64
west
 where
  -- name is generate from Direction data constuctor
  -- e.g. DLeft becomes "left"
  directionSyntax :: Text
directionSyntax = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Direction
d
  cardinal :: V2 Int64 -> DirInfo
cardinal V2 Int64
v2 = Text -> Maybe (V2 Int64) -> (V2 Int64 -> V2 Int64) -> DirInfo
DirInfo Text
directionSyntax (forall a. a -> Maybe a
Just V2 Int64
v2) (forall a b. a -> b -> a
const V2 Int64
v2)
  relative :: (V2 Int64 -> V2 Int64) -> DirInfo
relative = Text -> Maybe (V2 Int64) -> (V2 Int64 -> V2 Int64) -> DirInfo
DirInfo Text
directionSyntax forall a. Maybe a
Nothing

-- | Check if the direction is absolute (e.g. 'north' or 'south').
isCardinal :: Direction -> Bool
isCardinal :: Direction -> Bool
isCardinal = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirInfo -> Maybe (V2 Int64)
dirAbs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> DirInfo
dirInfo

-- | The cardinal direction north = @V2 0 1@.
north :: V2 Int64
north :: V2 Int64
north = forall a. a -> a -> V2 a
V2 Int64
0 Int64
1

-- | The cardinal direction south = @V2 0 (-1)@.
south :: V2 Int64
south :: V2 Int64
south = forall a. a -> a -> V2 a
V2 Int64
0 (-Int64
1)

-- | The cardinal direction east = @V2 1 0@.
east :: V2 Int64
east :: V2 Int64
east = forall a. a -> a -> V2 a
V2 Int64
1 Int64
0

-- | The cardinal direction west = @V2 (-1) 0@.
west :: V2 Int64
west :: V2 Int64
west = forall a. a -> a -> V2 a
V2 (-Int64
1) Int64
0

-- | The direction for viewing the current cell = @V2 0 0@.
down :: V2 Int64
down :: V2 Int64
down = forall a. a -> a -> V2 a
V2 Int64
0 Int64
0

-- | The 'applyTurn' function gives the meaning of each 'Direction' by
--   turning relative to the given vector or by turning to an absolute
--   direction vector.
applyTurn :: Direction -> V2 Int64 -> V2 Int64
applyTurn :: Direction -> V2 Int64 -> V2 Int64
applyTurn = DirInfo -> V2 Int64 -> V2 Int64
dirApplyTurn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> DirInfo
dirInfo

-- | Mapping from heading to their corresponding cardinal directions
--   only directions with a 'dirAbs` value are mapped
cardinalDirs :: M.Map (V2 Int64) Direction
cardinalDirs :: Map (V2 Int64) Direction
cardinalDirs =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Direction
d -> (,Direction
d) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirInfo -> Maybe (V2 Int64)
dirAbs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> DirInfo
dirInfo forall a b. (a -> b) -> a -> b
$ Direction
d))
    forall a b. (a -> b) -> a -> b
$ [Direction]
allDirs

-- | Possibly convert a vector into a 'Direction'---that is, if the
--   vector happens to be a unit vector in one of the cardinal
--   directions.
toDirection :: V2 Int64 -> Maybe Direction
toDirection :: V2 Int64 -> Maybe Direction
toDirection V2 Int64
v = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup V2 Int64
v Map (V2 Int64) Direction
cardinalDirs

-- | Convert a 'Direction' into a corresponding vector.  Note that
--   this only does something reasonable for 'DNorth', 'DSouth', 'DEast',
--   and 'DWest'---other 'Direction's return the zero vector.
fromDirection :: Direction -> V2 Int64
fromDirection :: Direction -> V2 Int64
fromDirection = forall a. a -> Maybe a -> a
fromMaybe (forall a. a -> a -> V2 a
V2 Int64
0 Int64
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirInfo -> Maybe (V2 Int64)
dirAbs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> DirInfo
dirInfo

-- | Constants, representing various built-in functions and commands.
--
--   IF YOU ADD A NEW CONSTANT, be sure to also update:
--   1. the 'constInfo' function (below)
--   2. the capability checker ("Swarm.Language.Capability")
--   3. the type checker ("Swarm.Language.Typecheck")
--   4. the runtime ("Swarm.Game.Step")
--   5. the emacs mode syntax highlighter (@contribs/swarm-mode.el@)
--
--   GHC will warn you about incomplete pattern matches for the first
--   four, so it's not really possible to forget.  Note you do not
--   need to update the parser or pretty-printer, since they are
--   auto-generated from 'constInfo'.
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
  | -- | 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
  | -- | Install a device on a robot.
    Install
  | -- | Make an item.
    Make
  | -- | Sense whether we have a certain item.
    Has
  | -- | Sense whether we have a certain device installed.
    Installed
  | -- | Sense how many of a certain item we have.
    Count
  | -- | Drill through an entity.
    Drill
  | -- | 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
  | -- Sensing / generation

    -- | Get current time
    Time
  | -- | Get the current x, y coordinates
    Whereami
  | -- | 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. (This may be removed.)
    Ishere
  | -- | Get a reference to oneself
    Self
  | -- | Get the robot's parent
    Parent
  | -- | Get a reference to the base
    Base
  | -- | 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
  | -- 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
  | -- 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 a robot by name.
    RobotNamed
  | -- | Find a robot 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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Const] -> ShowS
$cshowList :: [Const] -> ShowS
show :: Const -> String
$cshow :: Const -> String
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 a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstInfo] -> ShowS
$cshowList :: [ConstInfo] -> ShowS
show :: ConstInfo -> String
$cshow :: ConstInfo -> String
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstDoc] -> ShowS
$cshowList :: [ConstDoc] -> ShowS
show :: ConstDoc -> String
$cshow :: ConstDoc -> String
showsPrec :: Int -> ConstDoc -> ShowS
$cshowsPrec :: Int -> ConstDoc -> ShowS
Show)

instance IsString ConstDoc where
  fromString :: String -> 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
. String -> 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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstMeta] -> ShowS
$cshowList :: [ConstMeta] -> ShowS
show :: ConstMeta -> String
$cshow :: ConstMeta -> String
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MBinAssoc] -> ShowS
$cshowList :: [MBinAssoc] -> ShowS
show :: MBinAssoc -> String
$cshow :: MBinAssoc -> String
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MUnAssoc] -> ShowS
$cshowList :: [MUnAssoc] -> ShowS
show :: MUnAssoc -> String
$cshow :: MUnAssoc -> String
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tangibility] -> ShowS
$cshowList :: [Tangibility] -> ShowS
show :: Tangibility -> String
$cshow :: Tangibility -> String
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Length] -> ShowS
$cshowList :: [Length] -> ShowS
show :: Length -> String
$cshow :: Length -> String
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.Game.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 the 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
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 robot nearby."
  Const
Install -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
2 Tangibility
short ConstDoc
"Install a device from inventory on a robot."
  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
Installed -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Sense whether the robot has a specific device installed."
  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."
      ]
  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 installed from your inventory."
      ]
  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, installed 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 robots 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 installed 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 robots." forall a b. (a -> b) -> a -> b
$
      [ Text
"It will take the first message said by the closest robot."
      , 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 installed."
      , 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
Intangible ConstDoc
"Log the string in the robot's logger."
  Const
View -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
short ConstDoc
"View the given robot."
  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
Time -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"Get the current time."
  Const
Whereami -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
0 Tangibility
Intangible ConstDoc
"Get the current x and y coordinates."
  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
0 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 robot) 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
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
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
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
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 a robot by name."
  Const
RobotNumbered -> Int -> Tangibility -> ConstDoc -> ConstInfo
command Int
1 Tangibility
Intangible ConstDoc
"Find a robot 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
      }

-- | 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 (Const -> Term
TConst Const
c) Term
t1)

-- | 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 Location
l1 Term
_) s2 :: Syntax
s2@(Syntax Location
l2 Term
_) = Location -> Term -> Syntax
Syntax Location
newLoc Term
newTerm
 where
  -- The new syntax span both terms
  newLoc :: Location
newLoc = Location
l1 forall a. Semigroup a => a -> a -> a
<> Location
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 (Const -> Term
TConst Const
c)
  newTerm :: Term
newTerm = Syntax -> Syntax -> Term
SApp (Location -> Term -> Syntax
Syntax Location
l1 forall a b. (a -> b) -> a -> b
$ Syntax -> Syntax -> Term
SApp Syntax
sop Syntax
s1) Syntax
s2

-- | The surface syntax for the language
data Syntax = Syntax {Syntax -> Location
sLoc :: Location, Syntax -> Term
sTerm :: Term}
  deriving (Syntax -> Syntax -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Syntax -> Syntax -> Bool
$c/= :: Syntax -> Syntax -> Bool
== :: Syntax -> Syntax -> Bool
$c== :: Syntax -> Syntax -> Bool
Eq, Int -> Syntax -> ShowS
[Syntax] -> ShowS
Syntax -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Syntax] -> ShowS
$cshowList :: [Syntax] -> ShowS
show :: Syntax -> String
$cshow :: Syntax -> String
showsPrec :: Int -> Syntax -> ShowS
$cshowsPrec :: Int -> Syntax -> ShowS
Show, Typeable Syntax
Syntax -> DataType
Syntax -> Constr
(forall b. Data b => b -> b) -> Syntax -> Syntax
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) -> Syntax -> u
forall u. (forall d. Data d => d -> u) -> Syntax -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Syntax
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Syntax -> c Syntax
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Syntax)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Syntax)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Syntax -> m Syntax
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Syntax -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Syntax -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Syntax -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Syntax -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Syntax -> r
gmapT :: (forall b. Data b => b -> b) -> Syntax -> Syntax
$cgmapT :: (forall b. Data b => b -> b) -> Syntax -> Syntax
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Syntax)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Syntax)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Syntax)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Syntax)
dataTypeOf :: Syntax -> DataType
$cdataTypeOf :: Syntax -> DataType
toConstr :: Syntax -> Constr
$ctoConstr :: Syntax -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Syntax
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Syntax
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Syntax -> c Syntax
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Syntax -> c Syntax
Data, forall x. Rep Syntax x -> Syntax
forall x. Syntax -> Rep Syntax x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Syntax x -> Syntax
$cfrom :: forall x. Syntax -> Rep Syntax x
Generic, Value -> Parser [Syntax]
Value -> Parser Syntax
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Syntax]
$cparseJSONList :: Value -> Parser [Syntax]
parseJSON :: Value -> Parser Syntax
$cparseJSON :: Value -> Parser Syntax
FromJSON, [Syntax] -> Encoding
[Syntax] -> Value
Syntax -> Encoding
Syntax -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Syntax] -> Encoding
$ctoEncodingList :: [Syntax] -> Encoding
toJSONList :: [Syntax] -> Value
$ctoJSONList :: [Syntax] -> Value
toEncoding :: Syntax -> Encoding
$ctoEncoding :: Syntax -> Encoding
toJSON :: Syntax -> Value
$ctoJSON :: Syntax -> Value
ToJSON)

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

instance Semigroup Location where
  Location
NoLoc <> :: Location -> Location -> Location
<> Location
l = Location
l
  Location
l <> Location
NoLoc = Location
l
  Location Int
s1 Int
e1 <> Location Int
s2 Int
e2 = Int -> Int -> Location
Location (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 Location where
  mempty :: Location
mempty = Location
NoLoc

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

-- | Match a term without its a syntax
pattern STerm :: Term -> Syntax
pattern $bSTerm :: Term -> Syntax
$mSTerm :: forall {r}. Syntax -> (Term -> r) -> ((# #) -> r) -> r
STerm t <-
  Syntax _ t
  where
    STerm Term
t = Location -> Term -> Syntax
Syntax forall a. Monoid a => a
mempty Term
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 v ty (STerm 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 v pt (STerm t1) (STerm 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 v pt (STerm 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 v t1 t2 = SBind v (STerm t1) (STerm 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)

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

------------------------------------------------------------
-- 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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelayType] -> ShowS
$cshowList :: [DelayType] -> ShowS
show :: DelayType -> String
$cshow :: DelayType -> String
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)

-- | Terms of the Swarm language.
data Term
  = -- | 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 value.  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
  | -- | A variable.
    TVar Var
  | -- | A pair.
    SPair Syntax Syntax
  | -- | A lambda expression, with or without a type annotation on the
    --   binder.
    SLam Var (Maybe Type) Syntax
  | -- | Function application.
    SApp Syntax Syntax
  | -- | A (recursive) let expression, with or without a type
    --   annotation on the variable. The @Bool@ indicates whether
    --   it is known to be recursive.
    SLet Bool Var (Maybe Polytype) Syntax Syntax
  | -- | A (recursive) definition command, which binds a variable to a
    --   value in subsequent commands. The @Bool@ indicates whether the
    --   definition is known to be recursive.
    SDef Bool Var (Maybe Polytype) Syntax
  | -- | A monadic bind for commands, of the form @c1 ; c2@ or @x <- c1; c2@.
    SBind (Maybe Var) Syntax Syntax
  | -- | Delay evaluation of a term, written @{...}@.  Swarm is an
    --   eager language, but in some cases (e.g. for @if@ statements
    --   and recursive bindings) we need to delay evaluation.  The
    --   counterpart to @{...}@ is @force@, where @force {t} = t@.
    --   Note that 'Force' is just a constant, whereas 'SDelay' has to
    --   be a special syntactic form so its argument can get special
    --   treatment during evaluation.
    SDelay DelayType Syntax
  deriving (Term -> Term -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq, Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show, Typeable Term
Term -> DataType
Term -> Constr
(forall b. Data b => b -> b) -> Term -> Term
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) -> Term -> u
forall u. (forall d. Data d => d -> u) -> Term -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Term -> m Term
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Term -> m Term
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Term
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Term -> c Term
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Term)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Term)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Term -> m Term
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Term -> m Term
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Term -> m Term
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Term -> m Term
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Term -> m Term
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Term -> m Term
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Term -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Term -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Term -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Term -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Term -> r
gmapT :: (forall b. Data b => b -> b) -> Term -> Term
$cgmapT :: (forall b. Data b => b -> b) -> Term -> Term
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Term)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Term)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Term)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Term)
dataTypeOf :: Term -> DataType
$cdataTypeOf :: Term -> DataType
toConstr :: Term -> Constr
$ctoConstr :: Term -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Term
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Term
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Term -> c Term
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Term -> c Term
Data, forall x. Rep Term x -> Term
forall x. Term -> Rep Term x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Term x -> Term
$cfrom :: forall x. Term -> Rep Term x
Generic, Value -> Parser [Term]
Value -> Parser Term
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Term]
$cparseJSONList :: Value -> Parser [Term]
parseJSON :: Value -> Parser Term
$cparseJSON :: Value -> Parser Term
FromJSON, [Term] -> Encoding
[Term] -> Value
Term -> Encoding
Term -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Term] -> Encoding
$ctoEncodingList :: [Term] -> Encoding
toJSONList :: [Term] -> Value
$ctoJSONList :: [Term] -> Value
toEncoding :: Term -> Encoding
$ctoEncoding :: Term -> Encoding
toJSON :: Term -> Value
$ctoJSON :: Term -> Value
ToJSON)

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

-- | Traversal over those subterms of a term which represent free
--   variables.
fvT :: Traversal' Term Term
fvT :: Traversal' Term Term
fvT Term -> f Term
f = Set Text -> Term -> f Term
go forall a. Set a
S.empty
 where
  go :: Set Text -> Term -> f Term
go Set Text
bound Term
t = case Term
t of
    Term
TUnit -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TConst {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TDir {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TInt {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TAntiInt {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TText {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TAntiText {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TBool {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TRobot {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TRef {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TRequireDevice {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    TRequire {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t
    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 Term
t
      | Bool
otherwise -> Term -> f Term
f (Text -> Term
TVar Text
x)
    SLam Text
x Maybe Type
ty (Syntax Location
l1 Term
t1) -> Text -> Maybe Type -> Syntax -> Term
SLam Text
x Maybe Type
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location -> Term -> Syntax
Syntax Location
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go (forall a. Ord a => a -> Set a -> Set a
S.insert Text
x Set Text
bound) Term
t1)
    SApp (Syntax Location
l1 Term
t1) (Syntax Location
l2 Term
t2) ->
      Syntax -> Syntax -> Term
SApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location -> Term -> Syntax
Syntax Location
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound Term
t1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Location -> Term -> Syntax
Syntax Location
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound Term
t2)
    SLet Bool
r Text
x Maybe Polytype
ty (Syntax Location
l1 Term
t1) (Syntax Location
l2 Term
t2) ->
      let bound' :: Set Text
bound' = forall a. Ord a => a -> Set a -> Set a
S.insert Text
x Set Text
bound
       in Bool -> Text -> Maybe Polytype -> Syntax -> Syntax -> Term
SLet Bool
r Text
x Maybe Polytype
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location -> Term -> Syntax
Syntax Location
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound' Term
t1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Location -> Term -> Syntax
Syntax Location
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound' Term
t2)
    SPair (Syntax Location
l1 Term
t1) (Syntax Location
l2 Term
t2) ->
      Syntax -> Syntax -> Term
SPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location -> Term -> Syntax
Syntax Location
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound Term
t1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Location -> Term -> Syntax
Syntax Location
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound Term
t2)
    SDef Bool
r Text
x Maybe Polytype
ty (Syntax Location
l1 Term
t1) ->
      Bool -> Text -> Maybe Polytype -> Syntax -> Term
SDef Bool
r Text
x Maybe Polytype
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location -> Term -> Syntax
Syntax Location
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go (forall a. Ord a => a -> Set a -> Set a
S.insert Text
x Set Text
bound) Term
t1)
    SBind Maybe Text
mx (Syntax Location
l1 Term
t1) (Syntax Location
l2 Term
t2) ->
      Maybe Text -> Syntax -> Syntax -> Term
SBind Maybe Text
mx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location -> Term -> Syntax
Syntax Location
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound Term
t1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Location -> Term -> Syntax
Syntax Location
l2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
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 Maybe Text
mx Set Text
bound) Term
t2)
    SDelay DelayType
m (Syntax Location
l1 Term
t1) ->
      DelayType -> Syntax -> Term
SDelay DelayType
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Location -> Term -> Syntax
Syntax Location
l1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Term -> f Term
go Set Text
bound Term
t1)

-- | Traversal over the free variables of a term.  Note that if you
--   want to get the set of all free variables, you can do so via
--   @'Data.Set.Lens.setOf' 'fv'@.
fv :: Traversal' Term Var
fv :: Traversal' Term Text
fv = Traversal' Term Term
fvT forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text -> f Text
f -> \case TVar Text
x -> Text -> Term
TVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
x; Term
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t)

-- | Apply a function to all free occurrences of a particular variable.
mapFree1 :: Var -> (Term -> Term) -> Term -> Term
mapFree1 :: Text -> (Term -> Term) -> Term -> Term
mapFree1 Text
x Term -> Term
f = Traversal' Term Term
fvT forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Term
t -> if Term
t forall a. Eq a => a -> a -> Bool
== Text -> Term
TVar Text
x then Term -> Term
f Term
t else Term
t)

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 -> String
show a
a))