{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}

-- |
-- Module      : Jikka.RestrictedPython.Language.Expr
-- Description : contains data types of the restricted Python. / 制限された Python のためのデータ型を含みます。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.RestrictedPython.Language.Expr
  ( -- * types
    TypeName (..),
    unTypeName,
    Type (..),
    pattern NoneTy,

    -- * operators
    UnaryOp (..),
    Operator (..),
    BoolOp (..),
    CmpOp (..),
    CmpOp' (..),
    Constant (..),
    Builtin (..),
    AttributeName (..),
    unAttributeName,
    Attribute (..),
    Attribute',

    -- * exprs
    VarName (..),
    unVarName,
    module Jikka.Common.Location,
    VarName',
    Expr (..),
    Expr',
    Comprehension (..),

    -- * statements
    Target (..),
    Target',
    Statement (..),
    pattern Append,
    ToplevelStatement (..),
    Program,
  )
where

import Data.String (IsString)
import Jikka.Common.Location
import Jikka.Python.Language.Expr (BoolOp (..), CmpOp (..), Operator (..), UnaryOp (..))

newtype VarName = VarName String deriving (VarName -> VarName -> Bool
(VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool) -> Eq VarName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarName -> VarName -> Bool
$c/= :: VarName -> VarName -> Bool
== :: VarName -> VarName -> Bool
$c== :: VarName -> VarName -> Bool
Eq, Eq VarName
Eq VarName
-> (VarName -> VarName -> Ordering)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> VarName)
-> (VarName -> VarName -> VarName)
-> Ord VarName
VarName -> VarName -> Bool
VarName -> VarName -> Ordering
VarName -> VarName -> VarName
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 :: VarName -> VarName -> VarName
$cmin :: VarName -> VarName -> VarName
max :: VarName -> VarName -> VarName
$cmax :: VarName -> VarName -> VarName
>= :: VarName -> VarName -> Bool
$c>= :: VarName -> VarName -> Bool
> :: VarName -> VarName -> Bool
$c> :: VarName -> VarName -> Bool
<= :: VarName -> VarName -> Bool
$c<= :: VarName -> VarName -> Bool
< :: VarName -> VarName -> Bool
$c< :: VarName -> VarName -> Bool
compare :: VarName -> VarName -> Ordering
$ccompare :: VarName -> VarName -> Ordering
$cp1Ord :: Eq VarName
Ord, Int -> VarName -> ShowS
[VarName] -> ShowS
VarName -> String
(Int -> VarName -> ShowS)
-> (VarName -> String) -> ([VarName] -> ShowS) -> Show VarName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarName] -> ShowS
$cshowList :: [VarName] -> ShowS
show :: VarName -> String
$cshow :: VarName -> String
showsPrec :: Int -> VarName -> ShowS
$cshowsPrec :: Int -> VarName -> ShowS
Show, ReadPrec [VarName]
ReadPrec VarName
Int -> ReadS VarName
ReadS [VarName]
(Int -> ReadS VarName)
-> ReadS [VarName]
-> ReadPrec VarName
-> ReadPrec [VarName]
-> Read VarName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VarName]
$creadListPrec :: ReadPrec [VarName]
readPrec :: ReadPrec VarName
$creadPrec :: ReadPrec VarName
readList :: ReadS [VarName]
$creadList :: ReadS [VarName]
readsPrec :: Int -> ReadS VarName
$creadsPrec :: Int -> ReadS VarName
Read, String -> VarName
(String -> VarName) -> IsString VarName
forall a. (String -> a) -> IsString a
fromString :: String -> VarName
$cfromString :: String -> VarName
IsString)

unVarName :: VarName -> String
unVarName :: VarName -> String
unVarName (VarName String
x) = String
x

type VarName' = WithLoc' VarName

newtype TypeName = TypeName String deriving (TypeName -> TypeName -> Bool
(TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool) -> Eq TypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeName -> TypeName -> Bool
$c/= :: TypeName -> TypeName -> Bool
== :: TypeName -> TypeName -> Bool
$c== :: TypeName -> TypeName -> Bool
Eq, Eq TypeName
Eq TypeName
-> (TypeName -> TypeName -> Ordering)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> TypeName)
-> (TypeName -> TypeName -> TypeName)
-> Ord TypeName
TypeName -> TypeName -> Bool
TypeName -> TypeName -> Ordering
TypeName -> TypeName -> TypeName
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 :: TypeName -> TypeName -> TypeName
$cmin :: TypeName -> TypeName -> TypeName
max :: TypeName -> TypeName -> TypeName
$cmax :: TypeName -> TypeName -> TypeName
>= :: TypeName -> TypeName -> Bool
$c>= :: TypeName -> TypeName -> Bool
> :: TypeName -> TypeName -> Bool
$c> :: TypeName -> TypeName -> Bool
<= :: TypeName -> TypeName -> Bool
$c<= :: TypeName -> TypeName -> Bool
< :: TypeName -> TypeName -> Bool
$c< :: TypeName -> TypeName -> Bool
compare :: TypeName -> TypeName -> Ordering
$ccompare :: TypeName -> TypeName -> Ordering
$cp1Ord :: Eq TypeName
Ord, Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeName] -> ShowS
$cshowList :: [TypeName] -> ShowS
show :: TypeName -> String
$cshow :: TypeName -> String
showsPrec :: Int -> TypeName -> ShowS
$cshowsPrec :: Int -> TypeName -> ShowS
Show, ReadPrec [TypeName]
ReadPrec TypeName
Int -> ReadS TypeName
ReadS [TypeName]
(Int -> ReadS TypeName)
-> ReadS [TypeName]
-> ReadPrec TypeName
-> ReadPrec [TypeName]
-> Read TypeName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeName]
$creadListPrec :: ReadPrec [TypeName]
readPrec :: ReadPrec TypeName
$creadPrec :: ReadPrec TypeName
readList :: ReadS [TypeName]
$creadList :: ReadS [TypeName]
readsPrec :: Int -> ReadS TypeName
$creadsPrec :: Int -> ReadS TypeName
Read, String -> TypeName
(String -> TypeName) -> IsString TypeName
forall a. (String -> a) -> IsString a
fromString :: String -> TypeName
$cfromString :: String -> TypeName
IsString)

