{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
module Language.Egison.AST
( EgisonTopExpr (..)
, EgisonExpr (..)
, EgisonPattern (..)
, Var (..)
, VarWithIndices (..)
, varToVarWithIndices
, Arg (..)
, Index (..)
, extractIndex
, PMMode (..)
, InnerExpr (..)
, BindingExpr
, MatchClause
, PatternDef
, LoopRange (..)
, PrimitivePatPattern (..)
, PrimitiveDataPattern (..)
, Infix (..)
, BinOpAssoc (..)
, reservedExprInfix
, reservedPatternInfix
, stringToVar
, stringToVarExpr
) where
import Data.Hashable (Hashable)
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Data.Text (Text)
import GHC.Generics (Generic)
data EgisonTopExpr =
Define Var EgisonExpr
| DefineWithIndices VarWithIndices EgisonExpr
| Redefine Var EgisonExpr
| Test EgisonExpr
| Execute EgisonExpr
| LoadFile String
| Load String
| InfixDecl Bool Infix
deriving (Show, Eq)
data EgisonExpr =
CharExpr Char
| StringExpr Text
| BoolExpr Bool
| IntegerExpr Integer
| FloatExpr Double
| VarExpr Var
| FreshVarExpr
| IndexedExpr Bool EgisonExpr [Index EgisonExpr]
| SubrefsExpr Bool EgisonExpr EgisonExpr
| SuprefsExpr Bool EgisonExpr EgisonExpr
| UserrefsExpr Bool EgisonExpr EgisonExpr
| PowerExpr EgisonExpr EgisonExpr
| InductiveDataExpr String [EgisonExpr]
| TupleExpr [EgisonExpr]
| CollectionExpr [InnerExpr]
| ArrayExpr [EgisonExpr]
| HashExpr [(EgisonExpr, EgisonExpr)]
| VectorExpr [EgisonExpr]
| LambdaExpr [Arg] EgisonExpr
| MemoizedLambdaExpr [String] EgisonExpr
| MemoizeExpr [(EgisonExpr, EgisonExpr, EgisonExpr)] EgisonExpr
| CambdaExpr String EgisonExpr
| ProcedureExpr [String] EgisonExpr
| PatternFunctionExpr [String] EgisonPattern
| IfExpr EgisonExpr EgisonExpr EgisonExpr
| LetRecExpr [BindingExpr] EgisonExpr
| LetExpr [BindingExpr] EgisonExpr
| LetStarExpr [BindingExpr] EgisonExpr
| WithSymbolsExpr [String] EgisonExpr
| MatchExpr PMMode EgisonExpr EgisonExpr [MatchClause]
| MatchAllExpr PMMode EgisonExpr EgisonExpr [MatchClause]
| MatchLambdaExpr EgisonExpr [MatchClause]
| MatchAllLambdaExpr EgisonExpr [MatchClause]
| MatcherExpr [PatternDef]
| AlgebraicDataMatcherExpr [(String, [EgisonExpr])]
| QuoteExpr EgisonExpr
| QuoteSymbolExpr EgisonExpr
| WedgeApplyExpr EgisonExpr EgisonExpr
| DoExpr [BindingExpr] EgisonExpr
| IoExpr EgisonExpr
| UnaryOpExpr String EgisonExpr
| BinaryOpExpr Infix EgisonExpr EgisonExpr
| SectionExpr Infix (Maybe EgisonExpr) (Maybe EgisonExpr)
| SeqExpr EgisonExpr EgisonExpr
| ApplyExpr EgisonExpr EgisonExpr
| CApplyExpr EgisonExpr EgisonExpr
| PartialExpr Integer EgisonExpr
| PartialVarExpr Integer
| GenerateArrayExpr EgisonExpr (EgisonExpr, EgisonExpr)
| ArrayBoundsExpr EgisonExpr
| ArrayRefExpr EgisonExpr EgisonExpr
| GenerateTensorExpr EgisonExpr EgisonExpr
| TensorExpr EgisonExpr EgisonExpr
| TensorContractExpr EgisonExpr EgisonExpr
| TensorMapExpr EgisonExpr EgisonExpr
| TensorMap2Expr EgisonExpr EgisonExpr EgisonExpr
| TransposeExpr EgisonExpr EgisonExpr
| FlipIndicesExpr EgisonExpr
| FunctionExpr [EgisonExpr]
| SomethingExpr
| UndefinedExpr
deriving (Eq, Show)
data Var = Var [String] [Index ()]
deriving (Eq, Generic)
data VarWithIndices = VarWithIndices [String] [Index String]
deriving (Eq)
data Arg =
ScalarArg String
| InvertedScalarArg String
| TensorArg String
deriving (Eq, Show)
data Index a =
Subscript a
| Superscript a
| SupSubscript a
| MultiSubscript a a
| MultiSuperscript a a
| DFscript Integer Integer
| Userscript a
deriving (Eq, Functor, Foldable, Generic, Traversable)
extractIndex :: Index a -> a
extractIndex (Subscript x) = x
extractIndex (Superscript x) = x
extractIndex (SupSubscript x) = x
extractIndex (Userscript x) = x
extractIndex _ = error "extractIndex: Not supported"
data InnerExpr =
ElementExpr EgisonExpr
| SubCollectionExpr EgisonExpr
deriving (Show, Eq)
data PMMode = BFSMode | DFSMode
deriving (Eq, Show)
type BindingExpr = ([Var], EgisonExpr)
type MatchClause = (EgisonPattern, EgisonExpr)
type PatternDef = (PrimitivePatPattern, EgisonExpr, [(PrimitiveDataPattern, EgisonExpr)])
data EgisonPattern =
WildCard
| PatVar Var
| ValuePat EgisonExpr
| PredPat EgisonExpr
| IndexedPat EgisonPattern [EgisonExpr]
| LetPat [BindingExpr] EgisonPattern
| InfixPat Infix EgisonPattern EgisonPattern
| NotPat EgisonPattern
| AndPat [EgisonPattern]
| OrPat [EgisonPattern]
| ForallPat EgisonPattern EgisonPattern
| TuplePat [EgisonPattern]
| InductivePat String [EgisonPattern]
| LoopPat Var LoopRange EgisonPattern EgisonPattern
| ContPat
| PApplyPat EgisonExpr [EgisonPattern]
| VarPat String
| InductiveOrPApplyPat String [EgisonPattern]
| SeqNilPat
| SeqConsPat EgisonPattern EgisonPattern
| LaterPatVar
| DApplyPat EgisonPattern [EgisonPattern]
| DivPat EgisonPattern EgisonPattern
| PlusPat [EgisonPattern]
| MultPat [EgisonPattern]
| PowerPat EgisonPattern EgisonPattern
deriving (Eq, Show)
data LoopRange = LoopRange EgisonExpr EgisonExpr EgisonPattern
deriving (Eq, Show)
data PrimitivePatPattern =
PPWildCard
| PPPatVar
| PPValuePat String
| PPInductivePat String [PrimitivePatPattern]
| PPTuplePat [PrimitivePatPattern]
deriving (Show, Eq)
data PrimitiveDataPattern =
PDWildCard
| PDPatVar String
| PDInductivePat String [PrimitiveDataPattern]
| PDTuplePat [PrimitiveDataPattern]
| PDEmptyPat
| PDConsPat PrimitiveDataPattern PrimitiveDataPattern
| PDSnocPat PrimitiveDataPattern PrimitiveDataPattern
| PDConstantPat EgisonExpr
deriving (Show, Eq)
data Infix
= Infix { repr :: String
, func :: String
, priority :: Int
, assoc :: BinOpAssoc
, isWedge :: Bool
}
deriving (Eq, Ord, Show)
data BinOpAssoc
= LeftAssoc
| RightAssoc
| NonAssoc
deriving (Eq, Ord)
instance Show BinOpAssoc where
show LeftAssoc = "infixl"
show RightAssoc = "infixr"
show NonAssoc = "infix"
reservedExprInfix :: [Infix]
reservedExprInfix =
[ makeInfix "^" "**" 8 LeftAssoc
, makeInfix "*" "*" 7 LeftAssoc
, makeInfix "/" "/" 7 LeftAssoc
, makeInfix "." "." 7 LeftAssoc
, makeInfix "%" "remainder" 7 LeftAssoc
, makeInfix "+" "+" 6 LeftAssoc
, makeInfix "-" "-" 6 LeftAssoc
, makeInfix "++" "append" 5 RightAssoc
, makeInfix "::" "cons" 5 RightAssoc
, makeInfix "=" "eq?" 4 LeftAssoc
, makeInfix "<=" "lte?" 4 LeftAssoc
, makeInfix ">=" "gte?" 4 LeftAssoc
, makeInfix "<" "lt?" 4 LeftAssoc
, makeInfix ">" "gt?" 4 LeftAssoc
, makeInfix "&&" "and" 3 RightAssoc
, makeInfix "||" "or" 2 RightAssoc
, makeInfix "$" "apply" 0 RightAssoc
]
where
makeInfix r f p a =
Infix { repr = r, func = f, priority = p, assoc = a, isWedge = False }
reservedPatternInfix :: [Infix]
reservedPatternInfix =
[ makeInfix "::" "cons" 5 RightAssoc
, makeInfix "++" "join" 5 RightAssoc
, makeInfix "&" "&" 3 RightAssoc
, makeInfix "|" "|" 2 RightAssoc
]
where
makeInfix r f p a =
Infix { repr = r, func = f, priority = p, assoc = a, isWedge = False }
instance Hashable (Index ())
instance Hashable Var
stringToVar :: String -> Var
stringToVar name = Var (splitOn "." name) []
stringToVarExpr :: String -> EgisonExpr
stringToVarExpr = VarExpr . stringToVar
instance Show Var where
show (Var xs is) = intercalate "." xs ++ concatMap show is
instance Show VarWithIndices where
show (VarWithIndices xs is) = intercalate "." xs ++ concatMap show is
varToVarWithIndices :: Var -> VarWithIndices
varToVarWithIndices (Var xs is) = VarWithIndices xs $ map f is
where
f :: Index () -> Index String
f index = (\() -> "") <$> index
instance Show (Index ()) where
show (Superscript ()) = "~"
show (Subscript ()) = "_"
show (SupSubscript ()) = "~_"
show (DFscript _ _) = ""
show (Userscript _) = "|"
instance Show (Index String) where
show (Superscript s) = "~" ++ s
show (Subscript s) = "_" ++ s
show (SupSubscript s) = "~_" ++ s
show (DFscript _ _) = ""
show (Userscript i) = "|" ++ show i
instance Show (Index EgisonExpr) where
show (Superscript i) = "~" ++ show i
show (Subscript i) = "_" ++ show i
show (SupSubscript i) = "~_" ++ show i
show (DFscript _ _) = ""
show (Userscript i) = "|" ++ show i