module Language.Fortran.Vars.Eval.Deprecated.Operation
( valueToExpVal'
, valueToExpVal
, transformEither
, transformEitherList
, binaryTransformEither
, unaryOp'
, unaryOp
, binaryOp'
, binaryOp
, intrinsicFunctionCall
, nonLogicalToLogical
)
where
import Prelude hiding ( GT
, EQ
, LT
)
import Data.Char ( chr )
import Language.Fortran.AST ( BinaryOp(..)
, UnaryOp(..)
, Value(..)
)
import Language.Fortran.AST.Literal.Real ( readRealLit )
import Language.Fortran.Util.Position ( SrcSpan )
import Language.Fortran.Vars.BozConstant
( bozToInt8
, bozToInt
)
import Language.Fortran.Vars.Errors ( invalidArg' )
import Language.Fortran.Vars.Types ( ExpVal(..) )
import Data.Bits ( (.|.)
, complement
)
transformEither :: (a -> Either String b) -> Either String a -> Either String b
transformEither :: forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left
{-# INLINABLE transformEither #-}
binaryTransformEither
:: (a -> a -> Either String b)
-> Either String a
-> Either String a
-> Either String b
binaryTransformEither :: forall a b.
(a -> a -> Either String b)
-> Either String a -> Either String a -> Either String b
binaryTransformEither a -> a -> Either String b
_ (Left String
e) Either String a
_ = forall a b. a -> Either a b
Left String
e
binaryTransformEither a -> a -> Either String b
_ Either String a
_ (Left String
e ) = forall a b. a -> Either a b
Left String
e
binaryTransformEither a -> a -> Either String b
t (Right a
v1) (Right a
v2) = a -> a -> Either String b
t a
v1 a
v2
transformEitherList
:: ([a] -> Either String b) -> [Either String a] -> Either String b
transformEitherList :: forall a b.
([a] -> Either String b) -> [Either String a] -> Either String b
transformEitherList [a] -> Either String b
t [Either String a]
el = case forall a. [Either String a] -> Either String [a]
eitherListToList [Either String a]
el of
Left String
l -> forall a b. a -> Either a b
Left String
l
Right [a]
rs -> [a] -> Either String b
t [a]
rs
where
eitherListToList :: [Either String a] -> Either String [a]
eitherListToList :: forall a. [Either String a] -> Either String [a]
eitherListToList [] = forall a b. b -> Either a b
Right []
eitherListToList (Left String
l : [Either String a]
_ ) = forall a b. a -> Either a b
Left String
l
eitherListToList (Right a
r : [Either String a]
rs) = case forall a. [Either String a] -> Either String [a]
eitherListToList [Either String a]
rs of
Left String
l -> forall a b. a -> Either a b
Left String
l
Right [a]
rs' -> forall a b. b -> Either a b
Right (a
r forall a. a -> [a] -> [a]
: [a]
rs')
valueToExpVal' :: SrcSpan -> Value a -> Either String ExpVal
valueToExpVal' :: forall a. SrcSpan -> Value a -> Either String ExpVal
valueToExpVal' SrcSpan
s Value a
val = case Value a
val of
ValInteger String
i Maybe (KindParam a)
_ -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
i
ValReal RealLit
r Maybe (KindParam a)
_ -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real forall a b. (a -> b) -> a -> b
$ forall a. (Fractional a, Read a) => RealLit -> a
readRealLit RealLit
r
ValLogical Bool
l Maybe (KindParam a)
_ -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical Bool
l
ValString String
s' -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> ExpVal
Str String
s'
ValHollerith String
h -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> ExpVal
Str String
h
ValBoz Boz
b -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Boz -> ExpVal
Boz Boz
b
Value a
_ -> forall a b. a -> Either a b
Left (String
"toExpVal: unsupported value at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SrcSpan
s)
valueToExpVal :: SrcSpan -> Value a -> ExpVal
valueToExpVal :: forall a. SrcSpan -> Value a -> ExpVal
valueToExpVal SrcSpan
s Value a
val = case forall a. SrcSpan -> Value a -> Either String ExpVal
valueToExpVal' SrcSpan
s Value a
val of
Left String
err -> forall a. HasCallStack => String -> a
error String
err
Right ExpVal
expr -> ExpVal
expr
nonLogicalToLogical :: ExpVal -> Either String Bool
nonLogicalToLogical :: ExpVal -> Either String Bool
nonLogicalToLogical (Int Int
i) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int
i forall a. Eq a => a -> a -> Bool
/= Int
0
nonLogicalToLogical (Real Double
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double
r forall a. Eq a => a -> a -> Bool
/= Double
0.0
nonLogicalToLogical (Str String
_) =
forall a b. a -> Either a b
Left String
"Cannot transform a string value to a logical value"
nonLogicalToLogical (Logical Bool
l) = forall a b. b -> Either a b
Right Bool
l
nonLogicalToLogical (Boz Boz
b) = ExpVal -> Either String Bool
nonLogicalToLogical forall a b. (a -> b) -> a -> b
$ Boz -> ExpVal
bozToInt8 Boz
b
intrinsicFunctionCall :: String -> [ExpVal] -> Either String ExpVal
intrinsicFunctionCall :: String -> [ExpVal] -> Either String ExpVal
intrinsicFunctionCall String
function [ExpVal]
es = case String
function of
String
"ior" -> [ExpVal] -> Either String ExpVal
ior' [ExpVal]
es
String
"max" -> [ExpVal] -> Either String ExpVal
max' [ExpVal]
es
String
"char" -> [ExpVal] -> Either String ExpVal
char' [ExpVal]
es
String
"not" -> [ExpVal] -> Either String ExpVal
not' [ExpVal]
es
String
"int" -> [ExpVal] -> Either String ExpVal
int' [ExpVal]
es
String
"int2" -> [ExpVal] -> Either String ExpVal
int' [ExpVal]
es
String
_ -> forall a b. Show a => String -> [a] -> Either String b
invalidArg' (String
"intrinsicFunctionCall " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
function) [ExpVal]
es
ior' :: [ExpVal] -> Either String ExpVal
ior' :: [ExpVal] -> Either String ExpVal
ior' [ExpVal
val1, ExpVal
val2] = case (ExpVal
val1, ExpVal
val2) of
(Int Int
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> a -> a
(.|.) Int
a Int
b
(ExpVal, ExpVal)
_ -> forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"ior" [ExpVal
val1, ExpVal
val2]
ior' [ExpVal]
vs = forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"ior" [ExpVal]
vs
max' :: [ExpVal] -> Either String ExpVal
max' :: [ExpVal] -> Either String ExpVal
max' [ExpVal
val1] = case ExpVal
val1 of
Real Double
a -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real Double
a
Int Int
a -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int Int
a
ExpVal
_ -> forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"max" [ExpVal
val1]
max' (ExpVal
v : [ExpVal]
vs) =
let maxVs :: Either String ExpVal
maxVs = [ExpVal] -> Either String ExpVal
max' [ExpVal]
vs
in case (ExpVal
v, Either String ExpVal
maxVs) of
(ExpVal
_ , Left String
l ) -> forall a b. a -> Either a b
Left String
l
(Real Double
r', Right (Int Int
r) ) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Double
r' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)
(Int Int
r', Right (Real Double
r)) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r') Double
r
(Real Double
r', Right (Real Double
r)) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Double
r' Double
r
(Int Int
r', Right (Int Int
r) ) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
r' Int
r
(ExpVal, Either String ExpVal)
_ -> forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"max" (ExpVal
v forall a. a -> [a] -> [a]
: [ExpVal]
vs)
max' [ExpVal]
vs = forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"max" [ExpVal]
vs
char' :: [ExpVal] -> Either String ExpVal
char' :: [ExpVal] -> Either String ExpVal
char' [Int Int
i] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> ExpVal
Str [Int -> Char
chr Int
i]
char' [ExpVal]
vs = forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"char" [ExpVal]
vs
not' :: [ExpVal] -> Either String ExpVal
not' :: [ExpVal] -> Either String ExpVal
not' [Int Int
i] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (forall a. Bits a => a -> a
complement Int
i)
not' [ExpVal]
vs = forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"not" [ExpVal]
vs
int' :: [ExpVal] -> Either String ExpVal
int' :: [ExpVal] -> Either String ExpVal
int' [Int Int
i] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int Int
i
int' [Real Double
r] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
r)
int' v :: [ExpVal]
v@[(Boz Boz
boz), Int Int
k] =
if Int
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
2, Int
4, Int
8] then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> Boz -> ExpVal
bozToInt Int
k Boz
boz else forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"int" [ExpVal]
v
int' [ExpVal]
vs = forall a b. Show a => String -> [a] -> Either String b
invalidArg' String
"int" [ExpVal]
vs
unaryOp' :: UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' :: UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' UnaryOp
op ExpVal
v = case (UnaryOp
op, ExpVal
v) of
(UnaryOp
Plus , Int Int
a ) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int Int
a
(UnaryOp
Plus , Real Double
a) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real Double
a
(UnaryOp
Minus, Int Int
a ) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (forall a. Num a => a -> a
negate Int
a)
(UnaryOp
Minus, Real Double
a) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (forall a. Num a => a -> a
negate Double
a)
(UnaryOp
Not, ExpVal
a) -> forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ExpVal
Logical forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not) forall a b. (a -> b) -> a -> b
$ ExpVal -> Either String Bool
nonLogicalToLogical ExpVal
a
(UnaryOp, ExpVal)
_ -> forall a b. Show a => String -> [a] -> Either String b
invalidArg' (forall a. Show a => a -> String
show UnaryOp
op) [ExpVal
v]
unaryOp :: UnaryOp -> ExpVal -> ExpVal
unaryOp :: UnaryOp -> ExpVal -> ExpVal
unaryOp UnaryOp
op ExpVal
v = case UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' UnaryOp
op ExpVal
v of
Left String
err -> forall a. HasCallStack => String -> a
error String
err
Right ExpVal
expr -> ExpVal
expr
binaryOp' :: BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' :: BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
op ExpVal
val1 ExpVal
val2 = case (BinaryOp
op, ExpVal
val1, ExpVal
val2) of
(BinaryOp
Addition, Int Int
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (Int
a forall a. Num a => a -> a -> a
+ Int
b)
(BinaryOp
Addition, Real Double
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Num a => a -> a -> a
+ Double
b)
(BinaryOp
Addition, Int Int
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Num a => a -> a -> a
+ Double
b)
(BinaryOp
Addition, Real Double
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
(BinaryOp
Subtraction, Int Int
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (Int
a forall a. Num a => a -> a -> a
- Int
b)
(BinaryOp
Subtraction, Real Double
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Num a => a -> a -> a
- Double
b)
(BinaryOp
Subtraction, Int Int
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Num a => a -> a -> a
- Double
b)
(BinaryOp
Subtraction, Real Double
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
(BinaryOp
Multiplication, Int Int
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (Int
a forall a. Num a => a -> a -> a
* Int
b)
(BinaryOp
Multiplication, Real Double
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Num a => a -> a -> a
* Double
b)
(BinaryOp
Multiplication, Int Int
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Num a => a -> a -> a
* Double
b)
(BinaryOp
Multiplication, Real Double
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
(BinaryOp
Division, Int Int
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (forall a. Integral a => a -> a -> a
div Int
a Int
b)
(BinaryOp
Division, Real Double
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Fractional a => a -> a -> a
/ Double
b)
(BinaryOp
Division, Int Int
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Fractional a => a -> a -> a
/ Double
b)
(BinaryOp
Division, Real Double
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
(BinaryOp
Exponentiation, Int Int
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
Int (Int
a forall a b. (Num a, Integral b) => a -> b -> a
^ Int
b)
(BinaryOp
Exponentiation, Real Double
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Floating a => a -> a -> a
** Double
b)
(BinaryOp
Exponentiation, Int Int
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Floating a => a -> a -> a
** Double
b)
(BinaryOp
Exponentiation, Real Double
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
Real (Double
a forall a. Floating a => a -> a -> a
** forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
(BinaryOp
Concatenation, Str String
a, Str String
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> ExpVal
Str (String
a forall a. [a] -> [a] -> [a]
++ String
b)
(BinaryOp
LT, Int Int
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Int
a forall a. Ord a => a -> a -> Bool
< Int
b)
(BinaryOp
LT, Real Double
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Double
a forall a. Ord a => a -> a -> Bool
< Double
b)
(BinaryOp
LT, Int Int
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Ord a => a -> a -> Bool
< Double
b)
(BinaryOp
LT, Real Double
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Double
a forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
(BinaryOp
LT, Boz Boz
boz, ExpVal
b) -> BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
LT (Boz -> ExpVal
bozToInt8 Boz
boz) ExpVal
b
(BinaryOp
LT, ExpVal
a, Boz Boz
boz) -> BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
LT ExpVal
a (Boz -> ExpVal
bozToInt8 Boz
boz)
(BinaryOp
EQ, Int Int
a, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Eq a => a -> a -> Bool
== Double
b)
(BinaryOp
EQ, Real Double
a, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Double
a forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
(BinaryOp
EQ, Boz Boz
boz, ExpVal
b) -> BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
EQ (Boz -> ExpVal
bozToInt8 Boz
boz) ExpVal
b
(BinaryOp
EQ, ExpVal
a, Boz Boz
boz) -> BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
EQ ExpVal
a (Boz -> ExpVal
bozToInt8 Boz
boz)
(BinaryOp
EQ, Logical Bool
True, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Int
1 forall a. Eq a => a -> a -> Bool
== Int
b)
(BinaryOp
EQ, Logical Bool
False, Int Int
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Int
0 forall a. Eq a => a -> a -> Bool
== Int
b)
(BinaryOp
EQ, Int Int
a, Logical Bool
True) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Int
a forall a. Eq a => a -> a -> Bool
== Int
1)
(BinaryOp
EQ, Int Int
a, Logical Bool
False) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Int
a forall a. Eq a => a -> a -> Bool
== Int
0)
(BinaryOp
EQ, Logical Bool
True, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Double
1.0 forall a. Eq a => a -> a -> Bool
== Double
b)
(BinaryOp
EQ, Logical Bool
False, Real Double
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Double
0.0 forall a. Eq a => a -> a -> Bool
== Double
b)
(BinaryOp
EQ, Real Double
a, Logical Bool
True) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Double
a forall a. Eq a => a -> a -> Bool
== Double
1.0)
(BinaryOp
EQ, Real Double
a, Logical Bool
False) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Double
a forall a. Eq a => a -> a -> Bool
== Double
0.0)
(BinaryOp
EQ, ExpVal
v1, ExpVal
v2) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (ExpVal
v1 forall a. Eq a => a -> a -> Bool
== ExpVal
v2)
(BinaryOp
GT, ExpVal
v1, ExpVal
v2) -> BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
LT ExpVal
v2 ExpVal
v1
(BinaryOp
GTE, ExpVal
v1, ExpVal
v2) -> forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither (UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' UnaryOp
Not) forall a b. (a -> b) -> a -> b
$ BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
LT ExpVal
v2 ExpVal
v1
(BinaryOp
LTE, ExpVal
v1, ExpVal
v2) -> forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither (UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' UnaryOp
Not) forall a b. (a -> b) -> a -> b
$ BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
GT ExpVal
v2 ExpVal
v1
(BinaryOp
NE, ExpVal
v1, ExpVal
v2) -> forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither (UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' UnaryOp
Not) forall a b. (a -> b) -> a -> b
$ BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
EQ ExpVal
v1 ExpVal
v2
(BinaryOp
And, ExpVal
v1, ExpVal
v2) ->
forall a b.
(a -> a -> Either String b)
-> Either String a -> Either String a -> Either String b
binaryTransformEither (\Bool
x -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ExpVal
Logical forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
x Bool -> Bool -> Bool
&&))
(ExpVal -> Either String Bool
nonLogicalToLogical ExpVal
v1)
forall a b. (a -> b) -> a -> b
$ ExpVal -> Either String Bool
nonLogicalToLogical ExpVal
v2
(BinaryOp
Or, ExpVal
v1, ExpVal
v2) ->
forall a b.
(a -> a -> Either String b)
-> Either String a -> Either String a -> Either String b
binaryTransformEither (\Bool
x -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ExpVal
Logical forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
x Bool -> Bool -> Bool
||))
(ExpVal -> Either String Bool
nonLogicalToLogical ExpVal
v1)
forall a b. (a -> b) -> a -> b
$ ExpVal -> Either String Bool
nonLogicalToLogical ExpVal
v2
(BinaryOp
XOr, Logical Bool
a, Logical Bool
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Bool
a forall a. Eq a => a -> a -> Bool
/= Bool
b)
(BinaryOp
Equivalent, Logical Bool
a, Logical Bool
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Bool
a forall a. Eq a => a -> a -> Bool
== Bool
b)
(BinaryOp
NotEquivalent, Logical Bool
a, Logical Bool
b) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical (Bool
a forall a. Eq a => a -> a -> Bool
/= Bool
b)
(BinaryOp, ExpVal, ExpVal)
_ -> forall a b. Show a => String -> [a] -> Either String b
invalidArg' (forall a. Show a => a -> String
show BinaryOp
op) [ExpVal
val1, ExpVal
val2]
binaryOp :: BinaryOp -> ExpVal -> ExpVal -> ExpVal
binaryOp :: BinaryOp -> ExpVal -> ExpVal -> ExpVal
binaryOp BinaryOp
op ExpVal
val1 ExpVal
val2 = case BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
op ExpVal
val1 ExpVal
val2 of
Left String
err -> forall a. HasCallStack => String -> a
error String
err
Right ExpVal
expr -> ExpVal
expr