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

import Data.Bifunctor (bimap)

import Language.Drasil.Space
    (RealInterval(..), DiscreteDomainDesc, DomainDesc(BoundedDD))
import qualified Language.Drasil.Expr.Lang as E
import Language.Drasil.ModelExpr.Lang

assocArithOper :: E.AssocArithOper -> AssocArithOper 
assocArithOper :: AssocArithOper -> AssocArithOper
assocArithOper AssocArithOper
E.Add  = AssocArithOper
Add
assocArithOper AssocArithOper
E.Mul  = AssocArithOper
Mul

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

assocConcatOper :: E.AssocConcatOper -> AssocConcatOper 
assocConcatOper :: AssocConcatOper -> AssocConcatOper
assocConcatOper AssocConcatOper
E.SUnion  = AssocConcatOper
SUnion

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

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

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

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

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

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

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

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

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

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

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

nvvBinOp :: E.NVVBinOp -> NVVBinOp
nvvBinOp :: NVVBinOp -> NVVBinOp
nvvBinOp NVVBinOp
E.Scale = NVVBinOp
Scale

essBinOp :: E.ESSBinOp -> ESSBinOp
essBinOp :: ESSBinOp -> ESSBinOp
essBinOp ESSBinOp
E.SAdd = ESSBinOp
SAdd
essBinOp ESSBinOp
E.SRemove = ESSBinOp
SRemove

esbBinOp :: E.ESBBinOp -> ESBBinOp
esbBinOp :: ESBBinOp -> ESBBinOp
esbBinOp ESBBinOp
E.SContains = ESBBinOp
SContains

expr :: E.Expr -> ModelExpr
expr :: Expr -> ModelExpr
expr (E.Lit Literal
a)               = Literal -> ModelExpr
Lit Literal
a
expr (E.AssocA AssocArithOper
ao [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 AssocBoolOper
bo [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.AssocC AssocConcatOper
ao [Expr]
es)        = AssocConcatOper -> [ModelExpr] -> ModelExpr
AssocC (AssocConcatOper -> AssocConcatOper
assocConcatOper AssocConcatOper
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.C UID
u)                 = UID -> ModelExpr
C UID
u
expr (E.FCall UID
u [Expr]
es)          = UID -> [ModelExpr] -> ModelExpr
FCall UID
u ((Expr -> ModelExpr) -> [Expr] -> [ModelExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ModelExpr
expr [Expr]
es)
expr (E.Case Completeness
c [(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 a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
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 [[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.Set Space
s [Expr]
e)             = Space -> [ModelExpr] -> ModelExpr
Set Space
s ([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]
e
expr (E.Variable String
s Expr
e)        = String -> ModelExpr -> ModelExpr
Variable String
s (ModelExpr -> ModelExpr) -> ModelExpr -> ModelExpr
forall a b. (a -> b) -> a -> b
$ Expr -> ModelExpr
expr Expr
e
expr (E.UnaryOp UFunc
u Expr
e)         = UFunc -> ModelExpr -> ModelExpr
UnaryOp (UFunc -> UFunc
uFunc UFunc
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpB UFuncB
u Expr
e)        = UFuncB -> ModelExpr -> ModelExpr
UnaryOpB (UFuncB -> UFuncB
uFuncB UFuncB
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpVV UFuncVV
u Expr
e)       = UFuncVV -> ModelExpr -> ModelExpr
UnaryOpVV (UFuncVV -> UFuncVV
uFuncVV UFuncVV
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpVN UFuncVN
u Expr
e)       = UFuncVN -> ModelExpr -> ModelExpr
UnaryOpVN (UFuncVN -> UFuncVN
uFuncVN UFuncVN
u) (Expr -> ModelExpr
expr Expr
e)
expr (E.ArithBinaryOp ArithBinOp
a Expr
l 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 BoolBinOp
b Expr
l 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 EqBinOp
e Expr
l 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 LABinOp
la Expr
l 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 OrdBinOp
o Expr
l 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 VVVBinOp
v Expr
l 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 VVNBinOp
v Expr
l Expr
r)   = VVNBinOp -> ModelExpr -> ModelExpr -> ModelExpr
VVNBinaryOp (VVNBinOp -> VVNBinOp
vvnBinOp VVNBinOp
v) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.NVVBinaryOp NVVBinOp
v Expr
l Expr
r)   = NVVBinOp -> ModelExpr -> ModelExpr -> ModelExpr
NVVBinaryOp (NVVBinOp -> NVVBinOp
nvvBinOp NVVBinOp
v) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.ESSBinaryOp ESSBinOp
o Expr
l Expr
r)   = ESSBinOp -> ModelExpr -> ModelExpr -> ModelExpr
ESSBinaryOp (ESSBinOp -> ESSBinOp
essBinOp ESSBinOp
o) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.ESBBinaryOp ESBBinOp
o Expr
l Expr
r)   = ESBBinOp -> ModelExpr -> ModelExpr -> ModelExpr
ESBBinaryOp (ESBBinOp -> ESBBinOp
esbBinOp ESBBinOp
o) (Expr -> ModelExpr
expr Expr
l) (Expr -> ModelExpr
expr Expr
r)
expr (E.Operator AssocArithOper
ao DiscreteDomainDesc Expr Expr
dd 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 UID
u 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 (Inclusive
li, Expr
l) (Inclusive
ri, 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 (Inclusive
i, 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 (Inclusive
i, 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 Symbol
s RTopology
rt Expr
l 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