{-# LANGUAGE GADTs #-}

module Language.Drasil.CodeExpr.Lang where

import Prelude hiding (sqrt)

import Language.Drasil.Expr.Lang (Completeness)
import Language.Drasil.Literal.Class (LiteralC(..))
import Language.Drasil.Literal.Lang (Literal(..))
import Language.Drasil.Space (Space, RealInterval, DiscreteDomainDesc)
import Language.Drasil.UID (UID)

-- * Operators (mostly binary)

-- | Arithmetic operators (fractional, power, and subtraction).
data ArithBinOp = Frac | Pow | Subt
  deriving ArithBinOp -> ArithBinOp -> Bool
(ArithBinOp -> ArithBinOp -> Bool)
-> (ArithBinOp -> ArithBinOp -> Bool) -> Eq ArithBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArithBinOp -> ArithBinOp -> Bool
== :: ArithBinOp -> ArithBinOp -> Bool
$c/= :: ArithBinOp -> ArithBinOp -> Bool
/= :: ArithBinOp -> ArithBinOp -> Bool
Eq

-- | Equality operators (equal or not equal).
data EqBinOp = Eq | NEq
  deriving EqBinOp -> EqBinOp -> Bool
(EqBinOp -> EqBinOp -> Bool)
-> (EqBinOp -> EqBinOp -> Bool) -> Eq EqBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EqBinOp -> EqBinOp -> Bool
== :: EqBinOp -> EqBinOp -> Bool
$c/= :: EqBinOp -> EqBinOp -> Bool
/= :: EqBinOp -> EqBinOp -> Bool
Eq

-- | Conditional and Biconditional operators (Expressions can imply
-- one another, or exist if and only if another expression exists).
data BoolBinOp = Impl | Iff
  deriving BoolBinOp -> BoolBinOp -> Bool
(BoolBinOp -> BoolBinOp -> Bool)
-> (BoolBinOp -> BoolBinOp -> Bool) -> Eq BoolBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoolBinOp -> BoolBinOp -> Bool
== :: BoolBinOp -> BoolBinOp -> Bool
$c/= :: BoolBinOp -> BoolBinOp -> Bool
/= :: BoolBinOp -> BoolBinOp -> Bool
Eq

-- | Index operator.
data LABinOp = Index | IndexOf
  deriving LABinOp -> LABinOp -> Bool
(LABinOp -> LABinOp -> Bool)
-> (LABinOp -> LABinOp -> Bool) -> Eq LABinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LABinOp -> LABinOp -> Bool
== :: LABinOp -> LABinOp -> Bool
$c/= :: LABinOp -> LABinOp -> Bool
/= :: LABinOp -> LABinOp -> Bool
Eq

-- | Ordered binary operators (less than, greater than, less than or equal to, greater than or equal to).
data OrdBinOp = Lt | Gt | LEq | GEq
  deriving OrdBinOp -> OrdBinOp -> Bool
(OrdBinOp -> OrdBinOp -> Bool)
-> (OrdBinOp -> OrdBinOp -> Bool) -> Eq OrdBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrdBinOp -> OrdBinOp -> Bool
== :: OrdBinOp -> OrdBinOp -> Bool
$c/= :: OrdBinOp -> OrdBinOp -> Bool
/= :: OrdBinOp -> OrdBinOp -> Bool
Eq

-- | @Vector x Vector -> Vector@ binary operations (cross product, vector addition, vector sub).
data VVVBinOp = Cross | VAdd | VSub
  deriving VVVBinOp -> VVVBinOp -> Bool
(VVVBinOp -> VVVBinOp -> Bool)
-> (VVVBinOp -> VVVBinOp -> Bool) -> Eq VVVBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VVVBinOp -> VVVBinOp -> Bool
== :: VVVBinOp -> VVVBinOp -> Bool
$c/= :: VVVBinOp -> VVVBinOp -> Bool
/= :: VVVBinOp -> VVVBinOp -> Bool
Eq

-- | @Vector x Vector -> Number@ binary operations (dot product).
data VVNBinOp = Dot
  deriving VVNBinOp -> VVNBinOp -> Bool
(VVNBinOp -> VVNBinOp -> Bool)
-> (VVNBinOp -> VVNBinOp -> Bool) -> Eq VVNBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VVNBinOp -> VVNBinOp -> Bool
== :: VVNBinOp -> VVNBinOp -> Bool
$c/= :: VVNBinOp -> VVNBinOp -> Bool
/= :: VVNBinOp -> VVNBinOp -> Bool
Eq

-- | @Number x Vector -> Vector@ binary operations (scaling).
data NVVBinOp = Scale
  deriving NVVBinOp -> NVVBinOp -> Bool
(NVVBinOp -> NVVBinOp -> Bool)
-> (NVVBinOp -> NVVBinOp -> Bool) -> Eq NVVBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NVVBinOp -> NVVBinOp -> Bool
== :: NVVBinOp -> NVVBinOp -> Bool
$c/= :: NVVBinOp -> NVVBinOp -> Bool
/= :: NVVBinOp -> NVVBinOp -> Bool
Eq

-- | Element + Set -> Set
data ESSBinOp = SAdd | SRemove
  deriving ESSBinOp -> ESSBinOp -> Bool
(ESSBinOp -> ESSBinOp -> Bool)
-> (ESSBinOp -> ESSBinOp -> Bool) -> Eq ESSBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ESSBinOp -> ESSBinOp -> Bool
== :: ESSBinOp -> ESSBinOp -> Bool
$c/= :: ESSBinOp -> ESSBinOp -> Bool
/= :: ESSBinOp -> ESSBinOp -> Bool
Eq

-- | Element + Set -> Bool
data ESBBinOp = SContains
  deriving ESBBinOp -> ESBBinOp -> Bool
(ESBBinOp -> ESBBinOp -> Bool)
-> (ESBBinOp -> ESBBinOp -> Bool) -> Eq ESBBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ESBBinOp -> ESBBinOp -> Bool
== :: ESBBinOp -> ESBBinOp -> Bool
$c/= :: ESBBinOp -> ESBBinOp -> Bool
/= :: ESBBinOp -> ESBBinOp -> Bool
Eq

data AssocConcatOper = SUnion
  deriving AssocConcatOper -> AssocConcatOper -> Bool
(AssocConcatOper -> AssocConcatOper -> Bool)
-> (AssocConcatOper -> AssocConcatOper -> Bool)
-> Eq AssocConcatOper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssocConcatOper -> AssocConcatOper -> Bool
== :: AssocConcatOper -> AssocConcatOper -> Bool
$c/= :: AssocConcatOper -> AssocConcatOper -> Bool
/= :: AssocConcatOper -> AssocConcatOper -> Bool
Eq
-- | Associative operators (adding and multiplication). Also specifies whether it is for integers or for real numbers.
data AssocArithOper = Add | Mul
  deriving AssocArithOper -> AssocArithOper -> Bool
(AssocArithOper -> AssocArithOper -> Bool)
-> (AssocArithOper -> AssocArithOper -> Bool) -> Eq AssocArithOper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssocArithOper -> AssocArithOper -> Bool
== :: AssocArithOper -> AssocArithOper -> Bool
$c/= :: AssocArithOper -> AssocArithOper -> Bool
/= :: AssocArithOper -> AssocArithOper -> Bool
Eq

-- | Associative boolean operators (and, or).
data AssocBoolOper = And | Or
  deriving AssocBoolOper -> AssocBoolOper -> Bool
(AssocBoolOper -> AssocBoolOper -> Bool)
-> (AssocBoolOper -> AssocBoolOper -> Bool) -> Eq AssocBoolOper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssocBoolOper -> AssocBoolOper -> Bool
== :: AssocBoolOper -> AssocBoolOper -> Bool
$c/= :: AssocBoolOper -> AssocBoolOper -> Bool
/= :: AssocBoolOper -> AssocBoolOper -> Bool
Eq

-- | Unary functions (abs, log, ln, sin, etc.).
data UFunc = Abs | Log | Ln | Sin | Cos | Tan | Sec | Csc | Cot | Arcsin
  | Arccos | Arctan | Exp | Sqrt | Neg
  deriving UFunc -> UFunc -> Bool
(UFunc -> UFunc -> Bool) -> (UFunc -> UFunc -> Bool) -> Eq UFunc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UFunc -> UFunc -> Bool
== :: UFunc -> UFunc -> Bool
$c/= :: UFunc -> UFunc -> Bool
/= :: UFunc -> UFunc -> Bool
Eq

-- | @Bool -> Bool@ operators.
data UFuncB = Not
  deriving UFuncB -> UFuncB -> Bool
(UFuncB -> UFuncB -> Bool)
-> (UFuncB -> UFuncB -> Bool) -> Eq UFuncB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UFuncB -> UFuncB -> Bool
== :: UFuncB -> UFuncB -> Bool
$c/= :: UFuncB -> UFuncB -> Bool
/= :: UFuncB -> UFuncB -> Bool
Eq

-- | @Vector -> Vector@ operators.
data UFuncVV = NegV
  deriving UFuncVV -> UFuncVV -> Bool
(UFuncVV -> UFuncVV -> Bool)
-> (UFuncVV -> UFuncVV -> Bool) -> Eq UFuncVV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UFuncVV -> UFuncVV -> Bool
== :: UFuncVV -> UFuncVV -> Bool
$c/= :: UFuncVV -> UFuncVV -> Bool
/= :: UFuncVV -> UFuncVV -> Bool
Eq

-- | @Vector -> Number@ operators.
data UFuncVN = Norm | Dim
  deriving UFuncVN -> UFuncVN -> Bool
(UFuncVN -> UFuncVN -> Bool)
-> (UFuncVN -> UFuncVN -> Bool) -> Eq UFuncVN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UFuncVN -> UFuncVN -> Bool
== :: UFuncVN -> UFuncVN -> Bool
$c/= :: UFuncVN -> UFuncVN -> Bool
/= :: UFuncVN -> UFuncVN -> Bool
Eq

-- * CodeExpr

-- | Expression language where all terms also denote a term in GOOL
--   (i.e. translation is total and meaning preserving).
data CodeExpr where
  -- | Brings literals into the expression language.
  Lit      :: Literal -> CodeExpr

  -- | Takes an associative arithmetic operator with a list of expressions.
  AssocA   :: AssocArithOper -> [CodeExpr] -> CodeExpr
  -- | Takes an associative boolean operator with a list of expressions.
  AssocB   :: AssocBoolOper  -> [CodeExpr] -> CodeExpr

  AssocC :: AssocConcatOper -> [CodeExpr] -> CodeExpr
  -- | C stands for "Chunk", for referring to a chunk in an expression.
  --   Implicitly assumes that the chunk has a symbol.
  C        :: UID -> CodeExpr
  -- | A function call accepts a list of parameters and a list of named parameters.
  --   For example
  --
  --   * F(x) is (FCall F [x] []).
  --   * F(x,y) would be (FCall F [x,y]).
  --   * F(x,n=y) would be (FCall F [x] [(n,y)]).
  FCall    :: UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
  -- | Actor creation given 'UID', parameters, and named parameters.
  New      :: UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
  -- | Message an actor:
  --
  --   * 1st 'UID' is the actor,
  --   * 2nd 'UID' is the method.
  Message  :: UID -> UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
  -- | Access a field of an actor:
  --
  --   * 1st 'UID' is the actor,
  --   * 2nd 'UID' is the field.
  Field    :: UID -> UID -> CodeExpr
  -- | For multi-case expressions, each pair represents one case.
  Case     :: Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
  -- | Represents a matrix of expressions.
  Matrix   :: [[CodeExpr]] -> CodeExpr
  -- | Represents a set of expressions
  Set      :: Space -> [CodeExpr] -> CodeExpr
  -- | used to refernce the (name + type = variable )
  Variable :: String -> CodeExpr -> CodeExpr
  -- | Unary operation for most functions (eg. sin, cos, log, etc.).
  UnaryOp       :: UFunc -> CodeExpr -> CodeExpr
  -- | Unary operation for @Bool -> Bool@ operations.
  UnaryOpB      :: UFuncB -> CodeExpr -> CodeExpr
  -- | Unary operation for @Vector -> Vector@ operations.
  UnaryOpVV     :: UFuncVV -> CodeExpr -> CodeExpr
  -- | Unary operation for @Vector -> Number@ operations.
  UnaryOpVN     :: UFuncVN -> CodeExpr -> CodeExpr

  -- | Binary operator for arithmetic between expressions (fractional, power, and subtraction).
  ArithBinaryOp :: ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Binary operator for boolean operators (implies, iff).
  BoolBinaryOp  :: BoolBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Binary operator for equality between expressions.
  EqBinaryOp    :: EqBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Binary operator for indexing two expressions.
  LABinaryOp    :: LABinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Binary operator for ordering expressions (less than, greater than, etc.).
  OrdBinaryOp   :: OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Binary operator for @Vector x Vector -> Vector@ operations (cross product).
  VVVBinaryOp   :: VVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Binary operator for @Vector x Vector -> Number@ operations (dot product).
  VVNBinaryOp   :: VVNBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Binary operator for @Number x Vector -> Vector@ operations (scaling).
  NVVBinaryOp   :: NVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Set operator for Set + Set -> Set
  ESSBinaryOp :: ESSBinOp -> CodeExpr -> CodeExpr -> CodeExpr
  -- | Set operator for Element + Set -> Bool
  ESBBinaryOp :: ESBBinOp -> CodeExpr -> CodeExpr -> CodeExpr

  -- | Operators are generalized arithmetic operators over a 'DomainDesc'
  --   of an 'Expr'.  Could be called BigOp.
  --   ex: Summation is represented via 'Add' over a discrete domain.
  Operator :: AssocArithOper -> DiscreteDomainDesc CodeExpr CodeExpr -> CodeExpr -> CodeExpr
  -- | The expression is an element of a space.
  -- IsIn     :: Expr -> Space -> Expr
  -- | A different kind of 'IsIn'. A 'UID' is an element of an interval.
  RealI    :: UID -> RealInterval CodeExpr CodeExpr -> CodeExpr

instance LiteralC CodeExpr where
  str :: String -> CodeExpr
str      = Literal -> CodeExpr
Lit (Literal -> CodeExpr) -> (String -> Literal) -> String -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
forall r. LiteralC r => String -> r
str
  int :: Integer -> CodeExpr
int      = Literal -> CodeExpr
Lit (Literal -> CodeExpr)
-> (Integer -> Literal) -> Integer -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
forall r. LiteralC r => Integer -> r
int
  dbl :: Double -> CodeExpr
dbl      = Literal -> CodeExpr
Lit (Literal -> CodeExpr) -> (Double -> Literal) -> Double -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Literal
forall r. LiteralC r => Double -> r
dbl
  exactDbl :: Integer -> CodeExpr
exactDbl = Literal -> CodeExpr
Lit (Literal -> CodeExpr)
-> (Integer -> Literal) -> Integer -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
forall r. LiteralC r => Integer -> r
exactDbl
  perc :: Integer -> Integer -> CodeExpr
perc Integer
l Integer
r = Literal -> CodeExpr
Lit (Literal -> CodeExpr) -> Literal -> CodeExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Literal
forall r. LiteralC r => Integer -> Integer -> r
perc Integer
l Integer
r