{-# 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
type Eval' = ExceptT FS.Eval.Error (Reader SymbolTable)
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'
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
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
warn :: Name -> Eval ()
warn Name
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()