{-# 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

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

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
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
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
u (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpB UFuncB
u Expr
e)        = UFuncB -> ModelExpr -> ModelExpr
UnaryOpB UFuncB
u (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpVV UFuncVV
u Expr
e)       = UFuncVV -> ModelExpr -> ModelExpr
UnaryOpVV UFuncVV
u (Expr -> ModelExpr
expr Expr
e)
expr (E.UnaryOpVN UFuncVN
u Expr
e)       = UFuncVN -> ModelExpr -> ModelExpr
UnaryOpVN UFuncVN
u (Expr -> ModelExpr
expr Expr
e)
expr (E.ArithBinaryOp ArithBinOp
a Expr
l Expr
r) = ArithBinOp -> ModelExpr -> ModelExpr -> ModelExpr
ArithBinaryOp ArithBinOp
a (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
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
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
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
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
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
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
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
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
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