unTypeName :: TypeName -> String
unTypeName :: TypeName -> String
unTypeName (TypeName String
x) = String
x

newtype AttributeName = AttributeName String deriving (AttributeName -> AttributeName -> Bool
(AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool) -> Eq AttributeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeName -> AttributeName -> Bool
$c/= :: AttributeName -> AttributeName -> Bool
== :: AttributeName -> AttributeName -> Bool
$c== :: AttributeName -> AttributeName -> Bool
Eq, Eq AttributeName
Eq AttributeName
-> (AttributeName -> AttributeName -> Ordering)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> AttributeName)
-> (AttributeName -> AttributeName -> AttributeName)
-> Ord AttributeName
AttributeName -> AttributeName -> Bool
AttributeName -> AttributeName -> Ordering
AttributeName -> AttributeName -> AttributeName
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 :: AttributeName -> AttributeName -> AttributeName
$cmin :: AttributeName -> AttributeName -> AttributeName
max :: AttributeName -> AttributeName -> AttributeName
$cmax :: AttributeName -> AttributeName -> AttributeName
>= :: AttributeName -> AttributeName -> Bool
$c>= :: AttributeName -> AttributeName -> Bool
> :: AttributeName -> AttributeName -> Bool
$c> :: AttributeName -> AttributeName -> Bool
<= :: AttributeName -> AttributeName -> Bool
$c<= :: AttributeName -> AttributeName -> Bool
< :: AttributeName -> AttributeName -> Bool
$c< :: AttributeName -> AttributeName -> Bool
compare :: AttributeName -> AttributeName -> Ordering
$ccompare :: AttributeName -> AttributeName -> Ordering
$cp1Ord :: Eq AttributeName
Ord, Int -> AttributeName -> ShowS
[AttributeName] -> ShowS
AttributeName -> String
(Int -> AttributeName -> ShowS)
-> (AttributeName -> String)
-> ([AttributeName] -> ShowS)
-> Show AttributeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeName] -> ShowS
$cshowList :: [AttributeName] -> ShowS
show :: AttributeName -> String
$cshow :: AttributeName -> String
showsPrec :: Int -> AttributeName -> ShowS
$cshowsPrec :: Int -> AttributeName -> ShowS
Show, ReadPrec [AttributeName]
ReadPrec AttributeName
Int -> ReadS AttributeName
ReadS [AttributeName]
(Int -> ReadS AttributeName)
-> ReadS [AttributeName]
-> ReadPrec AttributeName
-> ReadPrec [AttributeName]
-> Read AttributeName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeName]
$creadListPrec :: ReadPrec [AttributeName]
readPrec :: ReadPrec AttributeName
$creadPrec :: ReadPrec AttributeName
readList :: ReadS [AttributeName]
$creadList :: ReadS [AttributeName]
readsPrec :: Int -> ReadS AttributeName
$creadsPrec :: Int -> ReadS AttributeName
Read, String -> AttributeName
(String -> AttributeName) -> IsString AttributeName
forall a. (String -> a) -> IsString a
fromString :: String -> AttributeName
$cfromString :: String -> AttributeName
IsString)

unAttributeName :: AttributeName -> String
unAttributeName :: AttributeName -> String
unAttributeName (AttributeName String
x) = String
x

-- | `Type` represents the types of our restricted Python-like language.
--
-- \[
--     \newcommand\int{\mathbf{int}}
--     \newcommand\bool{\mathbf{bool}}
--     \newcommand\list{\mathbf{list}}
--     \newcommand\string{\mathbf{string}}
--     \begin{array}{rl}
--         \tau ::= & \alpha \\
--         \vert & \int \\
--         \vert & \bool \\
--         \vert & \list(\tau) \\
--         \vert & \tau \times \tau \times \dots \times \tau \\
--         \vert & \tau \times \tau \times \dots \times \tau \to \tau
--         \vert & \string
--         \vert & \mathbf{side-effect}
--     \end{array}
-- \]
--
-- NOTE: \(\mathbf{None}\) is represented as the 0-tuple.
data Type
  = VarTy TypeName
  | IntTy
  | BoolTy
  | ListTy Type
  | TupleTy [Type]
  | CallableTy [Type] Type
  | StringTy
  | SideEffectTy
  deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, ReadPrec [Type]
