{- | fortran-vars-style expression evaluation which piggybacks off the evaluator
     in fortran-src.
-}

{-# LANGUAGE DerivingVia #-}

module Language.Fortran.Vars.Eval.FortranSrc
  ( module Language.Fortran.Vars.Eval.FortranSrc
  , module Language.Fortran.Vars.Eval.FortranSrc.Translate
  ) where

import Language.Fortran.Vars.Eval.FortranSrc.Translate

import Language.Fortran.Vars.Types.SymbolTable

import qualified Language.Fortran.Repr as FS.Rep
import qualified Language.Fortran.Repr.Eval.Common as FS.Eval
import qualified Language.Fortran.Repr.Eval.Value as FS.Eval

import Control.Monad.Reader
import Control.Monad.Except

import qualified Data.Map as Map

-- | Fortran expression evaluation monad, using 'SymbolTable' and reporting
--   fortran-src evaluator errors.
--
-- We use a newtype wrapper on this at 'Eval'. The type synonym assists some
-- boilerplate.
type Eval' = ExceptT FS.Eval.Error (Reader SymbolTable)

-- | Fortran expression evaluation monad, using 'SymbolTable' and reporting
--   fortran-src evaluator errors.
newtype Eval a = Eval { forall a. Eval a -> Eval' a
unEval :: Eval' a }
    deriving (forall a b. a -> Eval b -> Eval a
forall a b. (a -> b) -> Eval a -> Eval b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Eval b -> Eval a
$c<$ :: forall a b. a -> Eval b -> Eval a
fmap :: forall a b. (a -> b) -> Eval a -> Eval b
$cfmap :: forall a b. (a -> b) -> Eval a -> Eval b
Functor, Functor Eval
forall a. a -> Eval a
forall a b. Eval a -> Eval b -> Eval a
forall a b. Eval a -> Eval b -> Eval b
forall a b. Eval (a -> b) -> Eval a -> Eval b
forall a b c. (a -> b -> c) -> Eval a -> Eval b -> Eval c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Eval a -> Eval b -> Eval a
$c<* :: forall a b. Eval a -> Eval b -> Eval a
*> :: forall a b. Eval a -> Eval b -> Eval b
$c*> :: forall a b. Eval a -> Eval b -> Eval b
liftA2 :: forall a b c. (a -> b -> c) -> Eval a -> Eval b -> Eval c
$cliftA2 :: forall a b c. (a -> b -> c) -> Eval a -> Eval b -> Eval c
<*> :: forall a b. Eval (a -> b) -> Eval a -> Eval b
$c<*> :: forall a b. Eval (a -> b) -> Eval a -> Eval b
pure :: forall a. a -> Eval a
$cpure :: forall a. a -> Eval a
Applicative, Applicative Eval
forall a. a -> Eval a
forall a b. Eval a -> Eval b -> Eval b
forall a b. Eval a -> (a -> Eval b) -> Eval b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Eval a
$creturn :: forall a. a -> Eval a
>> :: forall a b. Eval a -> Eval b -> Eval b
$c>> :: forall a b. Eval a -> Eval b -> Eval b
>>= :: forall a b. Eval a -> (a -> Eval b) -> Eval b
$c>>= :: forall a b. Eval a -> (a -> Eval b) -> Eval b
Monad) via Eval'
    deriving (MonadReader SymbolTable) via Eval'
    deriving (MonadError FS.Eval.Error) via Eval'

-- | Execute a program in the Fortran expression evaluation monad 'Eval'.
runEval :: SymbolTable -> Eval a -> Either FS.Eval.Error a
runEval :: forall a. SymbolTable -> Eval a -> Either Error a
runEval SymbolTable
symt = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r a. Reader r a -> r -> a
runReader SymbolTable
symt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eval a -> Eval' a
unEval

-- | Evaluate Fortran expressions to 'FS.FValue's.
--
-- We look up variables from a plain 'SymbolTable', but evaluate using
-- fortran-src's machinery. We must therefore translate 'SymbolTable' 'ExpVal's
-- to 'FS.FValue'. If we want to return fortran-vars-style types, we must
-- translate the other way after executing a program in this monad.
instance FS.Eval.MonadFEval Eval where
    type EvalTo Eval = FS.Rep.FValue

    lookupFVar :: Name -> Eval (Maybe (EvalTo Eval))
lookupFVar Name
name = do
        SymbolTable
symt <- forall r (m :: * -> *). MonadReader r m => m r
ask
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name SymbolTable
symt of
          Maybe SymbolTableEntry
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          Just SymbolTableEntry
entry ->
            case SymbolTableEntry
entry of
              SParameter Type
_ ExpVal
val ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FScalarValue -> FValue
FS.Rep.MkFScalarValue forall a b. (a -> b) -> a -> b
$ ExpVal -> FScalarValue
translateExpVal ExpVal
val
              SymbolTableEntry
_ -> do
                forall (m :: * -> *). MonadFEval m => Name -> m ()
FS.Eval.warn forall a b. (a -> b) -> a -> b
$
                    Name
"found variable in SymbolTable, but wasn't an SParameter: "
                    forall a. Semigroup a => a -> a -> a
<>Name
name
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    -- | Ignore warnings. fortran-vars doesn't have a method to report warnings
    --   during evaluation.
    warn :: Name -> Eval ()
warn Name
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()