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
                                                )

-- | Given a function that returns an 'Either' and an 'Either' with
-- the 'Right' case as the same type input to the function, return
-- an either by possibly applying the function to the 'Right' value or
-- propagating the 'Left' case
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 #-}

-- | Given a function that takes two arguments of the same type and returns an
-- 'Either' as well as two 'Either's whose 'Right' cases hold the inputs to the
-- function, apply the function if possible. Otherwise propagate the 'Left' cases
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

-- | Given a function that takes a list of arguments of the same type and returns an
-- 'Either' as well as a list of 'Either's whose 'Right' cases hold the inputs to the
-- function, apply the function if possible. Otherwise propagate the 'Left' cases
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')

-- | Given a 'SrcSpan' and the 'Value' in that span either
-- return a 'String' describing the issue or the 'ExpVal' held
-- by that 'Value'.
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)

-- | Given a 'SrcSpan' and the 'Value' returnthe 'ExpVal' held
-- by that 'Value' or throw an error.
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

-- | Given a non-logical 'ExpVal', convert that value to a logical
-- one or return a 'String' describing why this was impossible.
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

-- | Given a string representing a function call and a list of ExpVal
-- values holding inputs to the function, evaluate the function call
-- and return the result in a Right, or propagate the Left case if any
-- of the list elements are 'Lefts'.
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

-- https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc8/index.html
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

-- | Given a 'UnaryOp' and an 'ExpVal', either return the resulting
-- 'ExpVal' after applying the operation or a 'String' describing
-- why this couldn't be done
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]

-- | Given a 'UnaryOp' and an 'ExpVal', either return the resulting
-- 'ExpVal' after applying the operation or throw an error
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

-- | Given a 'BinaryOp' and two 'ExpVal's, either return the resulting
-- 'ExpVal' after applying the operation or a 'String' describing
-- why this couldn't be done
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]

-- | Given a 'BinaryOp' and two 'ExpVal's, either return the resulting
-- 'ExpVal' after applying the operation or throw an error
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