ReadPrec Type
Int -> ReadS Type
ReadS [Type]
(Int -> ReadS Type)
-> ReadS [Type] -> ReadPrec Type -> ReadPrec [Type] -> Read Type
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type]
$creadListPrec :: ReadPrec [Type]
readPrec :: ReadPrec Type
$creadPrec :: ReadPrec Type
readList :: ReadS [Type]
$creadList :: ReadS [Type]
readsPrec :: Int -> ReadS Type
$creadsPrec :: Int -> ReadS Type
Read)

pattern $bNoneTy :: Type
$mNoneTy :: forall r. Type -> (Void# -> r) -> (Void# -> r) -> r
NoneTy = TupleTy []

data Constant
  = ConstNone
  | ConstInt Integer
  | ConstBool Bool
  | ConstBuiltin Builtin
  deriving (Constant -> Constant -> Bool
(Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool) -> Eq Constant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constant -> Constant -> Bool
$c/= :: Constant -> Constant -> Bool
== :: Constant -> Constant -> Bool
$c== :: Constant -> Constant -> Bool
Eq, Eq Constant
Eq Constant
-> (Constant -> Constant -> Ordering)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Constant)
-> (Constant -> Constant -> Constant)
-> Ord Constant
Constant -> Constant -> Bool
Constant -> Constant -> Ordering
Constant -> Constant -> Constant
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 :: Constant -> Constant -> Constant
$cmin :: Constant -> Constant -> Constant
max :: Constant -> Constant -> Constant
$cmax :: Constant -> Constant -> Constant
>= :: Constant -> Constant -> Bool
$c>= :: Constant -> Constant -> Bool
> :: Constant -> Constant -> Bool
$c> :: Constant -> Constant -> Bool
<= :: Constant -> Constant -> Bool
$c<= :: Constant -> Constant -> Bool
< :: Constant -> Constant -> Bool
$c< :: Constant -> Constant -> Bool
compare :: Constant -> Constant -> Ordering
$ccompare :: Constant -> Constant -> Ordering
$cp1Ord :: Eq Constant
Ord, Int -> Constant -> ShowS
[Constant] -> ShowS
Constant -> String
(Int -> Constant -> ShowS)
-> (Constant -> String) -> ([Constant] -> ShowS) -> Show Constant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constant] -> ShowS
$cshowList :: [Constant] -> ShowS
show :: Constant -> String
$cshow :: Constant -> String
showsPrec :: Int -> Constant -> ShowS
$cshowsPrec :: Int -> Constant -> ShowS
Show, ReadPrec [Constant]
ReadPrec Constant
Int -> ReadS Constant
ReadS [Constant]
(Int -> ReadS Constant)
-> ReadS [Constant]
-> ReadPrec Constant
-> ReadPrec [Constant]
-> Read Constant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constant]
$creadListPrec :: ReadPrec [Constant]
readPrec :: ReadPrec Constant
$creadPrec :: ReadPrec Constant
readList :: ReadS [Constant]
$creadList :: ReadS [Constant]
readsPrec :: Int -> ReadS Constant
$creadsPrec :: Int -> ReadS Constant
Read)

