{- | TODO -}

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

-- | Given a 'SymbolTable' and some 'Expression', evaluate that expression
-- into a basic type and return it as an 'ExpVal' or a 'String' describing
-- the issue that prevented the evaluation
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)

-- | Given a 'SymbolTable' and some 'Expression', evaluate that expression
-- into a basic type and return it as an 'ExpVal'
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

-- | Given a 'SymbolTable' and some 'Expression', evaluate that expression
-- into a basic type and return it as an 'ExpVal' or a 'String' describing
-- the issue that prevented the evaluation. In the case of expressions like
--
-- @
--       foobar .AND. .FALSE.
--       .TRUE. .OR. .foobar
-- @
--
-- the expressions will be shortcircuited to produce
--
-- @
--       .FALSE.
--       .TRUE.
-- @
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