{-# LANGUAGE GADTs #-}
-- | Defines functions to convert from the base expression language to 'ModelExpr's.
module Language.Drasil.ModelExpr.Convert where

import Data.Bifunctor (bimap, second)

import Language.Drasil.Space
import qualified Language.Drasil.Expr.Lang as E
import Language.Drasil.ModelExpr.Lang

assocArithOper :: E.AssocArithOper -> AssocArithOper 
assocArithOper :: AssocArithOper -> AssocArithOper
assocArithOper E.AddI  = AssocArithOper
AddI
assocArithOper E.AddRe = AssocArithOper
AddRe
assocArithOper E.MulI  = AssocArithOper
MulI
assocArithOper E.MulRe = AssocArithOper
MulRe

assocBoolOper :: E.AssocBoolOper -> AssocBoolOper
assocBoolOper :: AssocBoolOper -> AssocBoolOper
assocBoolOper E.And = AssocBoolOper
And
assocBoolOper E.Or  = AssocBoolOper
Or

uFunc :: E.UFunc -> UFunc
uFunc :: UFunc -> UFunc
uFunc E.Abs    = UFunc
Abs
uFunc E.Log    = UFunc
Log
uFunc E.Ln     = UFunc
Ln
uFunc E.Sin    = UFunc
Sin
uFunc E.Cos    = UFunc
Cos
uFunc E.Tan    = UFunc
Tan
uFunc E.Sec    = UFunc
Sec
uFunc E.Csc    = UFunc
Csc
uFunc E.Cot    = UFunc
Cot
uFunc E.Arcsin = UFunc
Arcsin
uFunc E.Arccos = UFunc
Arccos
uFunc E.Arctan = UFunc
Arctan
uFunc E.Exp    = UFunc
Exp
uFunc E.Sqrt   = UFunc
Sqrt
uFunc E.Neg    = UFunc
Neg

uFuncB :: E.UFuncB -> UFuncB
uFuncB :: UFuncB -> UFuncB
uFuncB E.Not = UFuncB
Not

uFuncVV :: E.UFuncVV -> UFuncVV
uFuncVV :: UFuncVV -> UFuncVV
uFuncVV E.NegV = UFuncVV
NegV

uFuncVN :: E.UFuncVN -> UFuncVN
uFuncVN :: UFuncVN -> UFuncVN
uFuncVN E.Norm = UFuncVN
Norm
uFuncVN E.Dim  = UFuncVN
Dim

arithBinOp :: E.ArithBinOp -> ArithBinOp
arithBinOp :: ArithBinOp -> ArithBinOp
arithBinOp E.Frac = ArithBinOp
Frac
arithBinOp E.Pow  = ArithBinOp
Pow
arithBinOp E.Subt = ArithBinOp
Subt

boolBinOp :: E.BoolBinOp -> BoolBinOp
boolBinOp :: BoolBinOp -> BoolBinOp
boolBinOp E.Impl = BoolBinOp
Impl
boolBinOp E.Iff  = BoolBinOp
Iff

eqBinOp :: E.EqBinOp -> EqBinOp
eqBinOp :: EqBinOp -> EqBinOp
eqBinOp E.Eq  = EqBinOp
Eq
eqBinOp E.NEq = EqBinOp
NEq

laBinOp :: E.LABinOp -> LABinOp
laBinOp :: LABinOp -> LABinOp
laBinOp E.Index = LABinOp
Index

ordBinOp :: E.OrdBinOp -> OrdBinOp
ordBinOp :: OrdBinOp -> OrdBinOp
ordBinOp E.Lt  = OrdBinOp
Lt
ordBinOp E.Gt  = OrdBinOp
Gt
ordBinOp E.LEq = OrdBinOp
LEq
ordBinOp E.GEq = OrdBinOp
GEq

vvvBinOp :: E.VVVBinOp -> VVVBinOp
vvvBinOp :: VVVBinOp -> VVVBinOp
vvvBinOp E.Cross = VVVBinOp
Cross

vvnBinOp :: E.VVNBinOp -> VVNBinOp
vvnBinOp :: VVNBinOp -> VVNBinOp
vvnBinOp E.Dot = VVNBinOp
Dot

expr :: E.Expr -> ModelExpr
expr :: Expr -> ModelExpr
expr (E.Lit a :: Literal
a) = Literal -> ModelExpr
Lit Literal
a
expr (E.AssocA ao :: AssocArithOper
ao es :: [Expr]
es) = AssocArithOper -> [ModelExpr] -> ModelExpr
AssocA (AssocArithOper -> AssocArithOper
assocArithOper AssocArithOper
ao) ([ModelExpr] -> ModelExpr) -> [ModelExpr] -> ModelExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> ModelExpr) -> [Expr] -> [ModelExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ModelExpr
expr [Expr]
es
expr (E.AssocB bo :: AssocBoolOper
bo es :: [Expr]
es) = AssocBoolOper -> [ModelExpr] -> ModelExpr
AssocB (AssocBoolOper -> AssocBoolOper
assocBoolOper AssocBoolOper
bo) ([ModelExpr] -> ModelExpr) -> [ModelExpr] -> ModelExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> ModelExpr) -> [Expr] -> [ModelExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ModelExpr
expr [Expr]
es
expr (E.C u :: UID
u) = UID -> ModelExpr
C UID
u
expr (E.FCall u :: UID
u es :: [Expr]
es nes :: [(UID, Expr)]
nes) = UID -> [ModelExpr] -> [(UID, ModelExpr)] -> ModelExpr
FCall UID
u ((Expr -> ModelExpr) -> [Expr] -> [ModelExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ModelExpr
expr [Expr]
es) (((UID, Expr) -> (UID, ModelExpr))
-> [(UID, Expr)] -> [(UID, ModelExpr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Expr -> ModelExpr) -> (UID, Expr) -> (UID, ModelExpr)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Expr -> ModelExpr
expr) [(UID, Expr)]
nes)
expr (E.Case c :: Completeness
c ces :: [(Expr, Expr)]
ces) = Completeness -> [(ModelExpr, ModelExpr)] -> ModelExpr
Case Completeness
c (((Expr, Expr) -> (ModelExpr, ModelExpr))
-> [(Expr, Expr)] -> [(ModelExpr, ModelExpr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Expr -> ModelExpr)
-> (Expr -> ModelExpr) -> (Expr, Expr) -> (ModelExpr, ModelExpr)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Expr -> ModelExpr
expr Expr -> ModelExpr
expr) [(Expr, Expr)]
ces)
expr (E.Matrix es :: [[Expr]]
es) = [[ModelExpr]] -> ModelExpr
Matrix ([[ModelExpr]] -> ModelExpr) -> [[ModelExpr]] -> ModelExpr
forall a b. (a -> b) -> a -> b
$ ([Expr] -> [ModelExpr]) -> [[Expr]] -> [[ModelExpr]]
forall a b. (a -> b) -> [a] -> [b]
map ((Expr -> ModelExpr) -> [Expr] -> [ModelExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ModelExpr
expr) [[Expr]]
es
expr (E.UnaryOp u :: UFunc
u e :: Expr
e) = UFunc -> ModelExpr -> ModelExpr
UnaryOp (UFunc -> UFunc
uFunc UFunc
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpB u :: UFuncB
u e :: Expr
e) = UFuncB -> ModelExpr -> ModelExpr
UnaryOpB (UFuncB -> UFuncB
uFuncB UFuncB
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpVV u :: UFuncVV
u e :: Expr
e) = UFuncVV -> ModelExpr -> ModelExpr
UnaryOpVV (UFuncVV -> UFuncVV
uFuncVV UFuncVV
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpVN u :: UFuncVN
u e :: Expr
e) = UFuncVN -> ModelExpr -> ModelExpr
UnaryOpVN (UFuncVN -> UFuncVN
uFuncVN UFuncVN
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.ArithBinaryOp a :: ArithBinOp
a l :: Expr
l r :: Expr
r) = ArithBinOp -> ModelExpr -> ModelExpr -> ModelExpr
ArithBinaryOp (ArithBinOp -> ArithBinOp
arithBinOp ArithBinOp
a) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.BoolBinaryOp b :: BoolBinOp
b l :: Expr
l r :: Expr
r) = BoolBinOp -> ModelExpr -> ModelExpr -> ModelExpr
BoolBinaryOp (BoolBinOp -> BoolBinOp
boolBinOp BoolBinOp
b) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.EqBinaryOp e :: EqBinOp
e l :: Expr
l r :: Expr
r) = EqBinOp -> ModelExpr -> ModelExpr -> ModelExpr
EqBinaryOp (EqBinOp -> EqBinOp
eqBinOp EqBinOp
e) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.LABinaryOp la :: LABinOp
la l :: Expr
l r :: Expr
r) = LABinOp -> ModelExpr -> ModelExpr -> ModelExpr
LABinaryOp (LABinOp -> LABinOp
laBinOp LABinOp
la) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.OrdBinaryOp o :: OrdBinOp
o l :: Expr
l r :: Expr
r) = OrdBinOp -> ModelExpr -> ModelExpr -> ModelExpr
OrdBinaryOp (OrdBinOp -> OrdBinOp
ordBinOp OrdBinOp
o) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.VVVBinaryOp v :: VVVBinOp
v l :: Expr
l r :: Expr
r) = VVVBinOp -> ModelExpr -> ModelExpr -> ModelExpr
VVVBinaryOp (VVVBinOp -> VVVBinOp
vvvBinOp VVVBinOp
v) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.VVNBinaryOp v :: VVNBinOp
v l :: Expr
l r :: Expr
r) = VVNBinOp -> ModelExpr -> ModelExpr -> ModelExpr
VVNBinaryOp (VVNBinOp -> VVNBinOp
vvnBinOp VVNBinOp
v) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.Operator ao :: AssocArithOper
ao dd :: DiscreteDomainDesc Expr Expr
dd e :: Expr
e) = AssocArithOper
-> DomainDesc 'Discrete ModelExpr ModelExpr
-> ModelExpr
-> ModelExpr
forall (t :: RTopology).
AssocArithOper
-> DomainDesc t ModelExpr ModelExpr -> ModelExpr -> ModelExpr
Operator (AssocArithOper -> AssocArithOper
assocArithOper AssocArithOper
ao) (DiscreteDomainDesc Expr Expr
-> DomainDesc 'Discrete ModelExpr ModelExpr
domainDesc DiscreteDomainDesc Expr Expr
dd) (Expr -> ModelExpr
expr Expr
e)
expr (E.RealI u :: UID
u ri :: RealInterval Expr Expr
ri) = UID -> RealInterval ModelExpr ModelExpr -> ModelExpr
RealI UID
u (RealInterval Expr Expr -> RealInterval ModelExpr ModelExpr
realInterval RealInterval Expr Expr
ri)