data Builtin
  = -- | "abs" \(: \int \to \int\)
    BuiltinAbs
  | -- | "pow" \((\lambda x k. x^k) : \int \times \int \to \int\)
    BuiltinPow
  | -- | modulo power "pow" \((\lambda x k m. x^k \bmod m): \int \times \int \to \int\)
    BuiltinModPow
  | -- | "divmod" \(: \int \times \int \to \int \times \int\)
    BuiltinDivMod
  | -- | ceil div \(: \int \times \int \to \int\)
    BuiltinCeilDiv
  | -- | ceil mod \(: \int \times \int \to \int\)
    BuiltinCeilMod
  | -- | floor div \(: \int \times \int \to \int\)
    BuiltinFloorDiv
  | -- | floor mod \(: \int \times \int \to \int\)
    BuiltinFloorMod
  | -- | \(\gcd: \int \times \int \to \int\)
    BuiltinGcd
  | -- | \(\mathbf{lcm}: \int \times \int \to \int\)
    BuiltinLcm
  | -- | "int" \(: \forall \alpha. \alpha \to \int\)
    BuiltinInt Type
  | -- | "bool" \(: \forall \alpha. \alpha \to \bool\)
    BuiltinBool Type
  | -- | "list" \(: \forall \alpha. \list(\alpha) \to \list(\alpha)\)
    BuiltinList Type
  | -- | "tuple" \(: \forall \alpha_0 \alpha_1 \dots \alpha _ {n - 1}. \tau \to \tau\) where \(\tau = \alpha_0 \times \dots \times \alpha _ {n - 1}\)
    BuiltinTuple [Type]
  | -- | "len" \(: \forall \alpha. \list(\alpha) \to \int\)
    BuiltinLen Type
  | -- | "map" \(: \forall \alpha_0 \alpha_1 \dots \alpha_n. (\alpha_0 \times \dots \times \alpha _ {n - 1} \to \alpha_n) \times \list(\alpha_0) \times \dots \list(\alpha _ {n - 1}) \to \list(\alpha_n)\)
    BuiltinMap [Type] Type
  | -- | "sorted" \(: \forall \alpha. \list(\alpha) \to \list(\alpha)\)
    BuiltinSorted Type
  | -- | "reversed" \(: \forall \alpha. \list(\alpha) \to \list(\alpha)\)
    BuiltinReversed Type
  | -- | "enumerate" \(: \forall \alpha. \list(\alpha) \to \list(\int \times \alpha)\)
    BuiltinEnumerate Type
  | -- | "filter" \(: \forall \alpha. (\alpha \to \bool) \times \list(\alpha) \to \list(\alpha)\)
    BuiltinFilter Type
  | -- | "zip" \(: \forall \alpha_0 \alpha_1 \dots \alpha _ {n - 1}. \list(\alpha_0) \times \dots \list(\alpha _ {n - 1}) \to \list(\alpha_0 \times \dots \times \alpha _ {n - 1})\)
    BuiltinZip [Type]
  | -- | "all" \(: \list(\bool) \to \bool\)
    BuiltinAll
  | -- | "any" \(: \list(\bool) \to \bool\)
    BuiltinAny
  | -- | "sum" \(: \list(\int) \to \int\)
    BuiltinSum
  | -- | product \(: \list(\int) \to \int\)
    BuiltinProduct
  | -- | "range" \(: \int \to \list(\int)\)
    BuiltinRange1
  | -- | "range" \(: \int \times \int \to \list(\int)\)
    BuiltinRange2
  | -- | "range" \(: \int \times \int \times \int \to \list(\int)\)
    BuiltinRange3
  | -- | "max" \(: \forall \alpha. \list(\alpha) \to \alpha\)
    BuiltinMax1 Type
  | -- | "max" \(: \forall \alpha. \underbrace{\alpha \times \alpha \times \dots \times \alpha} _ {n ~\text{times}} \to \alpha\)
    BuiltinMax Type Int
  | -- | "min" \(: \forall \alpha. \list(\alpha) \to \alpha\)
    BuiltinMin1 Type
  | -- | "min" \(: \forall \alpha. \underbrace{\alpha \times \alpha \times \dots \times \alpha} _ {n ~\text{times}} \to \alpha\)
    BuiltinMin Type Int
  | -- | \(: \forall \alpha. \list(\alpha) \to \int\)
    BuiltinArgMax Type
  | -- | \(: \forall \alpha. \list(\alpha) \to \int\)
    BuiltinArgMin Type
  | -- | factorial \((\lambda n. n!): \int \to \int\)
    BuiltinFact
  | -- | \((\lambda n r. {} _ n C _ r): \int \times \int \to \int\)
    BuiltinChoose
  | -- | \((\lambda n r. {} _ n P _ r): \int \times \int \to \int\)
    BuiltinPermute
  | -- | \((\lambda n r. {} _ n H _ r): \int \times \int \to \int\)
    BuiltinMultiChoose
  | -- | modulo inverse \((\lambda x m. x^{-1} \bmod m): \int \times \int \to \int\)
    BuiltinModInv
  | -- | "input" \(: \epsilon \to \string\)
    BuiltinInput
  | -- | "print" \(: \forall \alpha_0 \alpha_1 \dots \alpha _ {n - 1}. \alpha_0 \times \dots \alpha _ {n - 1} \to \epsilon\)
    BuiltinPrint [Type]
  deriving (Builtin -> Builtin -> Bool
(Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool) -> Eq Builtin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Builtin -> Builtin -> Bool
$c/= :: Builtin -> Builtin -> Bool
== :: Builtin -> Builtin -> Bool
$c== :: Builtin -> Builtin -> Bool
Eq, Eq Builtin
Eq Builtin
-> (Builtin -> Builtin -> Ordering)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Builtin)
-> (Builtin -> Builtin -> Builtin)
-> Ord Builtin
Builtin -> Builtin -> Bool
Builtin -> Builtin -> Ordering
Builtin -> Builtin -> Builtin
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 :: Builtin -> Builtin -> Builtin
$cmin :: Builtin -> Builtin -> Builtin
max :: Builtin -> Builtin -> Builtin
$cmax :: Builtin -> Builtin -> Builtin
>= :: Builtin -> Builtin -> Bool
$c>= :: Builtin -> Builtin -> Bool
> :: Builtin -> Builtin -> Bool
$c> :: Builtin -> Builtin -> Bool
<= :: Builtin -> Builtin -> Bool
$c<= :: Builtin -> Builtin -> Bool
< :: Builtin -> Builtin -> Bool
$c< :: Builtin -> Builtin -> Bool
compare :: Builtin -> Builtin -> Ordering
$ccompare :: Builtin -> Builtin -> Ordering
$cp1Ord :: Eq Builtin
Ord, Int -> Builtin -> ShowS
[Builtin] -> ShowS
Builtin -> String
(Int -> Builtin -> ShowS)
-> (Builtin -> String) -> ([Builtin] -> ShowS) -> Show Builtin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Builtin] -> ShowS
$cshowList :: [Builtin] -> ShowS
show :: Builtin -> String
$cshow :: Builtin -> String
showsPrec :: Int -> Builtin -> ShowS
$cshowsPrec :: Int -> Builtin -> ShowS
Show, ReadPrec [Builtin]
ReadPrec Builtin
Int -> ReadS Builtin
ReadS [Builtin]
(Int -> ReadS Builtin)
-> ReadS [Builtin]
-> ReadPrec Builtin
-> ReadPrec [Builtin]
-> Read Builtin
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Builtin]
$creadListPrec :: ReadPrec [Builtin]
readPrec :: ReadPrec Builtin
$creadPrec :: ReadPrec Builtin
readList :: ReadS [Builtin]
$creadList :: ReadS [Builtin]
readsPrec :: Int -> ReadS Builtin
$creadsPrec :: Int -> ReadS Builtin
Read)

