module Language.Fortran.Vars.Eval.Deprecated where
import Language.Fortran.Vars.Eval.Deprecated.Operation
import Language.Fortran.Vars.Rep
import Language.Fortran.Vars.Types.SymbolTable
import Language.Fortran.AST
import Language.Fortran.Util.Position ( getSpan )
import qualified Data.Map as Map
eval' :: SymbolTable -> Expression a -> Either String ExpVal
eval' :: forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable = \case
ExpValue a
_ SrcSpan
_ (ValVariable String
name) -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name SymbolTable
symTable of
Just (SParameter Type
_ ExpVal
expVal) -> forall a b. b -> Either a b
Right ExpVal
expVal
Just SymbolTableEntry
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Cannot be evaluated: " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" is not a parameter."
Maybe SymbolTableEntry
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Cannot find parameter : " forall a. [a] -> [a] -> [a]
++ String
name
ExpValue a
_ SrcSpan
s Value a
val -> forall a. SrcSpan -> Value a -> Either String ExpVal
valueToExpVal' SrcSpan
s Value a
val
ExpUnary a
_ SrcSpan
_ UnaryOp
op Expression a
e -> forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither (UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' UnaryOp
op) forall a b. (a -> b) -> a -> b
$ forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable Expression a
e
ExpBinary a
_ SrcSpan
_ BinaryOp
op Expression a
e1 Expression a
e2 ->
forall a b.
(a -> a -> Either String b)
-> Either String a -> Either String a -> Either String b
binaryTransformEither (BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
op) (forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable Expression a
e1) (forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable Expression a
e2)
ExpFunctionCall a
_ SrcSpan
_ (ExpValue a
_ SrcSpan
_ Value a
function) (AList a
_ SrcSpan
_ [Argument a]
args) ->
forall a b.
([a] -> Either String b) -> [Either String a] -> Either String b
transformEitherList [ExpVal] -> Either String ExpVal
intrinsicFunctionCall'
forall a b. (a -> b) -> a -> b
$ forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Argument a -> Expression a
argExtractExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Argument a]
args
where
intrinsicFunctionCall' :: [ExpVal] -> Either String ExpVal
intrinsicFunctionCall' = String -> [ExpVal] -> Either String ExpVal
intrinsicFunctionCall forall a b. (a -> b) -> a -> b
$ forall {a}. Value a -> String
functionName Value a
function
functionName :: Value a -> String
functionName (ValVariable String
name) = String
name
functionName (ValIntrinsic String
name) = String
name
functionName Value a
_ = String
""
Expression a
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unsupported expression at: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Spanned a => a -> SrcSpan
getSpan Expression a
e)
eval :: SymbolTable -> Expression a -> ExpVal
eval :: forall a. SymbolTable -> Expression a -> ExpVal
eval SymbolTable
symTable Expression a
expr = case forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable Expression a
expr of
Left String
err -> forall a. HasCallStack => String -> a
error (String
err forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Spanned a => a -> SrcSpan
getSpan Expression a
expr))
Right ExpVal
r -> ExpVal
r
evalWithShortcircuit :: SymbolTable -> Expression a -> Either String ExpVal
evalWithShortcircuit :: forall a. SymbolTable -> Expression a -> Either String ExpVal
evalWithShortcircuit SymbolTable
symTable Expression a
expr = case Expression a
expr of
ExpUnary a
_ SrcSpan
_ UnaryOp
op Expression a
e ->
forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither (UnaryOp -> ExpVal -> Either String ExpVal
unaryOp' UnaryOp
op) forall a b. (a -> b) -> a -> b
$ forall a. SymbolTable -> Expression a -> Either String ExpVal
evalWithShortcircuit SymbolTable
symTable Expression a
e
ExpBinary a
_ SrcSpan
_ BinaryOp
op Expression a
e1 Expression a
e2 ->
let e1' :: Either String ExpVal
e1' = forall a. SymbolTable -> Expression a -> Either String ExpVal
evalWithShortcircuit SymbolTable
symTable Expression a
e1
e2' :: Either String ExpVal
e2' = forall a. SymbolTable -> Expression a -> Either String ExpVal
evalWithShortcircuit SymbolTable
symTable Expression a
e2
t :: Either String ExpVal -> Either String Bool
t = forall a b.
(a -> Either String b) -> Either String a -> Either String b
transformEither ExpVal -> Either String Bool
nonLogicalToLogical
in case (BinaryOp
op, Either String ExpVal -> Either String Bool
t Either String ExpVal
e1', Either String ExpVal -> Either String Bool
t Either String ExpVal
e2') of
(BinaryOp
And, Right Bool
r , Right Bool
l ) -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ExpVal
Logical forall a b. (a -> b) -> a -> b
$ Bool
r Bool -> Bool -> Bool
&& Bool
l
(BinaryOp
And, Right Bool
False, Either String Bool
_ ) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical Bool
False
(BinaryOp
And, Either String Bool
_ , Right Bool
False) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical Bool
False
(BinaryOp
Or , Right Bool
r , Right Bool
l ) -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ExpVal
Logical forall a b. (a -> b) -> a -> b
$ Bool
r Bool -> Bool -> Bool
|| Bool
l
(BinaryOp
Or , Right Bool
True , Either String Bool
_ ) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical Bool
True
(BinaryOp
Or , Either String Bool
_ , Right Bool
True ) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
Logical Bool
True
(BinaryOp, Either String Bool, Either String Bool)
_ -> forall a b.
(a -> a -> Either String b)
-> Either String a -> Either String a -> Either String b
binaryTransformEither (BinaryOp -> ExpVal -> ExpVal -> Either String ExpVal
binaryOp' BinaryOp
op) Either String ExpVal
e1' Either String ExpVal
e2'
Expression a
_ -> forall a. SymbolTable -> Expression a -> Either String ExpVal
eval' SymbolTable
symTable Expression a
expr