{-# LANGUAGE FlexibleInstances #-}

{- |
Module      : Language.Egison.EvalState
Licence     : MIT

This module defines the state during the evaluation.
-}

module Language.Egison.EvalState
  ( EvalState(..)
  , initialEvalState
  , MonadEval(..)
  , mLabelFuncName
  , InstanceEnv
  , MethodDict
  , ConstructorEnv
  , ConstructorInfo(..)
  , PatternConstructorEnv
  ) where

import           Control.Monad.Except
import           Control.Monad.Trans.Class        (lift)
import           Control.Monad.Trans.State.Strict

import qualified Data.HashMap.Strict              as HashMap
import           Data.HashMap.Strict              (HashMap)

import           Language.Egison.IExpr
import           Language.Egison.Type.Types       (Type, TypeScheme)
import           Language.Egison.Type.Env          (TypeEnv, ClassEnv, PatternTypeEnv, emptyEnv, emptyClassEnv, emptyPatternEnv, extendEnv)

-- | Instance environment: maps class name -> method name -> type -> implementation
-- The implementation is stored as a function reference (Var name)
type MethodDict = HashMap Type String  -- Type -> implementation function name
type InstanceEnv = HashMap String (HashMap String MethodDict)  -- ClassName -> MethodName -> Dict

-- | Constructor environment: maps constructor name -> constructor info
-- Used for type inference and pattern matching
data ConstructorInfo = ConstructorInfo
  { ConstructorInfo -> String
ctorTypeName :: String      -- ^ The inductive type name, e.g., "Maybe"
  , ConstructorInfo -> [Type]
ctorArgTypes :: [Type]      -- ^ Constructor argument types
  , ConstructorInfo -> [String]
ctorTypeParams :: [String]  -- ^ Type parameters of the inductive type, e.g., ["a"]
  } deriving (Int -> ConstructorInfo -> ShowS
[ConstructorInfo] -> ShowS
ConstructorInfo -> String
(Int -> ConstructorInfo -> ShowS)
-> (ConstructorInfo -> String)
-> ([ConstructorInfo] -> ShowS)
-> Show ConstructorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstructorInfo -> ShowS
showsPrec :: Int -> ConstructorInfo -> ShowS
$cshow :: ConstructorInfo -> String
show :: ConstructorInfo -> String
$cshowList :: [ConstructorInfo] -> ShowS
showList :: [ConstructorInfo] -> ShowS
Show, ConstructorInfo -> ConstructorInfo -> Bool
(ConstructorInfo -> ConstructorInfo -> Bool)
-> (ConstructorInfo -> ConstructorInfo -> Bool)
-> Eq ConstructorInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstructorInfo -> ConstructorInfo -> Bool
== :: ConstructorInfo -> ConstructorInfo -> Bool
$c/= :: ConstructorInfo -> ConstructorInfo -> Bool
/= :: ConstructorInfo -> ConstructorInfo -> Bool
Eq)

type ConstructorEnv = HashMap String ConstructorInfo

-- | Pattern constructor environment: maps pattern constructor name -> type scheme
-- This uses the same format as PatternTypeEnv for consistency
type PatternConstructorEnv = PatternTypeEnv

data EvalState = EvalState
  { EvalState -> [Var]
funcNameStack  :: [Var]          -- ^ Names of called functions for improved error message
  , EvalState -> InstanceEnv
instanceEnv    :: InstanceEnv    -- ^ Type class instance environment (runtime dispatch)
  , EvalState -> ConstructorEnv
constructorEnv :: ConstructorEnv -- ^ Inductive data constructor environment
  , EvalState -> TypeEnv
typeEnv        :: TypeEnv        -- ^ Type environment (for type inference)
  , EvalState -> ClassEnv
classEnv       :: ClassEnv       -- ^ Class environment (for type inference)
  , EvalState -> PatternTypeEnv
patternEnv     :: PatternTypeEnv -- ^ Pattern constructor environment (for type inference)
  , EvalState -> PatternTypeEnv
patternFuncEnv :: PatternTypeEnv -- ^ Pattern function environment (for disambiguation)
  }

initialEvalState :: EvalState
initialEvalState :: EvalState
initialEvalState = EvalState
  { funcNameStack :: [Var]
funcNameStack = []
  , instanceEnv :: InstanceEnv
instanceEnv = InstanceEnv
forall k v. HashMap k v
HashMap.empty
  , constructorEnv :: ConstructorEnv
constructorEnv = ConstructorEnv
forall k v. HashMap k v
HashMap.empty
  , typeEnv :: TypeEnv
typeEnv = TypeEnv
emptyEnv
  , classEnv :: ClassEnv
classEnv = ClassEnv
emptyClassEnv
  , patternEnv :: PatternTypeEnv
patternEnv = PatternTypeEnv
emptyPatternEnv
  , patternFuncEnv :: PatternTypeEnv
patternFuncEnv = PatternTypeEnv
emptyPatternEnv
  }

class (Applicative m, Monad m) => MonadEval m where
  pushFuncName :: Var -> m ()
  topFuncName :: m Var
  popFuncName :: m ()
  getFuncNameStack :: m [Var]
  -- Instance environment operations
  getInstanceEnv :: m InstanceEnv
  registerInstance :: String -> String -> Type -> String -> m ()
  lookupInstance :: String -> String -> Type -> m (Maybe String)
  -- Constructor environment operations
  getConstructorEnv :: m ConstructorEnv
  registerConstructor :: String -> ConstructorInfo -> m ()
  lookupConstructor :: String -> m (Maybe ConstructorInfo)
  -- Type environment operations
  getTypeEnv :: m TypeEnv
  setTypeEnv :: TypeEnv -> m ()
  extendTypeEnv :: Var -> TypeScheme -> m ()
  -- Class environment operations
  getClassEnv :: m ClassEnv
  setClassEnv :: ClassEnv -> m ()
  -- Pattern environment operations
  getPatternEnv :: m PatternTypeEnv
  setPatternEnv :: PatternTypeEnv -> m ()
  -- Pattern function environment operations
  getPatternFuncEnv :: m PatternTypeEnv
  setPatternFuncEnv :: PatternTypeEnv -> m ()

instance Monad m => MonadEval (StateT EvalState m) where
  pushFuncName :: Var -> StateT EvalState m ()
pushFuncName Var
name = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { funcNameStack = name : funcNameStack st }
    () -> StateT EvalState m ()
forall a. a -> StateT EvalState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  topFuncName :: StateT EvalState m Var
topFuncName = [Var] -> Var
forall a. HasCallStack => [a] -> a
head ([Var] -> Var) -> (EvalState -> [Var]) -> EvalState -> Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> [Var]
funcNameStack (EvalState -> Var)
-> StateT EvalState m EvalState -> StateT EvalState m Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  popFuncName :: StateT EvalState m ()
popFuncName = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { funcNameStack = tail $ funcNameStack st }
    () -> StateT EvalState m ()
forall a. a -> StateT EvalState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  getFuncNameStack :: StateT EvalState m [Var]
getFuncNameStack = EvalState -> [Var]
funcNameStack (EvalState -> [Var])
-> StateT EvalState m EvalState -> StateT EvalState m [Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  
  getInstanceEnv :: StateT EvalState m InstanceEnv
getInstanceEnv = EvalState -> InstanceEnv
instanceEnv (EvalState -> InstanceEnv)
-> StateT EvalState m EvalState -> StateT EvalState m InstanceEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  
  registerInstance :: String -> String -> Type -> String -> StateT EvalState m ()
registerInstance String
className String
methodName Type
ty String
implName = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let env :: InstanceEnv
env = EvalState -> InstanceEnv
instanceEnv EvalState
st
        classDict :: HashMap String MethodDict
classDict = HashMap String MethodDict
-> String -> InstanceEnv -> HashMap String MethodDict
forall k v. Hashable k => v -> k -> HashMap k v -> v
HashMap.lookupDefault HashMap String MethodDict
forall k v. HashMap k v
HashMap.empty String
className InstanceEnv
env
        methodDict :: MethodDict
methodDict = MethodDict -> String -> HashMap String MethodDict -> MethodDict
forall k v. Hashable k => v -> k -> HashMap k v -> v
HashMap.lookupDefault MethodDict
forall k v. HashMap k v
HashMap.empty String
methodName HashMap String MethodDict
classDict
        methodDict' :: MethodDict
methodDict' = Type -> String -> MethodDict -> MethodDict
forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
HashMap.insert Type
ty String
implName MethodDict
methodDict
        classDict' :: HashMap String MethodDict
classDict' = String
-> MethodDict
-> HashMap String MethodDict
-> HashMap String MethodDict
forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
HashMap.insert String
methodName MethodDict
methodDict' HashMap String MethodDict
classDict
        env' :: InstanceEnv
env' = String -> HashMap String MethodDict -> InstanceEnv -> InstanceEnv
forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
HashMap.insert String
className HashMap String MethodDict
classDict' InstanceEnv
env
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { instanceEnv = env' }
  
  lookupInstance :: String -> String -> Type -> StateT EvalState m (Maybe String)
lookupInstance String
className String
methodName Type
ty = do
    InstanceEnv
env <- EvalState -> InstanceEnv
instanceEnv (EvalState -> InstanceEnv)
-> StateT EvalState m EvalState -> StateT EvalState m InstanceEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    Maybe String -> StateT EvalState m (Maybe String)
forall a. a -> StateT EvalState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> StateT EvalState m (Maybe String))
-> Maybe String -> StateT EvalState m (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
      HashMap String MethodDict
classDict <- String -> InstanceEnv -> Maybe (HashMap String MethodDict)
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup String
className InstanceEnv
env
      MethodDict
methodDict <- String -> HashMap String MethodDict -> Maybe MethodDict
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup String
methodName HashMap String MethodDict
classDict
      Type -> MethodDict -> Maybe String
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup Type
ty MethodDict
methodDict
  
  getConstructorEnv :: StateT EvalState m ConstructorEnv
getConstructorEnv = EvalState -> ConstructorEnv
constructorEnv (EvalState -> ConstructorEnv)
-> StateT EvalState m EvalState
-> StateT EvalState m ConstructorEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  
  registerConstructor :: String -> ConstructorInfo -> StateT EvalState m ()
registerConstructor String
ctorName ConstructorInfo
info = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let env :: ConstructorEnv
env = EvalState -> ConstructorEnv
constructorEnv EvalState
st
        env' :: ConstructorEnv
env' = String -> ConstructorInfo -> ConstructorEnv -> ConstructorEnv
forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
HashMap.insert String
ctorName ConstructorInfo
info ConstructorEnv
env
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { constructorEnv = env' }
  
  lookupConstructor :: String -> StateT EvalState m (Maybe ConstructorInfo)
lookupConstructor String
ctorName = do
    ConstructorEnv
env <- EvalState -> ConstructorEnv
constructorEnv (EvalState -> ConstructorEnv)
-> StateT EvalState m EvalState
-> StateT EvalState m ConstructorEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    Maybe ConstructorInfo -> StateT EvalState m (Maybe ConstructorInfo)
forall a. a -> StateT EvalState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ConstructorInfo
 -> StateT EvalState m (Maybe ConstructorInfo))
-> Maybe ConstructorInfo
-> StateT EvalState m (Maybe ConstructorInfo)
forall a b. (a -> b) -> a -> b
$ String -> ConstructorEnv -> Maybe ConstructorInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup String
ctorName ConstructorEnv
env
  
  getTypeEnv :: StateT EvalState m TypeEnv
getTypeEnv = EvalState -> TypeEnv
typeEnv (EvalState -> TypeEnv)
-> StateT EvalState m EvalState -> StateT EvalState m TypeEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  setTypeEnv :: TypeEnv -> StateT EvalState m ()
setTypeEnv TypeEnv
env = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { typeEnv = env }
  extendTypeEnv :: Var -> TypeScheme -> StateT EvalState m ()
extendTypeEnv Var
name TypeScheme
scheme = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let env' :: TypeEnv
env' = Var -> TypeScheme -> TypeEnv -> TypeEnv
extendEnv Var
name TypeScheme
scheme (EvalState -> TypeEnv
typeEnv EvalState
st)
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { typeEnv = env' }
  
  getClassEnv :: StateT EvalState m ClassEnv
getClassEnv = EvalState -> ClassEnv
classEnv (EvalState -> ClassEnv)
-> StateT EvalState m EvalState -> StateT EvalState m ClassEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  setClassEnv :: ClassEnv -> StateT EvalState m ()
setClassEnv ClassEnv
env = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { classEnv = env }
  
  getPatternEnv :: StateT EvalState m PatternTypeEnv
getPatternEnv = EvalState -> PatternTypeEnv
patternEnv (EvalState -> PatternTypeEnv)
-> StateT EvalState m EvalState
-> StateT EvalState m PatternTypeEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  setPatternEnv :: PatternTypeEnv -> StateT EvalState m ()
setPatternEnv PatternTypeEnv
env = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { patternEnv = env }
  
  getPatternFuncEnv :: StateT EvalState m PatternTypeEnv
getPatternFuncEnv = EvalState -> PatternTypeEnv
patternFuncEnv (EvalState -> PatternTypeEnv)
-> StateT EvalState m EvalState
-> StateT EvalState m PatternTypeEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  setPatternFuncEnv :: PatternTypeEnv -> StateT EvalState m ()
setPatternFuncEnv PatternTypeEnv
env = do
    EvalState
st <- StateT EvalState m EvalState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    EvalState -> StateT EvalState m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (EvalState -> StateT EvalState m ())
-> EvalState -> StateT EvalState m ()
forall a b. (a -> b) -> a -> b
$ EvalState
st { patternFuncEnv = env }

instance (MonadEval m) => MonadEval (ExceptT e m) where
  pushFuncName :: Var -> ExceptT e m ()
pushFuncName Var
name = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> m () -> ExceptT e m ()
forall a b. (a -> b) -> a -> b
$ Var -> m ()
forall (m :: * -> *). MonadEval m => Var -> m ()
pushFuncName Var
name
  topFuncName :: ExceptT e m Var
topFuncName = m Var -> ExceptT e m Var
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Var
forall (m :: * -> *). MonadEval m => m Var
topFuncName
  popFuncName :: ExceptT e m ()
popFuncName = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). MonadEval m => m ()
popFuncName
  getFuncNameStack :: ExceptT e m [Var]
getFuncNameStack = m [Var] -> ExceptT e m [Var]
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Var]
forall (m :: * -> *). MonadEval m => m [Var]
getFuncNameStack
  getInstanceEnv :: ExceptT e m InstanceEnv
getInstanceEnv = m InstanceEnv -> ExceptT e m InstanceEnv
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m InstanceEnv
forall (m :: * -> *). MonadEval m => m InstanceEnv
getInstanceEnv
  registerInstance :: String -> String -> Type -> String -> ExceptT e m ()
registerInstance String
cn String
mn Type
t String
i = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> m () -> ExceptT e m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Type -> String -> m ()
forall (m :: * -> *).
MonadEval m =>
String -> String -> Type -> String -> m ()
registerInstance String
cn String
mn Type
t String
i
  lookupInstance :: String -> String -> Type -> ExceptT e m (Maybe String)
lookupInstance String
cn String
mn Type
t = m (Maybe String) -> ExceptT e m (Maybe String)
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe String) -> ExceptT e m (Maybe String))
-> m (Maybe String) -> ExceptT e m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String -> Type -> m (Maybe String)
forall (m :: * -> *).
MonadEval m =>
String -> String -> Type -> m (Maybe String)
lookupInstance String
cn String
mn Type
t
  getConstructorEnv :: ExceptT e m ConstructorEnv