data Attribute
  = UnresolvedAttribute AttributeName
  | -- | "list.count" \(: \forall \alpha. \list(\alpha) \to \alpha \to \int\)
    BuiltinCount Type
  | -- | "list.index" \(: \forall \alpha. \list(\alpha) \to \alpha \to \int\)
    BuiltinIndex Type
  | -- | "list.copy" \(: \forall \alpha. \list(\alpha) \to \epsilon \to \list(\alpha)\)
    BuiltinCopy Type
  | -- | "list.append" \(: \forall \alpha. \list(\alpha) \to \alpha \to \mathbf{side-effect}\)
    BuiltinAppend Type
  | -- | "str.split" \(: \forall \alpha. \string \to \epsilon \to \list(\string)\)
    BuiltinSplit
  deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Eq Attribute
-> (Attribute -> Attribute -> Ordering)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Attribute)
-> (Attribute -> Attribute -> Attribute)
-> Ord Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
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 :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c< :: Attribute -> Attribute -> Bool
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
$cp1Ord :: Eq Attribute
Ord, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, ReadPrec [Attribute]
ReadPrec Attribute
Int -> ReadS Attribute
ReadS [Attribute]
(Int -> ReadS Attribute)
-> ReadS [Attribute]
-> ReadPrec Attribute
-> ReadPrec [Attribute]
-> Read Attribute
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Attribute]
$creadListPrec :: ReadPrec [Attribute]
readPrec :: ReadPrec Attribute
$creadPrec :: ReadPrec Attribute
readList :: ReadS [Attribute]
$creadList :: ReadS [Attribute]
readsPrec :: Int -> ReadS Attribute
$creadsPrec :: Int -> ReadS Attribute
Read)

type Attribute' = WithLoc' Attribute