realInterval :: RealInterval E.Expr E.Expr -> RealInterval ModelExpr ModelExpr
realInterval :: RealInterval Expr Expr -> RealInterval ModelExpr ModelExpr
realInterval (Bounded (li :: Inclusive
li, l :: Expr
l) (ri :: Inclusive
ri, r :: Expr
r)) = (Inclusive, ModelExpr)
-> (Inclusive, ModelExpr) -> RealInterval ModelExpr ModelExpr
forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
li, Expr -> ModelExpr
expr Expr
l) (Inclusive
ri, Expr -> ModelExpr
expr Expr
r)
realInterval (UpTo (i :: Inclusive
i, e :: Expr
e)) = (Inclusive, ModelExpr) -> RealInterval ModelExpr ModelExpr
forall a b. (Inclusive, a) -> RealInterval a b
UpTo (Inclusive
i, Expr -> ModelExpr
expr Expr
e)
realInterval (UpFrom (i :: Inclusive
i, e :: Expr
e)) = (Inclusive, ModelExpr) -> RealInterval ModelExpr ModelExpr
forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
i, Expr -> ModelExpr
expr Expr
e)

domainDesc :: DiscreteDomainDesc E.Expr E.Expr -> DiscreteDomainDesc ModelExpr ModelExpr
domainDesc :: DiscreteDomainDesc Expr Expr
-> DomainDesc 'Discrete ModelExpr ModelExpr
domainDesc (BoundedDD s :: Symbol
s rt :: RTopology
rt l :: Expr
l r :: Expr
r) = Symbol
-> RTopology
-> ModelExpr
-> ModelExpr
-> DomainDesc 'Discrete ModelExpr ModelExpr
forall a b.
Symbol -> RTopology -> a -> b -> DomainDesc 'Discrete a b
BoundedDD Symbol
s RTopology
rt (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
-- domainDesc (AllDD s rt) = AllDD s rt