getConstructorEnv = m ConstructorEnv -> ExceptT e m ConstructorEnv
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ConstructorEnv
forall (m :: * -> *). MonadEval m => m ConstructorEnv
getConstructorEnv
  registerConstructor :: String -> ConstructorInfo -> ExceptT e m ()
registerConstructor String
cn ConstructorInfo
info = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> m () -> ExceptT e m ()
forall a b. (a -> b) -> a -> b
$ String -> ConstructorInfo -> m ()
forall (m :: * -> *).
MonadEval m =>
String -> ConstructorInfo -> m ()
registerConstructor String
cn ConstructorInfo
info
  lookupConstructor :: String -> ExceptT e m (Maybe ConstructorInfo)
lookupConstructor String
cn = m (Maybe ConstructorInfo) -> ExceptT e m (Maybe ConstructorInfo)
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe ConstructorInfo) -> ExceptT e m (Maybe ConstructorInfo))
-> m (Maybe ConstructorInfo) -> ExceptT e m (Maybe ConstructorInfo)
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe ConstructorInfo)
forall (m :: * -> *).
MonadEval m =>
String -> m (Maybe ConstructorInfo)
lookupConstructor String
cn
  getTypeEnv :: ExceptT e m TypeEnv
getTypeEnv = m TypeEnv -> ExceptT e m TypeEnv
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
  setTypeEnv :: TypeEnv -> ExceptT e m ()
setTypeEnv = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ())
-> (TypeEnv -> m ()) -> TypeEnv -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeEnv -> m ()
forall (m :: * -> *). MonadEval m => TypeEnv -> m ()
setTypeEnv
  extendTypeEnv :: Var -> TypeScheme -> ExceptT e m ()
extendTypeEnv Var
name TypeScheme
scheme = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> m () -> ExceptT e m ()
forall a b. (a -> b) -> a -> b
$ Var -> TypeScheme -> m ()
forall (m :: * -> *). MonadEval m => Var -> TypeScheme -> m ()
extendTypeEnv Var
name TypeScheme
scheme
  getClassEnv :: ExceptT e m ClassEnv
getClassEnv = m ClassEnv -> ExceptT e m ClassEnv
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ClassEnv
forall (m :: * -> *). MonadEval m => m ClassEnv
getClassEnv
  setClassEnv :: ClassEnv -> ExceptT e m ()
setClassEnv = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ())
-> (ClassEnv -> m ()) -> ClassEnv -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassEnv -> m ()
forall (m :: * -> *). MonadEval m => ClassEnv -> m ()
setClassEnv
  getPatternEnv :: ExceptT e m PatternTypeEnv
getPatternEnv = m PatternTypeEnv -> ExceptT e m PatternTypeEnv
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PatternTypeEnv
forall (m :: * -> *). MonadEval m => m PatternTypeEnv
getPatternEnv
  setPatternEnv :: PatternTypeEnv -> ExceptT e m ()
setPatternEnv = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ())
-> (PatternTypeEnv -> m ()) -> PatternTypeEnv -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternTypeEnv -> m ()
forall (m :: * -> *). MonadEval m => PatternTypeEnv -> m ()
setPatternEnv
  getPatternFuncEnv :: ExceptT e m PatternTypeEnv
getPatternFuncEnv = m PatternTypeEnv -> ExceptT e m PatternTypeEnv
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PatternTypeEnv
forall (m :: * -> *). MonadEval m => m PatternTypeEnv
getPatternFuncEnv
  setPatternFuncEnv :: PatternTypeEnv -> ExceptT e m ()
setPatternFuncEnv = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ())
-> (PatternTypeEnv -> m ()) -> PatternTypeEnv -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternTypeEnv -> m ()
forall (m :: * -> *). MonadEval m => PatternTypeEnv -> m ()
setPatternFuncEnv

mLabelFuncName :: MonadEval m => Maybe Var -> m a -> m a
mLabelFuncName :: forall (m :: * -> *) a. MonadEval m => Maybe Var -> m a -> m a
mLabelFuncName Maybe Var
Nothing m a
m = m a
m
mLabelFuncName (Just Var
name) m a
m = do
  Var -> m ()
forall (m :: * -> *). MonadEval m => Var -> m ()
pushFuncName Var
name
  a
v <- m a
m
  m ()
forall (m :: * -> *). MonadEval m => m ()
popFuncName
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v