-- | `Target` represents the lvalue of our restricted Python-like language.
--
-- \[
--     \begin{array}{rl}
--         y ::= & y \lbrack e \rbrack \\
--         \vert & x \\
--         \vert & (y, y, \dots, y) \\
--     \end{array}
-- \]
data Target
  = SubscriptTrg Target' Expr'
  | NameTrg VarName'
  | TupleTrg [Target']
  deriving (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq, Eq Target
Eq Target
-> (Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
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 :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmax :: Target -> Target -> Target
>= :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c< :: Target -> Target -> Bool
compare :: Target -> Target -> Ordering
$ccompare :: Target -> Target -> Ordering
$cp1Ord :: Eq Target
Ord, Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show, ReadPrec [Target]
ReadPrec Target
Int -> ReadS Target
ReadS [Target]
(Int -> ReadS Target)
-> ReadS [Target]
-> ReadPrec Target
-> ReadPrec [Target]
-> Read Target
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Target]
$creadListPrec :: ReadPrec [Target]
readPrec :: ReadPrec Target
$creadPrec :: ReadPrec Target
readList :: ReadS [Target]
$creadList :: ReadS [Target]
readsPrec :: Int -> ReadS Target
$creadsPrec :: Int -> ReadS Target
Read)

type Target' = WithLoc' Target

-- | `CmpOp'` is a type for comparision operators.
-- This is annotated with its type as let-polymorphism.
data CmpOp' = CmpOp' CmpOp Type
  deriving (CmpOp' -> CmpOp' -> Bool
(CmpOp' -> CmpOp' -> Bool)
-> (CmpOp' -> CmpOp' -> Bool) -> Eq CmpOp'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpOp' -> CmpOp' -> Bool
$c/= :: CmpOp' -> CmpOp' -> Bool
== :: CmpOp' -> CmpOp' -> Bool
$c== :: CmpOp' -> CmpOp' -> Bool
Eq, Eq CmpOp'
Eq CmpOp'
-> (CmpOp' -> CmpOp' -> Ordering)
-> (CmpOp' -> CmpOp' -> Bool)
-> (CmpOp' -> CmpOp' -> Bool)
-> (CmpOp' -> CmpOp' -> Bool)
-> (CmpOp' -> CmpOp' -> Bool)
-> (CmpOp' -> CmpOp' -> CmpOp')
-> (CmpOp' -> CmpOp' -> CmpOp')
-> Ord CmpOp'
CmpOp' -> CmpOp' -> Bool
CmpOp' -> CmpOp' -> Ordering
CmpOp' -> CmpOp' -> CmpOp'
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 :: CmpOp' -> CmpOp' -> CmpOp'
$cmin :: CmpOp' -> CmpOp' -> CmpOp'
max :: CmpOp' -> CmpOp' -> CmpOp'
$cmax :: CmpOp' -> CmpOp' -> CmpOp'
>= :: CmpOp' -> CmpOp' -> Bool
$c>= :: CmpOp' -> CmpOp' -> Bool
> :: CmpOp' -> CmpOp' -> Bool
$c> :: CmpOp' -> CmpOp' -> Bool
<= :: CmpOp' -> CmpOp' -> Bool
$c<= :: CmpOp' -> CmpOp' -> Bool
< :: CmpOp' -> CmpOp' -> Bool
$c< :: CmpOp' -> CmpOp' -> Bool
compare :: CmpOp' -> CmpOp' -> Ordering
$ccompare :: CmpOp' -> CmpOp' -> Ordering
$cp1Ord :: Eq CmpOp'
Ord, Int -> CmpOp' -> ShowS
[CmpOp'] -> ShowS
CmpOp' -> String
(Int -> CmpOp' -> ShowS)
-> (CmpOp' -> String) -> ([CmpOp'] -> ShowS) -> Show CmpOp'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmpOp'] -> ShowS
$cshowList :: [CmpOp'] -> ShowS
show :: CmpOp' -> String
$cshow :: CmpOp' -> String
showsPrec :: Int -> CmpOp' -> ShowS
$cshowsPrec :: Int -> CmpOp' -> ShowS
Show, ReadPrec [CmpOp']
ReadPrec CmpOp'
Int -> ReadS CmpOp'
ReadS [CmpOp']
(Int -> ReadS CmpOp')
-> ReadS [CmpOp']
-> ReadPrec CmpOp'
-> ReadPrec [CmpOp']
-> Read CmpOp'
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CmpOp']
$creadListPrec :: ReadPrec [CmpOp']
readPrec :: ReadPrec CmpOp'
$creadPrec :: ReadPrec CmpOp'
readList :: ReadS [CmpOp']
$creadList :: ReadS [CmpOp']
readsPrec :: Int -> ReadS CmpOp'
$creadsPrec :: Int -> ReadS CmpOp'
Read)

data Comprehension = Comprehension Target' Expr' (Maybe Expr')
  deriving (Comprehension -> Comprehension -> Bool
(Comprehension -> Comprehension -> Bool)
-> (Comprehension -> Comprehension -> Bool) -> Eq Comprehension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comprehension -> Comprehension -> Bool
$c/= :: Comprehension -> Comprehension -> Bool
== :: Comprehension -> Comprehension -> Bool
$c== :: Comprehension -> Comprehension -> Bool
Eq, Eq Comprehension
Eq Comprehension
-> (Comprehension -> Comprehension -> Ordering)
-> (Comprehension -> Comprehension -> Bool)
-> (Comprehension -> Comprehension -> Bool)
-> (Comprehension -> Comprehension -> Bool)
-> (Comprehension -> Comprehension -> Bool)
-> (Comprehension -> Comprehension -> Comprehension)
-> (Comprehension -> Comprehension -> Comprehension)
-> Ord Comprehension
Comprehension -> Comprehension -> Bool
Comprehension -> Comprehension -> Ordering
Comprehension -> Comprehension -> Comprehension
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 :: Comprehension -> Comprehension -> Comprehension
$cmin :: Comprehension -> Comprehension -> Comprehension
max :: Comprehension -> Comprehension -> Comprehension
$cmax :: Comprehension -> Comprehension -> Comprehension
>= :: Comprehension -> Comprehension -> Bool
$c>= :: Comprehension -> Comprehension -> Bool
> :: Comprehension -> Comprehension -> Bool
$c> :: Comprehension -> Comprehension -> Bool
<= :: Comprehension -> Comprehension -> Bool
$c<= :: Comprehension -> Comprehension -> Bool
< :: Comprehension -> Comprehension -> Bool
$c< :: Comprehension -> Comprehension -> Bool
compare :: Comprehension -> Comprehension -> Ordering
$ccompare :: Comprehension -> Comprehension -> Ordering
$cp1Ord :: Eq Comprehension
Ord, Int -> Comprehension -> ShowS
[Comprehension] -> ShowS
Comprehension -> String
(Int -> Comprehension -> ShowS)
-> (Comprehension -> String)
-> ([Comprehension] -> ShowS)
-> Show Comprehension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comprehension] -> ShowS
$cshowList :: [Comprehension] -> ShowS
show :: Comprehension -> String
$cshow :: Comprehension -> String
showsPrec :: Int -> Comprehension -> ShowS
$cshowsPrec :: Int -> Comprehension -> ShowS
Show, ReadPrec [Comprehension]
ReadPrec Comprehension
Int -> ReadS Comprehension
ReadS [Comprehension]
(Int -> ReadS Comprehension)
-> ReadS [Comprehension]
-> ReadPrec Comprehension
-> ReadPrec [Comprehension]
-> Read Comprehension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Comprehension]
$creadListPrec :: ReadPrec [Comprehension]
readPrec :: ReadPrec Comprehension
$creadPrec :: ReadPrec Comprehension
readList :: ReadS [Comprehension]
$creadList :: ReadS [Comprehension]
readsPrec :: Int -> ReadS Comprehension
$creadsPrec :: Int -> ReadS Comprehension
Read)

-- | `Expr` represents the exprs of our restricted Python-like language.
--
-- \[
--     \begin{array}{rl}
--         e ::= & e \operatorname{boolop} e \\
--         \vert & e \operatorname{binop} e \\
--         \vert & \operatorname{unaryop} e \\
--         \vert & \lambda x _ \tau x _ \tau \dots x _ \tau. e \\
--         \vert & \mathbf{if}~ e ~\mathbf{then}~ e ~\mathbf{else}~ e \\
--         \vert & \lbrack e ~\mathbf{for}~ y ~\mathbf{in}~ e ~(\mathbf{if}~ e)? \rbrack \\
--         \vert & e \operatorname{cmpop} e \\
--         \vert & e (e, e, \dots, e) \\
--         \vert & \operatorname{constant} \\
--         \vert & e \lbrack e \rbrack \\
--         \vert & x \\
--         \vert & \lbrack e, e, \dots, e \rbrack _ \tau \\
--         \vert & e \lbrack e? \colon e? \colon e? \rbrack \\
--     \end{array}
-- \]
data Expr
  = BoolOp Expr' BoolOp Expr'
  | BinOp Expr' Operator Expr'
  | UnaryOp UnaryOp Expr'
  | Lambda [(VarName', Type)] Expr'
  | IfExp Expr' Expr' Expr'
  | ListComp Expr' Comprehension
  | Compare Expr' CmpOp' Expr'
  | Call Expr' [Expr']
  | Constant Constant
  | Attribute Expr' Attribute'
  | Subscript Expr' Expr'
  | Starred Expr'
  | Name VarName'
  | List Type [Expr']
  | Tuple [Expr']
  | SubscriptSlice Expr' (Maybe Expr') (Maybe Expr') (Maybe Expr')
  deriving (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, Eq Expr
Eq Expr
-> (Expr -> Expr -> Ordering)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> Ord Expr
Expr -> Expr -> Bool
Expr -> Expr -> Ordering
Expr -> Expr -> Expr
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 :: Expr -> Expr -> Expr
$cmin :: Expr -> Expr -> Expr
max :: Expr -> Expr -> Expr
$cmax :: Expr -> Expr -> Expr
>= :: Expr -> Expr -> Bool
$c>= :: Expr -> Expr -> Bool
> :: Expr -> Expr -> Bool
$c> :: Expr -> Expr -> Bool
<= :: Expr -> Expr -> Bool
$c<= :: Expr -> Expr -> Bool
< :: Expr -> Expr -> Bool
$c< :: Expr -> Expr -> Bool
compare :: Expr -> Expr -> Ordering
$ccompare :: Expr -> Expr -> Ordering
$cp1Ord :: Eq Expr
Ord, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, ReadPrec [Expr]
ReadPrec Expr
Int -> ReadS Expr
ReadS [Expr]
(Int -> ReadS Expr)
-> ReadS [Expr] -> ReadPrec Expr -> ReadPrec [Expr] -> Read Expr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expr]
$creadListPrec :: ReadPrec [Expr]
readPrec :: ReadPrec Expr
$creadPrec :: ReadPrec Expr
readList :: ReadS [Expr]
$creadList :: ReadS [Expr]
readsPrec :: Int -> ReadS Expr
$creadsPrec :: Int -> ReadS Expr
Read)

type Expr' = WithLoc' Expr

-- | `Statement` represents the statements of our restricted Python-like language.
-- They appear in bodies of `def`.
--
-- \[
--     \begin{array}{rl}
--         \mathrm{stmt} ::= & \mathbf{return}~ e \\
--         \vert & y \operatorname{binop} = e \\
--         \vert & y _ \tau := e \\
--         \vert & \mathbf{for}~ y ~\mathbf{in}~ e \colon\quad \mathrm{stmt}; \mathrm{stmt}; \dots; \mathrm{stmt} \\
--         \vert & \mathbf{if}~ e \colon\quad \mathrm{stmt}; \mathrm{stmt}; \dots; \mathrm{stmt};\quad \mathbf{else}\colon\quad \mathrm{stmt}; \mathrm{stmt}; \dots; \mathrm{stmt} \\
--         \vert & \mathbf{assert}~ e \\
--     \end{array}
-- \]
data Statement
  = Return Expr'
  | AugAssign Target' Operator Expr'
  | AnnAssign Target' Type Expr'
  | For Target' Expr' [Statement]
  | If Expr' [Statement] [Statement]
  | Assert Expr'
  | -- | expression statements
    Expr' Expr'
  deriving (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, Eq Statement
Eq Statement
-> (Statement -> Statement -> Ordering)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Statement)
-> (Statement -> Statement -> Statement)
-> Ord Statement
Statement -> Statement -> Bool
Statement -> Statement -> Ordering
Statement -> Statement -> Statement
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 :: Statement -> Statement -> Statement
$cmin :: Statement -> Statement -> Statement
max :: Statement -> Statement -> Statement
$cmax :: Statement -> Statement -> Statement
>= :: Statement -> Statement -> Bool
$c>= :: Statement -> Statement -> Bool
> :: Statement -> Statement -> Bool
$c> :: Statement -> Statement -> Bool
<= :: Statement -> Statement -> Bool
$c<= :: Statement -> Statement -> Bool
< :: Statement -> Statement -> Bool
$c< :: Statement -> Statement -> Bool
compare :: Statement -> Statement -> Ordering
$ccompare :: Statement -> Statement -> Ordering
$cp1Ord :: Eq Statement
Ord, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show, ReadPrec [Statement]
ReadPrec Statement
Int -> ReadS Statement
ReadS [Statement]
(Int -> ReadS Statement)
-> ReadS [Statement]
-> ReadPrec Statement
-> ReadPrec [Statement]
-> Read Statement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Statement]
$creadListPrec :: ReadPrec [Statement]
readPrec :: ReadPrec Statement
$creadPrec :: ReadPrec Statement
readList :: ReadS [Statement]
$creadList :: ReadS [Statement]
readsPrec :: Int -> ReadS Statement
$creadsPrec :: Int -> ReadS Statement
Read)

pattern $mAppend :: forall r.
Statement
-> (Maybe Loc -> Type -> Expr' -> Expr' -> r) -> (Void# -> r) -> r
Append loc t e1 e2 <- Expr' (WithLoc' loc (Call (WithLoc' _ (Attribute e1 (WithLoc' _ (BuiltinAppend t)))) [e2]))

-- | `TopLevelStatement` represents the statements of our restricted Python-like language.
-- They appear in the toplevel of programs.
--
-- \[
--     \begin{array}{rl}
--         \mathrm{tlstmt} ::= & x _ \tau := e \\
--         \vert & \mathbf{def}~ x (x _ \tau, x _ \tau, \dots, x _ \tau) \to \tau \colon\quad \mathrm{stmt}; \mathrm{stmt}; \dots; \mathrm{stmt} \\
--         \vert & \mathbf{assert}~ e \\
--     \end{array}
-- \]
data ToplevelStatement
  = ToplevelAnnAssign VarName' Type Expr'
  | ToplevelFunctionDef VarName' [(VarName', Type)] Type [Statement]
  | ToplevelAssert Expr'
  deriving (ToplevelStatement -> ToplevelStatement -> Bool
(ToplevelStatement -> ToplevelStatement -> Bool)
-> (ToplevelStatement -> ToplevelStatement -> Bool)
-> Eq ToplevelStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToplevelStatement -> ToplevelStatement -> Bool
$c/= :: ToplevelStatement -> ToplevelStatement -> Bool
== :: ToplevelStatement -> ToplevelStatement -> Bool
$c== :: ToplevelStatement -> ToplevelStatement -> Bool
Eq, Eq ToplevelStatement
Eq ToplevelStatement
-> (ToplevelStatement -> ToplevelStatement -> Ordering)
-> (ToplevelStatement -> ToplevelStatement -> Bool)
-> (ToplevelStatement -> ToplevelStatement -> Bool)
-> (ToplevelStatement -> ToplevelStatement -> Bool)
-> (ToplevelStatement -> ToplevelStatement -> Bool)
-> (ToplevelStatement -> ToplevelStatement -> ToplevelStatement)
-> (ToplevelStatement -> ToplevelStatement -> ToplevelStatement)
-> Ord ToplevelStatement
ToplevelStatement -> ToplevelStatement -> Bool
ToplevelStatement -> ToplevelStatement -> Ordering
ToplevelStatement -> ToplevelStatement -> ToplevelStatement
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 :: ToplevelStatement -> ToplevelStatement -> ToplevelStatement
$cmin :: ToplevelStatement -> ToplevelStatement -> ToplevelStatement
max :: ToplevelStatement -> ToplevelStatement -> ToplevelStatement
$cmax :: ToplevelStatement -> ToplevelStatement -> ToplevelStatement
>= :: ToplevelStatement -> ToplevelStatement -> Bool
$c>= :: ToplevelStatement -> ToplevelStatement -> Bool
> :: ToplevelStatement -> ToplevelStatement -> Bool
$c> :: ToplevelStatement -> ToplevelStatement -> Bool
<= :: ToplevelStatement -> ToplevelStatement -> Bool
$c<= :: ToplevelStatement -> ToplevelStatement -> Bool
< :: ToplevelStatement -> ToplevelStatement -> Bool
$c< :: ToplevelStatement -> ToplevelStatement -> Bool
compare :: ToplevelStatement -> ToplevelStatement -> Ordering
$ccompare :: ToplevelStatement -> ToplevelStatement -> Ordering
$cp1Ord :: Eq ToplevelStatement
Ord, Int -> ToplevelStatement -> ShowS
[ToplevelStatement] -> ShowS
ToplevelStatement -> String
(Int -> ToplevelStatement -> ShowS)
-> (ToplevelStatement -> String)
-> ([ToplevelStatement] -> ShowS)
-> Show ToplevelStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToplevelStatement] -> ShowS
$cshowList :: [ToplevelStatement] -> ShowS
show :: ToplevelStatement -> String
$cshow :: ToplevelStatement -> String
showsPrec :: Int -> ToplevelStatement -> ShowS
$cshowsPrec :: Int -> ToplevelStatement -> ShowS
Show, ReadPrec [ToplevelStatement]
ReadPrec ToplevelStatement
Int -> ReadS ToplevelStatement
ReadS [ToplevelStatement]
(Int -> ReadS ToplevelStatement)
-> ReadS [ToplevelStatement]
-> ReadPrec ToplevelStatement
-> ReadPrec [ToplevelStatement]
-> Read ToplevelStatement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ToplevelStatement]
$creadListPrec :: ReadPrec [ToplevelStatement]
readPrec :: ReadPrec ToplevelStatement
$creadPrec :: ReadPrec ToplevelStatement
readList :: ReadS [ToplevelStatement]
$creadList :: ReadS [ToplevelStatement]
readsPrec :: Int -> ReadS ToplevelStatement
$creadsPrec :: Int -> ReadS ToplevelStatement
Read)

-- | `Program` represents the programs of our restricted Python-like language.
--
-- \[
--     \begin{array}{rl}
--         \mathrm{prog} ::= & \mathrm{tlstmt}; \mathrm{tlstmt}; \dots; \mathrm{tlstmt} \\
--     \end{array}
-- \]
type Program = [ToplevelStatement]