{-# LANGUAGE GADTs #-}
module Drasil.Code.CodeExpr.Lang where
import Prelude hiding (sqrt)
import Control.Lens ((^.))
import Drasil.Database (UID, HasUID(..))
import Language.Drasil.Expr.Lang
(Completeness(..), ArithBinOp(..), EqBinOp(..),
LABinOp(..), OrdBinOp(..), EqBinOp(..),
VVVBinOp(..), VVNBinOp(..), NVVBinOp(..), ESSBinOp(..), ESBBinOp(..),
AssocArithOper(..), AssocBoolOper(..), AssocConcatOper(..),
UFunc(..), UFuncB(..), UFuncVV(..), UFuncVN(..))
import Language.Drasil.Expr.Class (ExprC(..), square)
import Language.Drasil.Literal.Class (LiteralC(..))
import Language.Drasil.Literal.Lang (Literal(..))
import Language.Drasil.Space (Space, RealInterval, DiscreteDomainDesc,
DomainDesc(BoundedDD), RTopology(..))
data CodeExpr where
Lit :: Literal -> CodeExpr
AssocA :: AssocArithOper -> [CodeExpr] -> CodeExpr
AssocB :: AssocBoolOper -> [CodeExpr] -> CodeExpr
AssocC :: AssocConcatOper -> [CodeExpr] -> CodeExpr
C :: UID -> CodeExpr
FCall :: UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
New :: UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
Message :: UID -> UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
Field :: UID -> UID -> CodeExpr
Case :: Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Matrix :: [[CodeExpr]] -> CodeExpr
Set :: Space -> [CodeExpr] -> CodeExpr
Variable :: String -> CodeExpr -> CodeExpr
UnaryOp :: UFunc -> CodeExpr -> CodeExpr
UnaryOpB :: UFuncB -> CodeExpr -> CodeExpr
UnaryOpVV :: UFuncVV -> CodeExpr -> CodeExpr
UnaryOpVN :: UFuncVN -> CodeExpr -> CodeExpr
ArithBinaryOp :: ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
EqBinaryOp :: EqBinOp -> CodeExpr -> CodeExpr -> CodeExpr
LABinaryOp :: LABinOp -> CodeExpr -> CodeExpr -> CodeExpr
OrdBinaryOp :: OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVVBinaryOp :: VVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVNBinaryOp :: VVNBinOp -> CodeExpr -> CodeExpr -> CodeExpr
NVVBinaryOp :: NVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ESSBinaryOp :: ESSBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ESBBinaryOp :: ESBBinOp -> CodeExpr -> CodeExpr -> CodeExpr
Operator :: AssocArithOper -> DiscreteDomainDesc CodeExpr CodeExpr -> CodeExpr -> CodeExpr
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
instance ExprC CodeExpr where
lit :: Literal -> CodeExpr
lit = Literal -> CodeExpr
Lit
$= :: CodeExpr -> CodeExpr -> CodeExpr
($=) = EqBinOp -> CodeExpr -> CodeExpr -> CodeExpr
EqBinaryOp EqBinOp
Eq
$!= :: CodeExpr -> CodeExpr -> CodeExpr
($!=) = EqBinOp -> CodeExpr -> CodeExpr -> CodeExpr
EqBinaryOp EqBinOp
NEq
$< :: CodeExpr -> CodeExpr -> CodeExpr
($<) = OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
OrdBinaryOp OrdBinOp
Lt
$> :: CodeExpr -> CodeExpr -> CodeExpr
($>) = OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
OrdBinaryOp OrdBinOp
Gt
$<= :: CodeExpr -> CodeExpr -> CodeExpr
($<=) = OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
OrdBinaryOp OrdBinOp
LEq
$>= :: CodeExpr -> CodeExpr -> CodeExpr
($>=) = OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
OrdBinaryOp OrdBinOp
GEq
$. :: CodeExpr -> CodeExpr -> CodeExpr
($.) = VVNBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVNBinaryOp VVNBinOp
Dot
$+ :: CodeExpr -> CodeExpr -> CodeExpr
($+) (Lit (Int Integer
0)) CodeExpr
r = CodeExpr
r
($+) CodeExpr
l (Lit (Int Integer
0)) = CodeExpr
l
($+) (Lit (Dbl Double
0)) CodeExpr
r = CodeExpr
r
($+) CodeExpr
l (Lit (Dbl Double
0)) = CodeExpr
l
($+) CodeExpr
l (Lit (ExactDbl Integer
0)) = CodeExpr
l
($+) (Lit (ExactDbl Integer
0)) CodeExpr
r = CodeExpr
r
($+) (AssocA AssocArithOper
Add [CodeExpr]
l) (AssocA AssocArithOper
Add [CodeExpr]
r) = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Add ([CodeExpr]
l [CodeExpr] -> [CodeExpr] -> [CodeExpr]
forall a. [a] -> [a] -> [a]
++ [CodeExpr]
r)
($+) (AssocA AssocArithOper
Add [CodeExpr]
l) CodeExpr
r = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Add ([CodeExpr]
l [CodeExpr] -> [CodeExpr] -> [CodeExpr]
forall a. [a] -> [a] -> [a]
++ [CodeExpr
r])
($+) CodeExpr
l (AssocA AssocArithOper
Add [CodeExpr]
r) = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Add (CodeExpr
l CodeExpr -> [CodeExpr] -> [CodeExpr]
forall a. a -> [a] -> [a]
: [CodeExpr]
r)
($+) CodeExpr
l CodeExpr
r = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Add [CodeExpr
l, CodeExpr
r]
$* :: CodeExpr -> CodeExpr -> CodeExpr
($*) (Lit (Int Integer
1)) CodeExpr
r = CodeExpr
r
($*) CodeExpr
l (Lit (Int Integer
1)) = CodeExpr
l
($*) (Lit (Dbl Double
1.0)) CodeExpr
r = CodeExpr
r
($*) CodeExpr
l (Lit (Dbl Double
1.0)) = CodeExpr
l
($*) CodeExpr
l (Lit (ExactDbl Integer
1)) = CodeExpr
l
($*) (Lit (ExactDbl Integer
1)) CodeExpr
r = CodeExpr
r
($*) (AssocA AssocArithOper
Mul [CodeExpr]
l) (AssocA AssocArithOper
Mul [CodeExpr]
r) = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Mul ([CodeExpr]
l [CodeExpr] -> [CodeExpr] -> [CodeExpr]
forall a. [a] -> [a] -> [a]
++ [CodeExpr]
r)
($*) (AssocA AssocArithOper
Mul [CodeExpr]
l) CodeExpr
r = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Mul ([CodeExpr]
l [CodeExpr] -> [CodeExpr] -> [CodeExpr]
forall a. [a] -> [a] -> [a]
++ [CodeExpr
r])
($*) CodeExpr
l (AssocA AssocArithOper
Mul [CodeExpr]
r) = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Mul (CodeExpr
l CodeExpr -> [CodeExpr] -> [CodeExpr]
forall a. a -> [a] -> [a]
: [CodeExpr]
r)
($*) CodeExpr
l CodeExpr
r = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
Mul [CodeExpr
l,CodeExpr
r]
$- :: CodeExpr -> CodeExpr -> CodeExpr
($-) = ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ArithBinaryOp ArithBinOp
Subt
$/ :: CodeExpr -> CodeExpr -> CodeExpr
($/) = ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ArithBinaryOp ArithBinOp
Frac
$^ :: CodeExpr -> CodeExpr -> CodeExpr
($^) = ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ArithBinaryOp ArithBinOp
Pow
CodeExpr
a $&& :: CodeExpr -> CodeExpr -> CodeExpr
$&& CodeExpr
b = AssocBoolOper -> [CodeExpr] -> CodeExpr
AssocB AssocBoolOper
And [CodeExpr
a, CodeExpr
b]
CodeExpr
a $|| :: CodeExpr -> CodeExpr -> CodeExpr
$|| CodeExpr
b = AssocBoolOper -> [CodeExpr] -> CodeExpr
AssocB AssocBoolOper
Or [CodeExpr
a, CodeExpr
b]
in' :: CodeExpr -> CodeExpr -> CodeExpr
in' = ESBBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ESBBinaryOp ESBBinOp
SContains
abs_ :: CodeExpr -> CodeExpr
abs_ = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Abs
neg :: CodeExpr -> CodeExpr
neg = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Neg
log :: CodeExpr -> CodeExpr
log = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Log
ln :: CodeExpr -> CodeExpr
ln = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Ln
sqrt :: CodeExpr -> CodeExpr
sqrt = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Sqrt
sin :: CodeExpr -> CodeExpr
sin = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Sin
cos :: CodeExpr -> CodeExpr
cos = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Cos
tan :: CodeExpr -> CodeExpr
tan = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Tan
sec :: CodeExpr -> CodeExpr
sec = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Sec
csc :: CodeExpr -> CodeExpr
csc = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Csc
cot :: CodeExpr -> CodeExpr
cot = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Cot
arcsin :: CodeExpr -> CodeExpr
arcsin = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Arcsin
arccos :: CodeExpr -> CodeExpr
arccos = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Arccos
arctan :: CodeExpr -> CodeExpr
arctan = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Arctan
exp :: CodeExpr -> CodeExpr
exp = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
Exp
dim :: CodeExpr -> CodeExpr
dim = UFuncVN -> CodeExpr -> CodeExpr
UnaryOpVN UFuncVN
Dim
norm :: CodeExpr -> CodeExpr
norm = UFuncVN -> CodeExpr -> CodeExpr
UnaryOpVN UFuncVN
Norm
negVec :: CodeExpr -> CodeExpr
negVec = UFuncVV -> CodeExpr -> CodeExpr
UnaryOpVV UFuncVV
NegV
vScale :: CodeExpr -> CodeExpr -> CodeExpr
vScale = NVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
NVVBinaryOp NVVBinOp
Scale
not_ :: CodeExpr -> CodeExpr
not_ = UFuncB -> CodeExpr -> CodeExpr
UnaryOpB UFuncB
Not
idx :: CodeExpr -> CodeExpr -> CodeExpr
idx = LABinOp -> CodeExpr -> CodeExpr -> CodeExpr
LABinaryOp LABinOp
Index
idxOf :: CodeExpr -> CodeExpr -> CodeExpr
idxOf = LABinOp -> CodeExpr -> CodeExpr -> CodeExpr
LABinaryOp LABinOp
IndexOf
defint :: Symbol -> CodeExpr -> CodeExpr -> CodeExpr -> CodeExpr
defint Symbol
v CodeExpr
low CodeExpr
high = AssocArithOper
-> DiscreteDomainDesc CodeExpr CodeExpr -> CodeExpr -> CodeExpr
Operator AssocArithOper
Add (Symbol
-> RTopology
-> CodeExpr
-> CodeExpr
-> DiscreteDomainDesc CodeExpr CodeExpr
forall a b.
Symbol -> RTopology -> a -> b -> DomainDesc 'Discrete a b
BoundedDD Symbol
v RTopology
Continuous CodeExpr
low CodeExpr
high)
defsum :: Symbol -> CodeExpr -> CodeExpr -> CodeExpr -> CodeExpr
defsum Symbol
v CodeExpr
low CodeExpr
high = AssocArithOper
-> DiscreteDomainDesc CodeExpr CodeExpr -> CodeExpr -> CodeExpr
Operator AssocArithOper
Add (Symbol
-> RTopology
-> CodeExpr
-> CodeExpr
-> DiscreteDomainDesc CodeExpr CodeExpr
forall a b.
Symbol -> RTopology -> a -> b -> DomainDesc 'Discrete a b
BoundedDD Symbol
v RTopology
Discrete CodeExpr
low CodeExpr
high)
defprod :: Symbol -> CodeExpr -> CodeExpr -> CodeExpr -> CodeExpr
defprod Symbol
v CodeExpr
low CodeExpr
high = AssocArithOper
-> DiscreteDomainDesc CodeExpr CodeExpr -> CodeExpr -> CodeExpr
Operator AssocArithOper
Mul (Symbol
-> RTopology
-> CodeExpr
-> CodeExpr
-> DiscreteDomainDesc CodeExpr CodeExpr
forall a b.
Symbol -> RTopology -> a -> b -> DomainDesc 'Discrete a b
BoundedDD Symbol
v RTopology
Discrete CodeExpr
low CodeExpr
high)
realInterval :: forall c.
HasUID c =>
c -> RealInterval CodeExpr CodeExpr -> CodeExpr
realInterval c
c = UID -> RealInterval CodeExpr CodeExpr -> CodeExpr
RealI (c
c c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid)
euclidean :: [CodeExpr] -> CodeExpr
euclidean = CodeExpr -> CodeExpr
forall r. ExprC r => r -> r
sqrt (CodeExpr -> CodeExpr)
-> ([CodeExpr] -> CodeExpr) -> [CodeExpr] -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeExpr -> CodeExpr -> CodeExpr) -> [CodeExpr] -> CodeExpr
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
($+) ([CodeExpr] -> CodeExpr)
-> ([CodeExpr] -> [CodeExpr]) -> [CodeExpr] -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
forall r. (ExprC r, LiteralC r) => r -> r
square
cross :: CodeExpr -> CodeExpr -> CodeExpr
cross = VVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVVBinaryOp VVVBinOp
Cross
vAdd :: CodeExpr -> CodeExpr -> CodeExpr
vAdd = VVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVVBinaryOp VVVBinOp
VAdd
vSub :: CodeExpr -> CodeExpr -> CodeExpr
vSub = VVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVVBinaryOp VVVBinOp
VSub
completeCase :: [(CodeExpr, CodeExpr)] -> CodeExpr
completeCase = Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
Complete
incompleteCase :: [(CodeExpr, CodeExpr)] -> CodeExpr
incompleteCase = Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
Incomplete
matrix :: [[CodeExpr]] -> CodeExpr
matrix = [[CodeExpr]] -> CodeExpr
Matrix
set' :: Space -> [CodeExpr] -> CodeExpr
set' = Space -> [CodeExpr] -> CodeExpr
Set
apply :: forall f. (HasUID f, HasSymbol f) => f -> [CodeExpr] -> CodeExpr
apply f
f [] = f -> CodeExpr
forall c. (HasUID c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy f
f
apply f
f [CodeExpr]
ps = UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
FCall (f
f f -> Getting UID f UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID f UID
forall c. HasUID c => Getter c UID
Getter f UID
uid) [CodeExpr]
ps []
sy :: forall c. (HasUID c, HasSymbol c) => c -> CodeExpr
sy c
x = UID -> CodeExpr
C (c
x c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid)