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

This module provides interface for evaluating Egison expressions.

Processing Flow (design/implementation.md):
  1. TopExpr (Parse result)
  2. expandLoads (File loading with caching)
  3. Environment Building Phase (Collect data constructors, type classes, instances, type signatures)
  4. Desugar (Syntactic desugaring)
  5. Type Inference Phase (Constraint generation, unification, type class constraint processing)
  6. Type Check Phase (Verify type annotations, check type class constraints)
  7. TypedTopExpr (Typed AST)
  8. TypedDesugar (Type-driven transformations: type class expansion, tensorMap insertion)
  9. TITopExpr (Evaluatable typed IR with type info preserved)
 10. Evaluation (Pattern matching execution, expression evaluation, IO actions)
-}

module Language.Egison.Eval
  (
  -- * Eval Egison expressions
    evalExpr
  , evalTopExpr
  , evalTopExprStr
  , evalTopExprs
  , evalTopExprs'
  , evalTopExprsNoPrint
  , runExpr
  , runTopExpr
  , runTopExprStr
  , runTopExprs
  -- * Load Egison files
  , loadEgisonLibrary
  , loadEgisonFile
  -- * Load expansion
  , expandLoads
  ) where

import           Control.Monad              (foldM, forM_, when)
import           Data.List                  (intercalate, partition)
import           Control.Monad.Except       (throwError, catchError)
import           Control.Monad.Reader       (ask, asks)
import           Control.Monad.State
import           System.IO                  (hPutStrLn, stderr)

import           Language.Egison.AST
import           Language.Egison.CmdOptions
import           Language.Egison.Core
import           Language.Egison.Data
import           Language.Egison.Data.Utils     (newEvaluatedObjectRef)
import           Language.Egison.Desugar (desugarExpr, desugarTopExpr, desugarTopExprs)
import           Language.Egison.EnvBuilder (buildEnvironments, EnvBuildResult(..))
import           Language.Egison.EvalState  (MonadEval (..), ConstructorEnv, PatternConstructorEnv)
import           Language.Egison.IExpr (TITopExpr(..), ITopExpr(..), IExpr(..), Var(..), stringToVar, stripTypeTopExpr)
import           Language.Egison.MathOutput (prettyMath)
import           Language.Egison.Parser
import qualified Language.Egison.Type.Types as Types
import           Language.Egison.Type.Infer (inferITopExpr, runInferWithWarningsAndState, InferState(..), initialInferStateWithConfig, permissiveInferConfig, defaultInferConfig)
import           Language.Egison.Type.Env (TypeEnv, ClassEnv, PatternTypeEnv, extendEnvMany, envToList, classEnvToList, lookupInstances, patternEnvToList, mergeClassEnv, extendPatternEnv)
import           Language.Egison.Type.TypeClassExpand ()
import           Language.Egison.Type.TypedDesugar (desugarTypedTopExprT_TensorMapOnly, desugarTypedTopExprT_TypeClassOnly)
import           Language.Egison.Type.Error (formatTypeError, formatTypeWarning)
import           Language.Egison.Type.Check (builtinEnv)
import           Language.Egison.Type.Pretty (prettyTypeScheme, prettyType)
import           Language.Egison.Pretty (prettyStr)
import           Language.Egison.EvalState (ConstructorInfo(..))
import qualified Data.HashMap.Strict as HashMap


-- | Evaluate an Egison expression.
evalExpr :: Env -> Expr -> EvalM EgisonValue
evalExpr :: Env -> Expr -> EvalM EgisonValue
evalExpr Env
env Expr
expr = Expr -> EvalM IExpr
desugarExpr Expr
expr EvalM IExpr -> (IExpr -> EvalM EgisonValue) -> EvalM EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> IExpr -> EvalM EgisonValue
evalExprDeep Env
env

--------------------------------------------------------------------------------
-- Phase 1: expandLoads - File Loading with Caching
--------------------------------------------------------------------------------
-- Recursively expand all Load/LoadFile statements into a flat list of TopExprs.
-- This phase handles file reading and prevents duplicate loading through caching.
-- After this phase, all source code is loaded and ready for environment building.

-- | Expand all Load/LoadFile statements recursively into a flat list of TopExprs.
-- Files are loaded recursively and deduplicated (same file loaded multiple times
-- will only appear once in the final list).
expandLoads :: [TopExpr] -> EvalM [TopExpr]
expandLoads :: [TopExpr] -> EvalM [TopExpr]
expandLoads [] = [TopExpr] -> EvalM [TopExpr]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
expandLoads (TopExpr
expr:[TopExpr]
rest) = case TopExpr
expr of
  Load String
lib -> do
    [TopExpr]
libExprs <- String -> EvalM [TopExpr]
loadLibraryFile String
lib
    [TopExpr]
expanded <- [TopExpr] -> EvalM [TopExpr]
expandLoads [TopExpr]
libExprs
    [TopExpr]
restExpanded <- [TopExpr] -> EvalM [TopExpr]
expandLoads [TopExpr]
rest
    [TopExpr] -> EvalM [TopExpr]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TopExpr] -> EvalM [TopExpr]) -> [TopExpr] -> EvalM [TopExpr]
forall a b. (a -> b) -> a -> b
$ [TopExpr]
expanded [TopExpr] -> [TopExpr] -> [TopExpr]
forall a. [a] -> [a] -> [a]
++ [TopExpr]
restExpanded
  LoadFile String
file -> do
    [TopExpr]
fileExprs <- String -> EvalM [TopExpr]
loadFile String
file
    [TopExpr]
expanded <- [TopExpr] -> EvalM [TopExpr]
expandLoads [TopExpr]
fileExprs
    [TopExpr]
restExpanded <- [TopExpr] -> EvalM [TopExpr]
expandLoads [TopExpr]
rest
    [TopExpr] -> EvalM [TopExpr]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TopExpr] -> EvalM [TopExpr]) -> [TopExpr] -> EvalM [TopExpr]
forall a b. (a -> b) -> a -> b
$ [TopExpr]
expanded [TopExpr] -> [TopExpr] -> [TopExpr]
forall a. [a] -> [a] -> [a]
++ [TopExpr]
restExpanded
  TopExpr
_ -> do
    [TopExpr]
restExpanded <- [TopExpr] -> EvalM [TopExpr]
expandLoads [TopExpr]
rest
    [TopExpr] -> EvalM [TopExpr]
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TopExpr] -> EvalM [TopExpr]) -> [TopExpr] -> EvalM [TopExpr]
forall a b. (a -> b) -> a -> b
$ TopExpr
expr TopExpr -> [TopExpr] -> [TopExpr]
forall a. a -> [a] -> [a]
: [TopExpr]
restExpanded

--------------------------------------------------------------------------------
-- Main Pipeline Entry Point
--------------------------------------------------------------------------------

-- | Evaluate an Egison top expression.
-- Implements the complete processing flow:
--   expandLoads → Environment Building → Desugar → Type Inference/Check → 
--   TypedDesugar → Evaluation
evalTopExpr :: Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr :: Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env TopExpr
topExpr = do
  -- Phase 1: Expand all Load/LoadFile recursively
  [TopExpr]
expanded <- [TopExpr] -> EvalM [TopExpr]
expandLoads [TopExpr
topExpr]
  -- Phase 2-10: Process all expanded expressions through remaining pipeline
  Env -> [TopExpr] -> EvalM (Maybe EgisonValue, Env)
evalExpandedTopExprsTyped Env
env [TopExpr]
expanded

-- | Evaluate expanded top expressions using typed pipeline
-- TODO: Implement type environment accumulation for proper type checking
evalExpandedTopExprsTyped :: Env -> [TopExpr] -> EvalM (Maybe EgisonValue, Env)
evalExpandedTopExprsTyped :: Env -> [TopExpr] -> EvalM (Maybe EgisonValue, Env)
evalExpandedTopExprsTyped Env
env [TopExpr]
exprs = Env -> [TopExpr] -> Bool -> Bool -> EvalM (Maybe EgisonValue, Env)
evalExpandedTopExprsTyped' Env
env [TopExpr]
exprs Bool
False Bool
True

--------------------------------------------------------------------------------
-- Phase 2-10: Environment Building → Desugar → Type Inference/Check → 
--             TypedDesugar → Evaluation
--------------------------------------------------------------------------------

-- | Evaluate expanded top expressions using the typed pipeline with optional printing.
-- This function implements phases 2-10 of the processing flow.
evalExpandedTopExprsTyped' :: Env -> [TopExpr] -> Bool -> Bool -> EvalM (Maybe EgisonValue, Env)
evalExpandedTopExprsTyped' :: Env -> [TopExpr] -> Bool -> Bool -> EvalM (Maybe EgisonValue, Env)
evalExpandedTopExprsTyped' Env
env [TopExpr]
exprs Bool
printValues Bool
shouldDumpTyped = do
  EgisonOpts
opts <- StateT EvalState (ExceptT EgisonError RuntimeM) EgisonOpts
forall r (m :: * -> *). MonadReader r m => m r
ask
  
  --------------------------------------------------------------------------------
  -- Phase 2: Environment Building Phase (完全に独立したフェーズ)
  --------------------------------------------------------------------------------
  -- Collect ALL environment information BEFORE type inference begins:
  --   1. Data constructor definitions (from InductiveDecl)
  --   2. Type class definitions (from ClassDeclExpr)
  --   3. Instance definitions (from InstanceDeclExpr)
  --   4. Type signatures (from DefineWithType)
  
  -- Get existing environments (may contain previously loaded libraries)
  TypeEnv
currentTypeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
  ClassEnv
currentClassEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) ClassEnv
forall (m :: * -> *). MonadEval m => m ClassEnv
getClassEnv
  PatternTypeEnv
currentPatternEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) PatternTypeEnv
forall (m :: * -> *). MonadEval m => m PatternTypeEnv
getPatternEnv

  -- Build environments from current expressions
  EnvBuildResult
envResult <- [TopExpr] -> EvalM EnvBuildResult
buildEnvironments [TopExpr]
exprs

  -- Merge existing environments with newly built environments
  -- New definitions extend existing ones (can override)
  let newTypeEnv :: TypeEnv
newTypeEnv = EnvBuildResult -> TypeEnv
ebrTypeEnv EnvBuildResult
envResult
      -- If currentTypeEnv is empty, use builtinEnv as base
      baseTypeEnv :: TypeEnv
baseTypeEnv = if [(Var, TypeScheme)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TypeEnv -> [(Var, TypeScheme)]
envToList TypeEnv
currentTypeEnv) then TypeEnv
builtinEnv else TypeEnv
currentTypeEnv
      mergedTypeEnv :: TypeEnv
mergedTypeEnv = [(Var, TypeScheme)] -> TypeEnv -> TypeEnv
extendEnvMany (TypeEnv -> [(Var, TypeScheme)]
envToList TypeEnv
newTypeEnv) TypeEnv
baseTypeEnv
      mergedClassEnv :: ClassEnv
mergedClassEnv = ClassEnv -> ClassEnv -> ClassEnv
mergeClassEnv ClassEnv
currentClassEnv (EnvBuildResult -> ClassEnv
ebrClassEnv EnvBuildResult
envResult)
      -- Merge pattern environments (new definitions can override)
      -- Pattern constructors from ebrPatternConstructorEnv and pattern functions from ebrPatternTypeEnv
      patternConstructorEnv :: PatternTypeEnv
patternConstructorEnv = EnvBuildResult -> PatternTypeEnv
ebrPatternConstructorEnv EnvBuildResult
envResult
      newPatternFuncEnv :: PatternTypeEnv
newPatternFuncEnv = EnvBuildResult -> PatternTypeEnv
ebrPatternTypeEnv EnvBuildResult
envResult
  
  -- Get current pattern function environment
  PatternTypeEnv
currentPatternFuncEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) PatternTypeEnv
forall (m :: * -> *). MonadEval m => m PatternTypeEnv
getPatternFuncEnv
  
  let -- Merge both into a single pattern environment
      mergedPatternEnv :: PatternTypeEnv
mergedPatternEnv = ((String, TypeScheme) -> PatternTypeEnv -> PatternTypeEnv)
-> PatternTypeEnv -> [(String, TypeScheme)] -> PatternTypeEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(String
name, TypeScheme
scheme) PatternTypeEnv
env -> String -> TypeScheme -> PatternTypeEnv -> PatternTypeEnv
extendPatternEnv String
name TypeScheme
scheme PatternTypeEnv
env) 
                               (((String, TypeScheme) -> PatternTypeEnv -> PatternTypeEnv)
-> PatternTypeEnv -> [(String, TypeScheme)] -> PatternTypeEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(String
name, TypeScheme
scheme) PatternTypeEnv
env -> String -> TypeScheme -> PatternTypeEnv -> PatternTypeEnv
extendPatternEnv String
name TypeScheme
scheme PatternTypeEnv
env)
                                      PatternTypeEnv
currentPatternEnv
                                      (PatternTypeEnv -> [(String, TypeScheme)]
patternEnvToList PatternTypeEnv
patternConstructorEnv))
                               (PatternTypeEnv -> [(String, TypeScheme)]
patternEnvToList PatternTypeEnv
newPatternFuncEnv)
      -- Also update pattern function environment separately
      mergedPatternFuncEnv :: PatternTypeEnv
mergedPatternFuncEnv = ((String, TypeScheme) -> PatternTypeEnv -> PatternTypeEnv)
-> PatternTypeEnv -> [(String, TypeScheme)] -> PatternTypeEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(String
name, TypeScheme
scheme) PatternTypeEnv
env -> String -> TypeScheme -> PatternTypeEnv -> PatternTypeEnv
extendPatternEnv String
name TypeScheme
scheme PatternTypeEnv
env)
                                   PatternTypeEnv
currentPatternFuncEnv
                                   (PatternTypeEnv -> [(String, TypeScheme)]
patternEnvToList PatternTypeEnv
newPatternFuncEnv)

  -- Update EvalState with merged environments
  TypeEnv -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => TypeEnv -> m ()
setTypeEnv TypeEnv
mergedTypeEnv
  ClassEnv -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => ClassEnv -> m ()
setClassEnv ClassEnv
mergedClassEnv
  PatternTypeEnv
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => PatternTypeEnv -> m ()
setPatternEnv PatternTypeEnv
mergedPatternEnv
  PatternTypeEnv
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => PatternTypeEnv -> m ()
setPatternFuncEnv PatternTypeEnv
mergedPatternFuncEnv
  
  -- Register constructors to EvalState
  [(String, ConstructorInfo)]
-> ((String, ConstructorInfo)
    -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap String ConstructorInfo -> [(String, ConstructorInfo)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (EnvBuildResult -> HashMap String ConstructorInfo
ebrConstructorEnv EnvBuildResult
envResult)) (((String, ConstructorInfo)
  -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> ((String, ConstructorInfo)
    -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ \(String
ctorName, ConstructorInfo
ctorInfo) ->
    String
-> ConstructorInfo
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *).
MonadEval m =>
String -> ConstructorInfo -> m ()
registerConstructor String
ctorName ConstructorInfo
ctorInfo
  
  -- Dump environment if requested
  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optDumpEnv EgisonOpts
opts) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    TypeEnv
-> ClassEnv
-> HashMap String ConstructorInfo
-> PatternTypeEnv
-> PatternTypeEnv
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpEnvironment TypeEnv
mergedTypeEnv ClassEnv
mergedClassEnv (EnvBuildResult -> HashMap String ConstructorInfo
ebrConstructorEnv EnvBuildResult
envResult) 
                    (EnvBuildResult -> PatternTypeEnv
ebrPatternConstructorEnv EnvBuildResult
envResult) (EnvBuildResult -> PatternTypeEnv
ebrPatternTypeEnv EnvBuildResult
envResult)
  
  -- Dump desugared AST if requested
  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optDumpDesugared EgisonOpts
opts) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    [ITopExpr]
desugaredExprs <- [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs [TopExpr]
exprs
    [Maybe ITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpDesugared ((ITopExpr -> Maybe ITopExpr) -> [ITopExpr] -> [Maybe ITopExpr]
forall a b. (a -> b) -> [a] -> [b]
map ITopExpr -> Maybe ITopExpr
forall a. a -> Maybe a
Just [ITopExpr]
desugaredExprs)
  
  -- Get the environments for type inference
  -- Permissive mode allows falling back to untyped evaluation on type errors
  let permissive :: Bool
permissive = Bool -> Bool
not (EgisonOpts -> Bool
optTypeCheckStrict EgisonOpts
opts)
  
  -- Process each expression sequentially through phases 3-8 (type inference and desugaring)
  -- Collect all definitions to bind them together later (Phase 9)
  -- Non-definition expressions (ITest, IExecute) will be evaluated in Phase 10
  -- Also collect typed ASTs if dump-typed, dump-ti, or dump-tc is enabled
  -- The accumulator separates regular value bindings from pattern function bindings so
  -- they can be placed in different environments after collection.
  (([(Var, IExpr)]
allBindings, [(String, IExpr)]
allPatFuncBindings, [(ITopExpr, Bool)]
nonDefExprs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs) <- ((([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
  [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
 -> TopExpr
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
       [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr]))
-> (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
    [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> [TopExpr]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\(([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs) TopExpr
expr -> do
    -- Get current type and class environments from EvalState
    TypeEnv
currentTypeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
    ClassEnv
currentClassEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) ClassEnv
forall (m :: * -> *). MonadEval m => m ClassEnv
getClassEnv
    
    -- Phase 3-4: Desugar (TopExpr → ITopExpr)
    Maybe ITopExpr
mITopExpr <- TopExpr -> EvalM (Maybe ITopExpr)
desugarTopExpr TopExpr
expr
    
    case Maybe ITopExpr
mITopExpr of
      Maybe ITopExpr
Nothing -> (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)  -- No desugared output
      Just ITopExpr
iTopExpr -> do
        -- Phase 5-6: Type Inference (ITopExpr → TypedITopExpr)
        let inferConfig :: InferConfig
inferConfig = if Bool
permissive then InferConfig
permissiveInferConfig else InferConfig
defaultInferConfig
        -- Get the current pattern environment from EvalState
        PatternTypeEnv
currentPatternEnv' <- StateT EvalState (ExceptT EgisonError RuntimeM) PatternTypeEnv
forall (m :: * -> *). MonadEval m => m PatternTypeEnv
getPatternEnv
        PatternTypeEnv
currentPatternFuncEnv' <- StateT EvalState (ExceptT EgisonError RuntimeM) PatternTypeEnv
forall (m :: * -> *). MonadEval m => m PatternTypeEnv
getPatternFuncEnv
        -- Add pattern function types to inferEnv so they can be referenced as variables
        let patternFuncBindings :: [(Var, TypeScheme)]
patternFuncBindings = [(String -> Var
stringToVar String
name, TypeScheme
scheme) | (String
name, TypeScheme
scheme) <- PatternTypeEnv -> [(String, TypeScheme)]
patternEnvToList PatternTypeEnv
currentPatternFuncEnv']
            enrichedTypeEnv :: TypeEnv
enrichedTypeEnv = [(Var, TypeScheme)] -> TypeEnv -> TypeEnv
extendEnvMany [(Var, TypeScheme)]
patternFuncBindings TypeEnv
currentTypeEnv
            initState :: InferState
initState = (InferConfig -> InferState
initialInferStateWithConfig InferConfig
inferConfig) {
              inferEnv = enrichedTypeEnv,
              inferClassEnv = currentClassEnv,
              inferPatternEnv = currentPatternEnv',
              inferPatternFuncEnv = currentPatternFuncEnv'
            }
        (Either TypeError (Maybe TITopExpr, Subst)
result, [TypeWarning]
warnings, InferState
finalState) <- IO
  (Either TypeError (Maybe TITopExpr, Subst), [TypeWarning],
   InferState)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Either TypeError (Maybe TITopExpr, Subst), [TypeWarning],
      InferState)
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either TypeError (Maybe TITopExpr, Subst), [TypeWarning],
    InferState)
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (Either TypeError (Maybe TITopExpr, Subst), [TypeWarning],
       InferState))
-> IO
     (Either TypeError (Maybe TITopExpr, Subst), [TypeWarning],
      InferState)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Either TypeError (Maybe TITopExpr, Subst), [TypeWarning],
      InferState)
forall a b. (a -> b) -> a -> b
$ 
          Infer (Maybe TITopExpr, Subst)
-> InferState
-> IO
     (Either TypeError (Maybe TITopExpr, Subst), [TypeWarning],
      InferState)
forall a.
Infer a
-> InferState -> IO (Either TypeError a, [TypeWarning], InferState)
runInferWithWarningsAndState (ITopExpr -> Infer (Maybe TITopExpr, Subst)
inferITopExpr ITopExpr
iTopExpr) InferState
initState
        
        let updatedTypeEnv :: TypeEnv
updatedTypeEnv = InferState -> TypeEnv
inferEnv InferState
finalState
        let updatedClassEnv :: ClassEnv
updatedClassEnv = InferState -> ClassEnv
inferClassEnv InferState
finalState
        let updatedPatternEnv :: PatternTypeEnv
updatedPatternEnv = InferState -> PatternTypeEnv
inferPatternEnv InferState
finalState
        let updatedPatternFuncEnv :: PatternTypeEnv
updatedPatternFuncEnv = InferState -> PatternTypeEnv
inferPatternFuncEnv InferState
finalState
    
        -- Print type warnings if any
        Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([TypeWarning] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeWarning]
warnings)) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
          IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ (TypeWarning -> IO ()) -> [TypeWarning] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ())
-> (TypeWarning -> String) -> TypeWarning -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeWarning -> String
formatTypeWarning) [TypeWarning]
warnings
        
        -- Update type, class, and pattern environments in EvalState
        TypeEnv -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => TypeEnv -> m ()
setTypeEnv TypeEnv
updatedTypeEnv
        ClassEnv -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => ClassEnv -> m ()
setClassEnv ClassEnv
updatedClassEnv
        PatternTypeEnv
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => PatternTypeEnv -> m ()
setPatternEnv PatternTypeEnv
updatedPatternEnv
        PatternTypeEnv
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => PatternTypeEnv -> m ()
setPatternFuncEnv PatternTypeEnv
updatedPatternFuncEnv
        
        case Either TypeError (Maybe TITopExpr, Subst)
result of
          Left TypeError
err -> do
            IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Type error:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeError -> String
formatTypeError TypeError
err
            -- Fallback: Use untyped evaluation if type checking fails (permissive mode)
            -- Type errors are handled immediately, not collected
            Maybe ITopExpr
topExpr' <- TopExpr -> EvalM (Maybe ITopExpr)
desugarTopExpr TopExpr
expr
            case Maybe ITopExpr
topExpr' of
              Maybe ITopExpr
Nothing -> (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)
              Just ITopExpr
topExpr'' -> do
                -- Evaluate type-error expressions immediately (not collected)
                -- This is a fallback for permissive mode
                case ITopExpr
topExpr'' of
                  IDefine Var
name IExpr
expr ->
                    (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings [(Var, IExpr)] -> [(Var, IExpr)] -> [(Var, IExpr)]
forall a. [a] -> [a] -> [a]
++ [(Var
name, IExpr
expr)], [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)
                  IDefineMany [(Var, IExpr)]
defs ->
                    (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings [(Var, IExpr)] -> [(Var, IExpr)] -> [(Var, IExpr)]
forall a. [a] -> [a] -> [a]
++ [(Var, IExpr)]
defs, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)
                  IPatternFunctionDecl String
name [TyVar]
_tyVars [(String, Type)]
params Type
_retType IPattern
body ->
                    let paramNames :: [String]
paramNames = ((String, Type) -> String) -> [(String, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> String
forall a b. (a, b) -> a
fst [(String, Type)]
params
                        patternFuncExpr :: IExpr
patternFuncExpr = [String] -> IPattern -> IExpr
IPatternFuncExpr [String]
paramNames IPattern
body
                    in (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings [(String, IExpr)] -> [(String, IExpr)] -> [(String, IExpr)]
forall a. [a] -> [a] -> [a]
++ [(String
name, IExpr
patternFuncExpr)], [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)
                  ITopExpr
_ ->
                    -- Non-definition: collect for later evaluation
                    (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs [(ITopExpr, Bool)] -> [(ITopExpr, Bool)] -> [(ITopExpr, Bool)]
forall a. [a] -> [a] -> [a]
++ [(ITopExpr
topExpr'', Bool
printValues)]), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)

          Right (Maybe TITopExpr
Nothing, Subst
_subst) ->
            -- No code generated (e.g., load statements that are already processed)
            (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs, [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)
          
          Right (Just TITopExpr
tiTopExpr, Subst
_subst) -> do
            -- Phase 7: inferITopExpr now returns TITopExpr directly
            -- No need for separate conversion

            -- Collect typed AST for --dump-typed (Phase 6: after type inference, before TypedDesugar)
            let typedExprs' :: [Maybe TITopExpr]
typedExprs' = if EgisonOpts -> Bool
optDumpTyped EgisonOpts
opts then [Maybe TITopExpr]
typedExprs [Maybe TITopExpr] -> [Maybe TITopExpr] -> [Maybe TITopExpr]
forall a. [a] -> [a] -> [a]
++ [TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just TITopExpr
tiTopExpr] else [Maybe TITopExpr]
typedExprs

            -- Phase 8a: TensorMap Insertion
            -- Insert tensorMap where needed (scalar vs tensor argument type conversion)
            Maybe TITopExpr
mTiTopExprAfterTensorMap <- TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT_TensorMapOnly TITopExpr
tiTopExpr

            case Maybe TITopExpr
mTiTopExprAfterTensorMap of
              Maybe TITopExpr
Nothing ->
                -- Load/LoadFile statements - no evaluation needed
                (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs', [Maybe TITopExpr]
tiExprs, [Maybe TITopExpr]
tcExprs)

              Just TITopExpr
tiTopExprAfterTensorMap -> do
                -- Collect TensorMap-inserted AST for --dump-ti (after TensorMap insertion)
                let tiExprs' :: [Maybe TITopExpr]
tiExprs' = if EgisonOpts -> Bool
optDumpTi EgisonOpts
opts then [Maybe TITopExpr]
tiExprs [Maybe TITopExpr] -> [Maybe TITopExpr] -> [Maybe TITopExpr]
forall a. [a] -> [a] -> [a]
++ [TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just TITopExpr
tiTopExprAfterTensorMap] else [Maybe TITopExpr]
tiExprs

                -- Phase 8b: Type Class Expansion
                -- Expand type class method calls to dictionary-based dispatch
                Maybe TITopExpr
mTcTopExprAfterTypeClass <- TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT_TypeClassOnly TITopExpr
tiTopExprAfterTensorMap

                case Maybe TITopExpr
mTcTopExprAfterTypeClass of
                  Maybe TITopExpr
Nothing ->
                    -- Load/LoadFile statements - no evaluation needed
                    (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs', [Maybe TITopExpr]
tiExprs', [Maybe TITopExpr]
tcExprs)

                  Just TITopExpr
tcTopExprAfterTypeClass -> do
                    -- Collect TypeClass-expanded AST for --dump-tc (after TypeClass expansion)
                    let tcExprs' :: [Maybe TITopExpr]
tcExprs' = if EgisonOpts -> Bool
optDumpTc EgisonOpts
opts then [Maybe TITopExpr]
tcExprs [Maybe TITopExpr] -> [Maybe TITopExpr] -> [Maybe TITopExpr]
forall a. [a] -> [a] -> [a]
++ [TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just TITopExpr
tcTopExprAfterTypeClass] else [Maybe TITopExpr]
tcExprs

                    -- Extract ITopExpr for evaluation
                    let iTopExprExpanded :: ITopExpr
iTopExprExpanded = TITopExpr -> ITopExpr
stripTypeTopExpr TITopExpr
tcTopExprAfterTypeClass

                    -- Type scheme is already in the environment (added by inferITopExpr), no need to add again

                    -- Phase 9-10: Collect definitions and non-definitions
                    -- Definitions will be bound together using recursiveBind to support mutual recursion
                    -- Non-definitions will be evaluated sequentially after all definitions are bound
                    case ITopExpr
iTopExprExpanded of
                      IDefine Var
name IExpr
expr ->
                        -- Collect definition for later binding
                        (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings [(Var, IExpr)] -> [(Var, IExpr)] -> [(Var, IExpr)]
forall a. [a] -> [a] -> [a]
++ [(Var
name, IExpr
expr)], [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs', [Maybe TITopExpr]
tiExprs', [Maybe TITopExpr]
tcExprs')
                      IDefineMany [(Var, IExpr)]
defs ->
                        -- Collect multiple definitions for later binding
                        (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings [(Var, IExpr)] -> [(Var, IExpr)] -> [(Var, IExpr)]
forall a. [a] -> [a] -> [a]
++ [(Var, IExpr)]
defs, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs', [Maybe TITopExpr]
tiExprs', [Maybe TITopExpr]
tcExprs')
                      IPatternFunctionDecl String
name [TyVar]
_tyVars [(String, Type)]
params Type
_retType IPattern
body ->
                        -- Collect pattern function definition separately; it will be bound
                        -- into the pattern function environment (not the value environment)
                        -- via recursiveBindPatFuncs after all regular definitions are bound.
                        let paramNames :: [String]
paramNames = ((String, Type) -> String) -> [(String, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> String
forall a b. (a, b) -> a
fst [(String, Type)]
params
                            patternFuncExpr :: IExpr
patternFuncExpr = [String] -> IPattern -> IExpr
IPatternFuncExpr [String]
paramNames IPattern
body
                        in (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings [(String, IExpr)] -> [(String, IExpr)] -> [(String, IExpr)]
forall a. [a] -> [a] -> [a]
++ [(String
name, IExpr
patternFuncExpr)], [(ITopExpr, Bool)]
nonDefs), [Maybe TITopExpr]
typedExprs', [Maybe TITopExpr]
tiExprs', [Maybe TITopExpr]
tcExprs')
                      ITopExpr
_ ->
                        -- Non-definition expressions (ITest, IExecute)
                        -- Collect for evaluation after all definitions are bound
                        (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
 [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (([(Var, IExpr)], [(String, IExpr)], [(ITopExpr, Bool)]),
      [Maybe TITopExpr], [Maybe TITopExpr], [Maybe TITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [(ITopExpr, Bool)]
nonDefs [(ITopExpr, Bool)] -> [(ITopExpr, Bool)] -> [(ITopExpr, Bool)]
forall a. [a] -> [a] -> [a]
++ [(ITopExpr
iTopExprExpanded, Bool
printValues)]), [Maybe TITopExpr]
typedExprs', [Maybe TITopExpr]
tiExprs', [Maybe TITopExpr]
tcExprs')
    ) (([], [], []), [], [], []) [TopExpr]
exprs

  -- Dump typed AST BEFORE evaluation (so dumps are available even if evaluation fails)
  -- This is important for debugging - we want to see the typed AST even when there are runtime errors
  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optDumpTyped EgisonOpts
opts Bool -> Bool -> Bool
&& Bool
shouldDumpTyped) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    [Maybe TITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpTyped [Maybe TITopExpr]
typedExprs

  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optDumpTi EgisonOpts
opts Bool -> Bool -> Bool
&& Bool
shouldDumpTyped) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    [Maybe TITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpTi [Maybe TITopExpr]
tiExprs

  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optDumpTc EgisonOpts
opts Bool -> Bool -> Bool
&& Bool
shouldDumpTyped) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    [Maybe TITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpTc [Maybe TITopExpr]
tcExprs

  -- Phase 9: Bind all regular value definitions and pattern function definitions
  -- together in a single step via recursiveBindAll so that every thunk is closed
  -- over a single environment that contains both regular values and pattern
  -- functions.  Regular values go into the normal env layers; pattern functions
  -- go into the separate PatFuncEnv.  This is necessary because ordinary
  -- definitions may contain matchAll expressions that invoke pattern functions.
  Env
envWithPatFuncs <- Env -> [(Var, IExpr)] -> [(String, IExpr)] -> EvalM Env
recursiveBindAll Env
env [(Var, IExpr)]
allBindings [(String, IExpr)]
allPatFuncBindings

  -- Phase 10: Evaluate non-definition expressions in order
  (Maybe EgisonValue
lastVal, Env
finalEnv) <- ((Maybe EgisonValue, Env)
 -> (ITopExpr, Bool) -> EvalM (Maybe EgisonValue, Env))
-> (Maybe EgisonValue, Env)
-> [(ITopExpr, Bool)]
-> EvalM (Maybe EgisonValue, Env)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\(Maybe EgisonValue
lastVal, Env
currentEnv) (ITopExpr
iExpr, Bool
shouldPrint) -> do
      Either EgisonError (Maybe EgisonValue, Env)
evalResult <- StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (Either EgisonError (Maybe EgisonValue, Env))
-> (EgisonError
    -> StateT
         EvalState
         (ExceptT EgisonError RuntimeM)
         (Either EgisonError (Maybe EgisonValue, Env)))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Either EgisonError (Maybe EgisonValue, Env))
forall a.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (EgisonError
    -> StateT EvalState (ExceptT EgisonError RuntimeM) a)
-> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
        ((Maybe EgisonValue, Env)
-> Either EgisonError (Maybe EgisonValue, Env)
forall a b. b -> Either a b
Right ((Maybe EgisonValue, Env)
 -> Either EgisonError (Maybe EgisonValue, Env))
-> EvalM (Maybe EgisonValue, Env)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Either EgisonError (Maybe EgisonValue, Env))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' Env
currentEnv ITopExpr
iExpr)
        (\EgisonError
err -> do
          IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Evaluation error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EgisonError -> String
forall a. Show a => a -> String
show EgisonError
err
          Either EgisonError (Maybe EgisonValue, Env)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Either EgisonError (Maybe EgisonValue, Env))
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either EgisonError (Maybe EgisonValue, Env)
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      (Either EgisonError (Maybe EgisonValue, Env)))
-> Either EgisonError (Maybe EgisonValue, Env)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (Either EgisonError (Maybe EgisonValue, Env))
forall a b. (a -> b) -> a -> b
$ EgisonError -> Either EgisonError (Maybe EgisonValue, Env)
forall a b. a -> Either a b
Left EgisonError
err)

      case Either EgisonError (Maybe EgisonValue, Env)
evalResult of
        Left EgisonError
_ -> (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
lastVal, Env
currentEnv)
        Right (Maybe EgisonValue
mVal, Env
env'') -> do
          Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldPrint (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ case Maybe EgisonValue
mVal of
            Maybe EgisonValue
Nothing -> () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just EgisonValue
val -> EgisonValue -> EvalM String
valueToStr EgisonValue
val EvalM String
-> (String -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> (String -> IO ())
-> String
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
          (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
mVal, Env
env'')
    ) (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
envWithPatFuncs) [(ITopExpr, Bool)]
nonDefExprs

  (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
lastVal, Env
finalEnv)

--------------------------------------------------------------------------------
-- Phase 2 Helper: Environment Building (moved to EnvBuilder module)
--------------------------------------------------------------------------------
-- | Evaluate an Egison top expression.
evalTopExprStr :: Env -> TopExpr -> EvalM (Maybe String, Env)
evalTopExprStr :: Env -> TopExpr -> EvalM (Maybe String, Env)
evalTopExprStr Env
env TopExpr
topExpr = do
  (Maybe EgisonValue
val, Env
env') <- Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env TopExpr
topExpr
  case Maybe EgisonValue
val of
    Maybe EgisonValue
Nothing  -> (Maybe String, Env) -> EvalM (Maybe String, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
forall a. Maybe a
Nothing, Env
env')
    Just EgisonValue
val -> do String
str <- EgisonValue -> EvalM String
valueToStr EgisonValue
val
                   (Maybe String, Env) -> EvalM (Maybe String, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
str, Env
env')

valueToStr :: EgisonValue -> EvalM String
valueToStr :: EgisonValue -> EvalM String
valueToStr EgisonValue
val = do
  Maybe String
mathExpr <- (EgisonOpts -> Maybe String)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EgisonOpts -> Maybe String
optMathExpr
  case Maybe String
mathExpr of
    Maybe String
Nothing   -> String -> EvalM String
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
val)
    Just String
lang -> String -> EvalM String
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EgisonValue -> String
prettyMath String
lang EgisonValue
val)

-- | Evaluate Egison top expressions.
-- Pipeline: ExpandLoads → TypeCheck → TypedDesugar → Eval
evalTopExprs :: Env -> [TopExpr] -> EvalM Env
evalTopExprs :: Env -> [TopExpr] -> EvalM Env
evalTopExprs Env
env [TopExpr]
exprs = Env -> [TopExpr] -> Bool -> Bool -> EvalM Env
evalTopExprs' Env
env [TopExpr]
exprs Bool
True Bool
True

-- | Evaluate Egison top expressions with control over printing and dumping.
evalTopExprs' :: Env -> [TopExpr] -> Bool -> Bool -> EvalM Env
evalTopExprs' :: Env -> [TopExpr] -> Bool -> Bool -> EvalM Env
evalTopExprs' Env
env [TopExpr]
exprs Bool
printValues Bool
shouldDumpTyped = do
  -- Expand all Load/LoadFile recursively
  [TopExpr]
expanded <- [TopExpr] -> EvalM [TopExpr]
expandLoads [TopExpr]
exprs
  -- Evaluate using typed pipeline with printing
  (Maybe EgisonValue
_, Env
env') <- Env -> [TopExpr] -> Bool -> Bool -> EvalM (Maybe EgisonValue, Env)
evalExpandedTopExprsTyped' Env
env [TopExpr]
expanded Bool
printValues Bool
shouldDumpTyped
  Env -> EvalM Env
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env'

-- | Evaluate Egison top expressions without printing.
-- Pipeline: ExpandLoads → TypeCheck → TypedDesugar → Eval
evalTopExprsNoPrint :: Env -> [TopExpr] -> EvalM Env
evalTopExprsNoPrint :: Env -> [TopExpr] -> EvalM Env
evalTopExprsNoPrint Env
env [TopExpr]
exprs = Env -> [TopExpr] -> Bool -> Bool -> EvalM Env
evalTopExprs' Env
env [TopExpr]
exprs Bool
False Bool
True

-- | Evaluate an Egison expression. Input is a Haskell string.
runExpr :: Env -> String -> EvalM EgisonValue
runExpr :: Env -> String -> EvalM EgisonValue
runExpr Env
env String
input =
  String -> EvalM Expr
readExpr String
input EvalM Expr -> (Expr -> EvalM EgisonValue) -> EvalM EgisonValue
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> Expr -> EvalM EgisonValue
evalExpr Env
env

-- | Evaluate an Egison top expression. Input is a Haskell string.
runTopExpr :: Env -> String -> EvalM (Maybe EgisonValue, Env)
runTopExpr :: Env -> String -> EvalM (Maybe EgisonValue, Env)
runTopExpr Env
env String
input =
  String -> EvalM TopExpr
readTopExpr String
input EvalM TopExpr
-> (TopExpr -> EvalM (Maybe EgisonValue, Env))
-> EvalM (Maybe EgisonValue, Env)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env

-- | Evaluate an Egison top expression. Input is a Haskell string.
runTopExprStr :: Env -> String -> EvalM (Maybe String, Env)
runTopExprStr :: Env -> String -> EvalM (Maybe String, Env)
runTopExprStr Env
env String
input =
  String -> EvalM TopExpr
readTopExpr String
input EvalM TopExpr
-> (TopExpr -> EvalM (Maybe String, Env))
-> EvalM (Maybe String, Env)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> TopExpr -> EvalM (Maybe String, Env)
evalTopExprStr Env
env

-- | Evaluate Egison top expressions. Input is a Haskell string.
runTopExprs :: Env -> String -> EvalM Env
runTopExprs :: Env -> String -> EvalM Env
runTopExprs Env
env String
input =
  String -> EvalM [TopExpr]
readTopExprs String
input EvalM [TopExpr] -> ([TopExpr] -> EvalM Env) -> EvalM Env
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> [TopExpr] -> EvalM Env
evalTopExprs Env
env

-- | Load an Egison file.
loadEgisonFile :: Env -> FilePath -> EvalM Env
loadEgisonFile :: Env -> String -> EvalM Env
loadEgisonFile Env
env String
path = do
  (Maybe EgisonValue
_, Env
env') <- Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env (String -> TopExpr
LoadFile String
path)
  Env -> EvalM Env
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env'

-- | Load an Egison library.
loadEgisonLibrary :: Env -> FilePath -> EvalM Env
loadEgisonLibrary :: Env -> String -> EvalM Env
loadEgisonLibrary Env
env String
path = do
  (Maybe EgisonValue
_, Env
env') <- Env -> TopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr Env
env (String -> TopExpr
Load String
path)
  Env -> EvalM Env
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env'


--
-- Helper functions
--

collectDefs :: EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs :: EgisonOpts
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs = EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [] [] []
  where
    collectDefs' :: EgisonOpts -> [ITopExpr] -> [(Var, IExpr)] -> [(String, IExpr)] -> [ITopExpr] -> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
    collectDefs' :: EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts (ITopExpr
expr:[ITopExpr]
exprs) [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings [ITopExpr]
rest =
      case ITopExpr
expr of
        IDefine Var
name IExpr
expr -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs ((Var
name, IExpr
expr) (Var, IExpr) -> [(Var, IExpr)] -> [(Var, IExpr)]
forall a. a -> [a] -> [a]
: [(Var, IExpr)]
bindings) [(String, IExpr)]
patFuncBindings [ITopExpr]
rest
        IDefineMany [(Var, IExpr)]
defs  -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs ([(Var, IExpr)]
defs [(Var, IExpr)] -> [(Var, IExpr)] -> [(Var, IExpr)]
forall a. [a] -> [a] -> [a]
++ [(Var, IExpr)]
bindings) [(String, IExpr)]
patFuncBindings [ITopExpr]
rest
        IPatternFunctionDecl String
name [TyVar]
_tyVars [(String, Type)]
params Type
_retType IPattern
body ->
          let paramNames :: [String]
paramNames = ((String, Type) -> String) -> [(String, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> String
forall a b. (a, b) -> a
fst [(String, Type)]
params
              patternFuncExpr :: IExpr
patternFuncExpr = [String] -> IPattern -> IExpr
IPatternFuncExpr [String]
paramNames IPattern
body
          in EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [(Var, IExpr)]
bindings ((String
name, IExpr
patternFuncExpr) (String, IExpr) -> [(String, IExpr)] -> [(String, IExpr)]
forall a. a -> [a] -> [a]
: [(String, IExpr)]
patFuncBindings) [ITopExpr]
rest
        ITest{}     -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings (ITopExpr
expr ITopExpr -> [ITopExpr] -> [ITopExpr]
forall a. a -> [a] -> [a]
: [ITopExpr]
rest)
        IExecute{}  -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings (ITopExpr
expr ITopExpr -> [ITopExpr] -> [ITopExpr]
forall a. a -> [a] -> [a]
: [ITopExpr]
rest)
        ILoadFile String
_ | EgisonOpts -> Bool
optNoIO EgisonOpts
opts -> EgisonError
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
        ILoadFile String
file -> do
          [ITopExpr]
exprs' <- String -> EvalM [TopExpr]
loadFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
          EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts ([ITopExpr]
exprs' [ITopExpr] -> [ITopExpr] -> [ITopExpr]
forall a. [a] -> [a] -> [a]
++ [ITopExpr]
exprs) [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings [ITopExpr]
rest
        ILoad String
_ | EgisonOpts -> Bool
optNoIO EgisonOpts
opts -> EgisonError
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
        ILoad String
file -> do
          [ITopExpr]
exprs' <- String -> EvalM [TopExpr]
loadLibraryFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
          EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts ([ITopExpr]
exprs' [ITopExpr] -> [ITopExpr] -> [ITopExpr]
forall a. [a] -> [a] -> [a]
++ [ITopExpr]
exprs) [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings [ITopExpr]
rest
        ITopExpr
_ -> EgisonOpts
-> [ITopExpr]
-> [(Var, IExpr)]
-> [(String, IExpr)]
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs' EgisonOpts
opts [ITopExpr]
exprs [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings [ITopExpr]
rest
    collectDefs' EgisonOpts
_ [] [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings [ITopExpr]
rest = ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [ITopExpr] -> [ITopExpr]
forall a. [a] -> [a]
reverse [ITopExpr]
rest)

evalTopExpr' :: Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' :: Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' Env
env (IDefine Var
name IExpr
expr) = do
  Env
env' <- Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var
name, IExpr
expr)]
  (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env')
evalTopExpr' Env
env (IDefineMany [(Var, IExpr)]
defs) = do
  Env
env' <- Env -> [(Var, IExpr)] -> EvalM Env
recursiveBind Env
env [(Var, IExpr)]
defs
  (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env')
evalTopExpr' Env
env (ITest IExpr
expr) = do
  Var -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => Var -> m ()
pushFuncName (String -> Var
stringToVar String
"<stdin>")
  EgisonValue
val <- Env -> IExpr -> EvalM EgisonValue
evalExprDeep Env
env IExpr
expr
  StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => m ()
popFuncName
  (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> Maybe EgisonValue
forall a. a -> Maybe a
Just EgisonValue
val, Env
env)
evalTopExpr' Env
env (IExecute IExpr
expr) = do
  Var -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => Var -> m ()
pushFuncName (String -> Var
stringToVar String
"<stdin>")
  WHNFData
io <- Env -> IExpr -> EvalM WHNFData
evalExprShallow Env
env IExpr
expr
  case WHNFData
io of
    Value (IOFunc EvalM WHNFData
m) -> EvalM WHNFData
m EvalM WHNFData
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (m :: * -> *). MonadEval m => m ()
popFuncName StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> EvalM (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env)
    WHNFData
_                -> (CallStack -> EgisonError) -> EvalM (Maybe EgisonValue, Env)
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"io" WHNFData
io)
evalTopExpr' Env
env (ILoad String
file) = do
  EgisonOpts
opts <- StateT EvalState (ExceptT EgisonError RuntimeM) EgisonOpts
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optNoIO EgisonOpts
opts) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
  [ITopExpr]
exprs <- String -> EvalM [TopExpr]
loadLibraryFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
  ([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [ITopExpr]
_) <- EgisonOpts
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs
  Env
env' <- Env -> [(Var, IExpr)] -> [(String, IExpr)] -> EvalM Env
recursiveBindAll Env
env [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings
  (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env')
evalTopExpr' Env
env (ILoadFile String
file) = do
  EgisonOpts
opts <- StateT EvalState (ExceptT EgisonError RuntimeM) EgisonOpts
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EgisonOpts -> Bool
optNoIO EgisonOpts
opts) (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> EgisonError
Default String
"No IO support")
  [ITopExpr]
exprs <- String -> EvalM [TopExpr]
loadFile String
file EvalM [TopExpr]
-> ([TopExpr] -> EvalM [ITopExpr]) -> EvalM [ITopExpr]
forall a b.
StateT EvalState (ExceptT EgisonError RuntimeM) a
-> (a -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs
  ([(Var, IExpr)]
bindings, [(String, IExpr)]
patFuncBindings, [ITopExpr]
_) <- EgisonOpts
-> [ITopExpr]
-> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs EgisonOpts
opts [ITopExpr]
exprs
  Env
env' <- Env -> [(Var, IExpr)] -> [(String, IExpr)] -> EvalM Env
recursiveBindAll Env
env [(Var, IExpr)]
bindings [(String, IExpr)]
patFuncBindings
  (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env')
evalTopExpr' Env
env (IDeclareSymbol [String]
_names Maybe Type
_mType) = do
  -- Symbol declarations are only used during type inference
  -- At runtime, they don't produce any value or modify the environment
  (Maybe EgisonValue, Env) -> EvalM (Maybe EgisonValue, Env)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EgisonValue
forall a. Maybe a
Nothing, Env
env)
evalTopExpr' Env
_env (IPatternFunctionDecl String
name [TyVar]
_ [(String, Type)]
_ Type
_ IPattern
_) = do
  -- Pattern function declarations are now handled via recursiveBind
  -- They should not reach here; this is a fallback
  EgisonError -> EvalM (Maybe EgisonValue, Env)
forall a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM (Maybe EgisonValue, Env))
-> EgisonError -> EvalM (Maybe EgisonValue, Env)
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default (String -> EgisonError) -> String -> EgisonError
forall a b. (a -> b) -> a -> b
$ String
"Pattern function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" should have been converted to IPatternFuncExpr"

--------------------------------------------------------------------------------
-- Environment Dumping
--------------------------------------------------------------------------------

-- | Dump environment information after Phase 2 (Environment Building)
dumpEnvironment :: TypeEnv -> ClassEnv -> ConstructorEnv -> PatternConstructorEnv -> PatternTypeEnv -> EvalM ()
dumpEnvironment :: TypeEnv
-> ClassEnv
-> HashMap String ConstructorInfo
-> PatternTypeEnv
-> PatternTypeEnv
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpEnvironment TypeEnv
typeEnv ClassEnv
classEnv HashMap String ConstructorInfo
ctorEnv PatternTypeEnv
patternCtorEnv PatternTypeEnv
patternEnv = do
  IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"=== Environment Information (Phase 2: Environment Building) ==="
    String -> IO ()
putStrLn String
""
    
    -- 1. Type Signatures
    String -> IO ()
putStrLn String
"--- Type Signatures ---"
    let typeBindings :: [(Var, TypeScheme)]
typeBindings = TypeEnv -> [(Var, TypeScheme)]
envToList TypeEnv
typeEnv
    if [(Var, TypeScheme)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Var, TypeScheme)]
typeBindings
      then String -> IO ()
putStrLn String
"  (none)"
      else [(Var, TypeScheme)] -> ((Var, TypeScheme) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Var, TypeScheme)]
typeBindings (((Var, TypeScheme) -> IO ()) -> IO ())
-> ((Var, TypeScheme) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Var String
varName [Index (Maybe Var)]
indices, TypeScheme
scheme) ->
        let displayName :: String
displayName = if [Index (Maybe Var)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Index (Maybe Var)]
indices 
                          then String
varName
                          else String
varName String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Index (Maybe Var) -> String) -> [Index (Maybe Var)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Index (Maybe Var) -> String
forall a b. a -> b -> a
const String
"_") [Index (Maybe Var)]
indices
        in String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
displayName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeScheme -> String
prettyTypeScheme TypeScheme
scheme
    String -> IO ()
putStrLn String
""
    
    -- 2. Type Classes
    String -> IO ()
putStrLn String
"--- Type Classes ---"
    let classBindings :: [(String, ClassInfo)]
classBindings = ClassEnv -> [(String, ClassInfo)]
classEnvToList ClassEnv
classEnv
    if [(String, ClassInfo)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, ClassInfo)]
classBindings
      then String -> IO ()
putStrLn String
"  (none)"
      else [(String, ClassInfo)] -> ((String, ClassInfo) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, ClassInfo)]
classBindings (((String, ClassInfo) -> IO ()) -> IO ())
-> ((String, ClassInfo) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
className, ClassInfo
classInfo) -> do
        let paramName :: String
paramName = case ClassInfo -> TyVar
Types.classParam ClassInfo
classInfo of
              Types.TyVar String
name -> String
name
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  class " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" where"
        [(String, Type)] -> ((String, Type) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ClassInfo -> [(String, Type)]
Types.classMethods ClassInfo
classInfo) (((String, Type) -> IO ()) -> IO ())
-> ((String, Type) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
methName, Type
methType) ->
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
methName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
methType
    String -> IO ()
putStrLn String
""
    
    -- 3. Instances
    String -> IO ()
putStrLn String
"--- Type Class Instances ---"
    let allInstances :: [(String, InstanceInfo)]
allInstances = ((String, ClassInfo) -> [(String, InstanceInfo)])
-> [(String, ClassInfo)] -> [(String, InstanceInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(String
clsName, ClassInfo
_) -> 
          (InstanceInfo -> (String, InstanceInfo))
-> [InstanceInfo] -> [(String, InstanceInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\InstanceInfo
inst -> (String
clsName, InstanceInfo
inst)) (String -> ClassEnv -> [InstanceInfo]
lookupInstances String
clsName ClassEnv
classEnv)) [(String, ClassInfo)]
classBindings
    if [(String, InstanceInfo)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, InstanceInfo)]
allInstances
      then String -> IO ()
putStrLn String
"  (none)"
      else [(String, InstanceInfo)]
-> ((String, InstanceInfo) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, InstanceInfo)]
allInstances (((String, InstanceInfo) -> IO ()) -> IO ())
-> ((String, InstanceInfo) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
className, InstanceInfo
instInfo) -> do
        let contextStr :: String
contextStr = if [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (InstanceInfo -> [Constraint]
Types.instContext InstanceInfo
instInfo)
              then String
""
              else let showConstraint :: Constraint -> String
showConstraint (Types.Constraint String
cls Type
ty) = String
cls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
ty
                   in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Constraint -> String) -> [Constraint] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> String
showConstraint (InstanceInfo -> [Constraint]
Types.instContext InstanceInfo
instInfo)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" => "
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  instance " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
contextStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType (InstanceInfo -> Type
Types.instType InstanceInfo
instInfo)
    String -> IO ()
putStrLn String
""
    
    -- 4. Data Constructors
    String -> IO ()
putStrLn String
"--- Data Constructors ---"
    let ctorBindings :: [(String, ConstructorInfo)]
ctorBindings = HashMap String ConstructorInfo -> [(String, ConstructorInfo)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap String ConstructorInfo
ctorEnv
    if [(String, ConstructorInfo)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, ConstructorInfo)]
ctorBindings
      then String -> IO ()
putStrLn String
"  (none)"
      else [(String, ConstructorInfo)]
-> ((String, ConstructorInfo) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, ConstructorInfo)]
ctorBindings (((String, ConstructorInfo) -> IO ()) -> IO ())
-> ((String, ConstructorInfo) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
ctorName, ConstructorInfo
ctorInfo) -> do
        let typeParams :: [String]
typeParams = ConstructorInfo -> [String]
ctorTypeParams ConstructorInfo
ctorInfo
        let retType :: String
retType = if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
typeParams
              then ConstructorInfo -> String
ctorTypeName ConstructorInfo
ctorInfo
              else ConstructorInfo -> String
ctorTypeName ConstructorInfo
ctorInfo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
typeParams
        let ctorType :: String
ctorType = if [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ConstructorInfo -> [Type]
ctorArgTypes ConstructorInfo
ctorInfo)
              then String
retType
              else String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" -> " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
prettyType (ConstructorInfo -> [Type]
ctorArgTypes ConstructorInfo
ctorInfo) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
retType])
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctorName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctorType
    String -> IO ()
putStrLn String
""
    
    -- 5. Pattern Constructors
    String -> IO ()
putStrLn String
"--- Pattern Constructors ---"
    let patternCtorBindings :: [(String, TypeScheme)]
patternCtorBindings = PatternTypeEnv -> [(String, TypeScheme)]
patternEnvToList PatternTypeEnv
patternCtorEnv
    if [(String, TypeScheme)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, TypeScheme)]
patternCtorBindings
      then String -> IO ()
putStrLn String
"  (none)"
      else [(String, TypeScheme)] -> ((String, TypeScheme) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, TypeScheme)]
patternCtorBindings (((String, TypeScheme) -> IO ()) -> IO ())
-> ((String, TypeScheme) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
ctorName, TypeScheme
scheme) ->
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctorName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeScheme -> String
prettyTypeScheme TypeScheme
scheme
    String -> IO ()
putStrLn String
""
    
    -- 6. Pattern Functions
    String -> IO ()
putStrLn String
"--- Pattern Functions ---"
    let patternBindings :: [(String, TypeScheme)]
patternBindings = PatternTypeEnv -> [(String, TypeScheme)]
patternEnvToList PatternTypeEnv
patternEnv
    if [(String, TypeScheme)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, TypeScheme)]
patternBindings
      then String -> IO ()
putStrLn String
"  (none)"
      else [(String, TypeScheme)] -> ((String, TypeScheme) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, TypeScheme)]
patternBindings (((String, TypeScheme) -> IO ()) -> IO ())
-> ((String, TypeScheme) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
name, TypeScheme
scheme) ->
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeScheme -> String
prettyTypeScheme TypeScheme
scheme
    String -> IO ()
putStrLn String
""
    
    String -> IO ()
putStrLn String
"=== End of Environment Information ==="

-- | Dump desugared AST after Phase 3 (Desugaring)
dumpDesugared :: [Maybe ITopExpr] -> EvalM ()
dumpDesugared :: [Maybe ITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpDesugared [Maybe ITopExpr]
desugaredExprs = do
  IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"=== Desugared AST (Phase 3: Desugaring) ==="
    String -> IO ()
putStrLn String
""
    if [Maybe ITopExpr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe ITopExpr]
desugaredExprs
      then String -> IO ()
putStrLn String
"  (none)"
      else [(Int, Maybe ITopExpr)]
-> ((Int, Maybe ITopExpr) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Maybe ITopExpr] -> [(Int, Maybe ITopExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] [Maybe ITopExpr]
desugaredExprs) (((Int, Maybe ITopExpr) -> IO ()) -> IO ())
-> ((Int, Maybe ITopExpr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i :: Int, Maybe ITopExpr
mExpr) ->
        case Maybe ITopExpr
mExpr of
          Maybe ITopExpr
Nothing -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] (skipped)"
          Just ITopExpr
expr -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ITopExpr -> String
forall a. Pretty a => a -> String
prettyStr ITopExpr
expr
    String -> IO ()
putStrLn String
""
    String -> IO ()
putStrLn String
"=== End of Desugared AST ==="

-- | Dump typed AST after Phase 6 (Type Inference & Check)
dumpTyped :: [Maybe TITopExpr] -> EvalM ()
dumpTyped :: [Maybe TITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpTyped [Maybe TITopExpr]
typedExprs = do
  IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"=== Typed AST (Phase 5-6: Type Inference) ==="
    String -> IO ()
putStrLn String
""
    if [Maybe TITopExpr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe TITopExpr]
typedExprs
      then String -> IO ()
putStrLn String
"  (none)"
      else [(Int, Maybe TITopExpr)]
-> ((Int, Maybe TITopExpr) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Maybe TITopExpr] -> [(Int, Maybe TITopExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] [Maybe TITopExpr]
typedExprs) (((Int, Maybe TITopExpr) -> IO ()) -> IO ())
-> ((Int, Maybe TITopExpr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i :: Int, Maybe TITopExpr
mExpr) ->
        case Maybe TITopExpr
mExpr of
          Maybe TITopExpr
Nothing -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] (skipped)"
          Just TITopExpr
expr -> do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TITopExpr -> String
forall a. Pretty a => a -> String
prettyStr TITopExpr
expr
    String -> IO ()
putStrLn String
""
    String -> IO ()
putStrLn String
"=== End of Typed AST ==="

dumpTi :: [Maybe TITopExpr] -> EvalM ()
dumpTi :: [Maybe TITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpTi [Maybe TITopExpr]
tiExprs = do
  IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"=== Typed AST after TensorMap Insertion (Phase 8a) ==="
    String -> IO ()
putStrLn String
""
    if [Maybe TITopExpr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe TITopExpr]
tiExprs
      then String -> IO ()
putStrLn String
"  (none)"
      else [(Int, Maybe TITopExpr)]
-> ((Int, Maybe TITopExpr) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Maybe TITopExpr] -> [(Int, Maybe TITopExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] [Maybe TITopExpr]
tiExprs) (((Int, Maybe TITopExpr) -> IO ()) -> IO ())
-> ((Int, Maybe TITopExpr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i :: Int, Maybe TITopExpr
mExpr) ->
        case Maybe TITopExpr
mExpr of
          Maybe TITopExpr
Nothing -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] (skipped)"
          Just TITopExpr
expr -> do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TITopExpr -> String
forall a. Pretty a => a -> String
prettyStr TITopExpr
expr
    String -> IO ()
putStrLn String
""
    String -> IO ()
putStrLn String
"=== End of TensorMap Insertion AST ==="

dumpTc :: [Maybe TITopExpr] -> EvalM ()
dumpTc :: [Maybe TITopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
dumpTc [Maybe TITopExpr]
tcExprs = do
  IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> IO () -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"=== Typed AST after Type Class Expansion (Phase 8b) ==="
    String -> IO ()
putStrLn String
""
    if [Maybe TITopExpr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe TITopExpr]
tcExprs
      then String -> IO ()
putStrLn String
"  (none)"
      else [(Int, Maybe TITopExpr)]
-> ((Int, Maybe TITopExpr) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Maybe TITopExpr] -> [(Int, Maybe TITopExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] [Maybe TITopExpr]
tcExprs) (((Int, Maybe TITopExpr) -> IO ()) -> IO ())
-> ((Int, Maybe TITopExpr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i :: Int, Maybe TITopExpr
mExpr) ->
        case Maybe TITopExpr
mExpr of
          Maybe TITopExpr
Nothing -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] (skipped)"
          Just TITopExpr
expr -> do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TITopExpr -> String
forall a. Pretty a => a -> String
prettyStr TITopExpr
expr
    String -> IO ()
putStrLn String
""
    String -> IO ()
putStrLn String
"=== End of Type Class Expansion AST ==="