{- |
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 = desugarExpr expr >>= evalExprDeep 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 [] = return []
expandLoads (expr:rest) = case expr of
  Load lib -> do
    libExprs <- loadLibraryFile lib
    expanded <- expandLoads libExprs
    restExpanded <- expandLoads rest
    return $ expanded ++ restExpanded
  LoadFile file -> do
    fileExprs <- loadFile file
    expanded <- expandLoads fileExprs
    restExpanded <- expandLoads rest
    return $ expanded ++ restExpanded
  _ -> do
    restExpanded <- expandLoads rest
    return $ expr : 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 = do
  -- Phase 1: Expand all Load/LoadFile recursively
  expanded <- expandLoads [topExpr]
  -- Phase 2-10: Process all expanded expressions through remaining pipeline
  evalExpandedTopExprsTyped env 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 exprs = evalExpandedTopExprsTyped' env exprs False 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 exprs printValues shouldDumpTyped = do
  opts <- 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)
  currentTypeEnv <- getTypeEnv
  currentClassEnv <- getClassEnv
  currentPatternEnv <- getPatternEnv

  -- Build environments from current expressions
  envResult <- buildEnvironments exprs

  -- Merge existing environments with newly built environments
  -- New definitions extend existing ones (can override)
  let newTypeEnv = ebrTypeEnv envResult
      -- If currentTypeEnv is empty, use builtinEnv as base
      baseTypeEnv = if null (envToList currentTypeEnv) then builtinEnv else currentTypeEnv
      mergedTypeEnv = extendEnvMany (envToList newTypeEnv) baseTypeEnv
      mergedClassEnv = mergeClassEnv currentClassEnv (ebrClassEnv envResult)
      -- Merge pattern environments (new definitions can override)
      -- Pattern constructors from ebrPatternConstructorEnv and pattern functions from ebrPatternTypeEnv
      patternConstructorEnv = ebrPatternConstructorEnv envResult
      newPatternFuncEnv = ebrPatternTypeEnv envResult
  
  -- Get current pattern function environment
  currentPatternFuncEnv <- getPatternFuncEnv
  
  let -- Merge both into a single pattern environment
      mergedPatternEnv = foldr (\(name, scheme) env -> extendPatternEnv name scheme env) 
                               (foldr (\(name, scheme) env -> extendPatternEnv name scheme env)
                                      currentPatternEnv
                                      (patternEnvToList patternConstructorEnv))
                               (patternEnvToList newPatternFuncEnv)
      -- Also update pattern function environment separately
      mergedPatternFuncEnv = foldr (\(name, scheme) env -> extendPatternEnv name scheme env)
                                   currentPatternFuncEnv
                                   (patternEnvToList newPatternFuncEnv)

  -- Update EvalState with merged environments
  setTypeEnv mergedTypeEnv
  setClassEnv mergedClassEnv
  setPatternEnv mergedPatternEnv
  setPatternFuncEnv mergedPatternFuncEnv
  
  -- Register constructors to EvalState
  forM_ (HashMap.toList (ebrConstructorEnv envResult)) $ \(ctorName, ctorInfo) ->
    registerConstructor ctorName ctorInfo
  
  -- Dump environment if requested
  when (optDumpEnv opts) $ do
    dumpEnvironment mergedTypeEnv mergedClassEnv (ebrConstructorEnv envResult) 
                    (ebrPatternConstructorEnv envResult) (ebrPatternTypeEnv envResult)
  
  -- Dump desugared AST if requested
  when (optDumpDesugared opts) $ do
    desugaredExprs <- desugarTopExprs exprs
    dumpDesugared (map Just desugaredExprs)
  
  -- Get the environments for type inference
  -- Permissive mode allows falling back to untyped evaluation on type errors
  let permissive = not (optTypeCheckStrict 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.
  ((allBindings, allPatFuncBindings, nonDefExprs), typedExprs, tiExprs, tcExprs) <- foldM (\((bindings, patFuncBindings, nonDefs), typedExprs, tiExprs, tcExprs) expr -> do
    -- Get current type and class environments from EvalState
    currentTypeEnv <- getTypeEnv
    currentClassEnv <- getClassEnv
    
    -- Phase 3-4: Desugar (TopExpr → ITopExpr)
    mITopExpr <- desugarTopExpr expr
    
    case mITopExpr of
      Nothing -> return ((bindings, patFuncBindings, nonDefs), typedExprs, tiExprs, tcExprs)  -- No desugared output
      Just iTopExpr -> do
        -- Phase 5-6: Type Inference (ITopExpr → TypedITopExpr)
        let inferConfig = if permissive then permissiveInferConfig else defaultInferConfig
        -- Get the current pattern environment from EvalState
        currentPatternEnv' <- getPatternEnv
        currentPatternFuncEnv' <- getPatternFuncEnv
        -- Add pattern function types to inferEnv so they can be referenced as variables
        let patternFuncBindings = [(stringToVar name, scheme) | (name, scheme) <- patternEnvToList currentPatternFuncEnv']
            enrichedTypeEnv = extendEnvMany patternFuncBindings currentTypeEnv
            initState = (initialInferStateWithConfig inferConfig) {
              inferEnv = enrichedTypeEnv,
              inferClassEnv = currentClassEnv,
              inferPatternEnv = currentPatternEnv',
              inferPatternFuncEnv = currentPatternFuncEnv'
            }
        (result, warnings, finalState) <- liftIO $ 
          runInferWithWarningsAndState (inferITopExpr iTopExpr) initState
        
        let updatedTypeEnv = inferEnv finalState
        let updatedClassEnv = inferClassEnv finalState
        let updatedPatternEnv = inferPatternEnv finalState
        let updatedPatternFuncEnv = inferPatternFuncEnv finalState
    
        -- Print type warnings if any
        when (not (null warnings)) $ do
          liftIO $ mapM_ (hPutStrLn stderr . formatTypeWarning) warnings
        
        -- Update type, class, and pattern environments in EvalState
        setTypeEnv updatedTypeEnv
        setClassEnv updatedClassEnv
        setPatternEnv updatedPatternEnv
        setPatternFuncEnv updatedPatternFuncEnv
        
        case result of
          Left err -> do
            liftIO $ hPutStrLn stderr $ "Type error:\n" ++ formatTypeError err
            -- Fallback: Use untyped evaluation if type checking fails (permissive mode)
            -- Type errors are handled immediately, not collected
            topExpr' <- desugarTopExpr expr
            case topExpr' of
              Nothing -> return ((bindings, patFuncBindings, nonDefs), typedExprs, tiExprs, tcExprs)
              Just topExpr'' -> do
                -- Evaluate type-error expressions immediately (not collected)
                -- This is a fallback for permissive mode
                case topExpr'' of
                  IDefine name expr ->
                    return ((bindings ++ [(name, expr)], patFuncBindings, nonDefs), typedExprs, tiExprs, tcExprs)
                  IDefineMany defs ->
                    return ((bindings ++ defs, patFuncBindings, nonDefs), typedExprs, tiExprs, tcExprs)
                  IPatternFunctionDecl name _tyVars params _retType body ->
                    let paramNames = map fst params
                        patternFuncExpr = IPatternFuncExpr paramNames body
                    in return ((bindings, patFuncBindings ++ [(name, patternFuncExpr)], nonDefs), typedExprs, tiExprs, tcExprs)
                  _ ->
                    -- Non-definition: collect for later evaluation
                    return ((bindings, patFuncBindings, nonDefs ++ [(topExpr'', printValues)]), typedExprs, tiExprs, tcExprs)

          Right (Nothing, _subst) ->
            -- No code generated (e.g., load statements that are already processed)
            return ((bindings, patFuncBindings, nonDefs), typedExprs, tiExprs, tcExprs)
          
          Right (Just tiTopExpr, _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' = if optDumpTyped opts then typedExprs ++ [Just tiTopExpr] else typedExprs

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

            case mTiTopExprAfterTensorMap of
              Nothing ->
                -- Load/LoadFile statements - no evaluation needed
                return ((bindings, patFuncBindings, nonDefs), typedExprs', tiExprs, tcExprs)

              Just tiTopExprAfterTensorMap -> do
                -- Collect TensorMap-inserted AST for --dump-ti (after TensorMap insertion)
                let tiExprs' = if optDumpTi opts then tiExprs ++ [Just tiTopExprAfterTensorMap] else tiExprs

                -- Phase 8b: Type Class Expansion
                -- Expand type class method calls to dictionary-based dispatch
                mTcTopExprAfterTypeClass <- desugarTypedTopExprT_TypeClassOnly tiTopExprAfterTensorMap

                case mTcTopExprAfterTypeClass of
                  Nothing ->
                    -- Load/LoadFile statements - no evaluation needed
                    return ((bindings, patFuncBindings, nonDefs), typedExprs', tiExprs', tcExprs)

                  Just tcTopExprAfterTypeClass -> do
                    -- Collect TypeClass-expanded AST for --dump-tc (after TypeClass expansion)
                    let tcExprs' = if optDumpTc opts then tcExprs ++ [Just tcTopExprAfterTypeClass] else tcExprs

                    -- Extract ITopExpr for evaluation
                    let iTopExprExpanded = stripTypeTopExpr 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 iTopExprExpanded of
                      IDefine name expr ->
                        -- Collect definition for later binding
                        return ((bindings ++ [(name, expr)], patFuncBindings, nonDefs), typedExprs', tiExprs', tcExprs')
                      IDefineMany defs ->
                        -- Collect multiple definitions for later binding
                        return ((bindings ++ defs, patFuncBindings, nonDefs), typedExprs', tiExprs', tcExprs')
                      IPatternFunctionDecl name _tyVars params _retType 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 = map fst params
                            patternFuncExpr = IPatternFuncExpr paramNames body
                        in return ((bindings, patFuncBindings ++ [(name, patternFuncExpr)], nonDefs), typedExprs', tiExprs', tcExprs')
                      _ ->
                        -- Non-definition expressions (ITest, IExecute)
                        -- Collect for evaluation after all definitions are bound
                        return ((bindings, patFuncBindings, nonDefs ++ [(iTopExprExpanded, printValues)]), typedExprs', tiExprs', tcExprs')
    ) (([], [], []), [], [], []) 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
  when (optDumpTyped opts && shouldDumpTyped) $ do
    dumpTyped typedExprs

  when (optDumpTi opts && shouldDumpTyped) $ do
    dumpTi tiExprs

  when (optDumpTc opts && shouldDumpTyped) $ do
    dumpTc 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.
  envWithPatFuncs <- recursiveBindAll env allBindings allPatFuncBindings

  -- Phase 10: Evaluate non-definition expressions in order
  (lastVal, finalEnv) <- foldM (\(lastVal, currentEnv) (iExpr, shouldPrint) -> do
      evalResult <- catchError
        (Right <$> evalTopExpr' currentEnv iExpr)
        (\err -> do
          liftIO $ hPutStrLn stderr $ "Evaluation error: " ++ show err
          return $ Left err)

      case evalResult of
        Left _ -> return (lastVal, currentEnv)
        Right (mVal, env'') -> do
          when shouldPrint $ case mVal of
            Nothing -> return ()
            Just val -> valueToStr val >>= liftIO . putStrLn
          return (mVal, env'')
    ) (Nothing, envWithPatFuncs) nonDefExprs

  return (lastVal, 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 = do
  (val, env') <- evalTopExpr env topExpr
  case val of
    Nothing  -> return (Nothing, env')
    Just val -> do str <- valueToStr val
                   return (Just str, env')

valueToStr :: EgisonValue -> EvalM String
valueToStr val = do
  mathExpr <- asks optMathExpr
  case mathExpr of
    Nothing   -> return (show val)
    Just lang -> return (prettyMath lang val)

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

-- | Evaluate Egison top expressions with control over printing and dumping.
evalTopExprs' :: Env -> [TopExpr] -> Bool -> Bool -> EvalM Env
evalTopExprs' env exprs printValues shouldDumpTyped = do
  -- Expand all Load/LoadFile recursively
  expanded <- expandLoads exprs
  -- Evaluate using typed pipeline with printing
  (_, env') <- evalExpandedTopExprsTyped' env expanded printValues shouldDumpTyped
  return env'

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

-- | Evaluate an Egison expression. Input is a Haskell string.
runExpr :: Env -> String -> EvalM EgisonValue
runExpr env input =
  readExpr input >>= evalExpr env

-- | Evaluate an Egison top expression. Input is a Haskell string.
runTopExpr :: Env -> String -> EvalM (Maybe EgisonValue, Env)
runTopExpr env input =
  readTopExpr input >>= evalTopExpr env

-- | Evaluate an Egison top expression. Input is a Haskell string.
runTopExprStr :: Env -> String -> EvalM (Maybe String, Env)
runTopExprStr env input =
  readTopExpr input >>= evalTopExprStr env

-- | Evaluate Egison top expressions. Input is a Haskell string.
runTopExprs :: Env -> String -> EvalM Env
runTopExprs env input =
  readTopExprs input >>= evalTopExprs env

-- | Load an Egison file.
loadEgisonFile :: Env -> FilePath -> EvalM Env
loadEgisonFile env path = do
  (_, env') <- evalTopExpr env (LoadFile path)
  return env'

-- | Load an Egison library.
loadEgisonLibrary :: Env -> FilePath -> EvalM Env
loadEgisonLibrary env path = do
  (_, env') <- evalTopExpr env (Load path)
  return env'


--
-- Helper functions
--

collectDefs :: EgisonOpts -> [ITopExpr] -> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
collectDefs opts exprs = collectDefs' opts exprs [] [] []
  where
    collectDefs' :: EgisonOpts -> [ITopExpr] -> [(Var, IExpr)] -> [(String, IExpr)] -> [ITopExpr] -> EvalM ([(Var, IExpr)], [(String, IExpr)], [ITopExpr])
    collectDefs' opts (expr:exprs) bindings patFuncBindings rest =
      case expr of
        IDefine name expr -> collectDefs' opts exprs ((name, expr) : bindings) patFuncBindings rest
        IDefineMany defs  -> collectDefs' opts exprs (defs ++ bindings) patFuncBindings rest
        IPatternFunctionDecl name _tyVars params _retType body ->
          let paramNames = map fst params
              patternFuncExpr = IPatternFuncExpr paramNames body
          in collectDefs' opts exprs bindings ((name, patternFuncExpr) : patFuncBindings) rest
        ITest{}     -> collectDefs' opts exprs bindings patFuncBindings (expr : rest)
        IExecute{}  -> collectDefs' opts exprs bindings patFuncBindings (expr : rest)
        ILoadFile _ | optNoIO opts -> throwError (Default "No IO support")
        ILoadFile file -> do
          exprs' <- loadFile file >>= desugarTopExprs
          collectDefs' opts (exprs' ++ exprs) bindings patFuncBindings rest
        ILoad _ | optNoIO opts -> throwError (Default "No IO support")
        ILoad file -> do
          exprs' <- loadLibraryFile file >>= desugarTopExprs
          collectDefs' opts (exprs' ++ exprs) bindings patFuncBindings rest
        _ -> collectDefs' opts exprs bindings patFuncBindings rest
    collectDefs' _ [] bindings patFuncBindings rest = return (bindings, patFuncBindings, reverse rest)

evalTopExpr' :: Env -> ITopExpr -> EvalM (Maybe EgisonValue, Env)
evalTopExpr' env (IDefine name expr) = do
  env' <- recursiveBind env [(name, expr)]
  return (Nothing, env')
evalTopExpr' env (IDefineMany defs) = do
  env' <- recursiveBind env defs
  return (Nothing, env')
evalTopExpr' env (ITest expr) = do
  pushFuncName (stringToVar "<stdin>")
  val <- evalExprDeep env expr
  popFuncName
  return (Just val, env)
evalTopExpr' env (IExecute expr) = do
  pushFuncName (stringToVar "<stdin>")
  io <- evalExprShallow env expr
  case io of
    Value (IOFunc m) -> m >> popFuncName >> return (Nothing, env)
    _                -> throwErrorWithTrace (TypeMismatch "io" io)
evalTopExpr' env (ILoad file) = do
  opts <- ask
  when (optNoIO opts) $ throwError (Default "No IO support")
  exprs <- loadLibraryFile file >>= desugarTopExprs
  (bindings, patFuncBindings, _) <- collectDefs opts exprs
  env' <- recursiveBindAll env bindings patFuncBindings
  return (Nothing, env')
evalTopExpr' env (ILoadFile file) = do
  opts <- ask
  when (optNoIO opts) $ throwError (Default "No IO support")
  exprs <- loadFile file >>= desugarTopExprs
  (bindings, patFuncBindings, _) <- collectDefs opts exprs
  env' <- recursiveBindAll env bindings patFuncBindings
  return (Nothing, env')
evalTopExpr' env (IDeclareSymbol _names _mType) = do
  -- Symbol declarations are only used during type inference
  -- At runtime, they don't produce any value or modify the environment
  return (Nothing, env)
evalTopExpr' _env (IPatternFunctionDecl name _ _ _ _) = do
  -- Pattern function declarations are now handled via recursiveBind
  -- They should not reach here; this is a fallback
  throwError $ Default $ "Pattern function " ++ name ++ " 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 ctorEnv patternCtorEnv patternEnv = do
  liftIO $ do
    putStrLn "=== Environment Information (Phase 2: Environment Building) ==="
    putStrLn ""
    
    -- 1. Type Signatures
    putStrLn "--- Type Signatures ---"
    let typeBindings = envToList typeEnv
    if null typeBindings
      then putStrLn "  (none)"
      else forM_ typeBindings $ \(Var varName indices, scheme) ->
        let displayName = if null indices 
                          then varName
                          else varName ++ concatMap (const "_") indices
        in putStrLn $ "  " ++ displayName ++ " : " ++ prettyTypeScheme scheme
    putStrLn ""
    
    -- 2. Type Classes
    putStrLn "--- Type Classes ---"
    let classBindings = classEnvToList classEnv
    if null classBindings
      then putStrLn "  (none)"
      else forM_ classBindings $ \(className, classInfo) -> do
        let paramName = case Types.classParam classInfo of
              Types.TyVar name -> name
        putStrLn $ "  class " ++ className ++ " " ++ paramName ++ " where"
        forM_ (Types.classMethods classInfo) $ \(methName, methType) ->
          putStrLn $ "    " ++ methName ++ " : " ++ prettyType methType
    putStrLn ""
    
    -- 3. Instances
    putStrLn "--- Type Class Instances ---"
    let allInstances = concatMap (\(clsName, _) -> 
          map (\inst -> (clsName, inst)) (lookupInstances clsName classEnv)) classBindings
    if null allInstances
      then putStrLn "  (none)"
      else forM_ allInstances $ \(className, instInfo) -> do
        let contextStr = if null (Types.instContext instInfo)
              then ""
              else let showConstraint (Types.Constraint cls ty) = cls ++ " " ++ prettyType ty
                   in intercalate ", " (map showConstraint (Types.instContext instInfo)) ++ " => "
        putStrLn $ "  instance " ++ contextStr ++ className ++ " " ++ prettyType (Types.instType instInfo)
    putStrLn ""
    
    -- 4. Data Constructors
    putStrLn "--- Data Constructors ---"
    let ctorBindings = HashMap.toList ctorEnv
    if null ctorBindings
      then putStrLn "  (none)"
      else forM_ ctorBindings $ \(ctorName, ctorInfo) -> do
        let typeParams = ctorTypeParams ctorInfo
        let retType = if null typeParams
              then ctorTypeName ctorInfo
              else ctorTypeName ctorInfo ++ " " ++ unwords typeParams
        let ctorType = if null (ctorArgTypes ctorInfo)
              then retType
              else intercalate " -> " (map prettyType (ctorArgTypes ctorInfo) ++ [retType])
        putStrLn $ "  " ++ ctorName ++ " : " ++ ctorType
    putStrLn ""
    
    -- 5. Pattern Constructors
    putStrLn "--- Pattern Constructors ---"
    let patternCtorBindings = patternEnvToList patternCtorEnv
    if null patternCtorBindings
      then putStrLn "  (none)"
      else forM_ patternCtorBindings $ \(ctorName, scheme) ->
        putStrLn $ "  " ++ ctorName ++ " : " ++ prettyTypeScheme scheme
    putStrLn ""
    
    -- 6. Pattern Functions
    putStrLn "--- Pattern Functions ---"
    let patternBindings = patternEnvToList patternEnv
    if null patternBindings
      then putStrLn "  (none)"
      else forM_ patternBindings $ \(name, scheme) ->
        putStrLn $ "  " ++ name ++ " : " ++ prettyTypeScheme scheme
    putStrLn ""
    
    putStrLn "=== End of Environment Information ==="

-- | Dump desugared AST after Phase 3 (Desugaring)
dumpDesugared :: [Maybe ITopExpr] -> EvalM ()
dumpDesugared desugaredExprs = do
  liftIO $ do
    putStrLn "=== Desugared AST (Phase 3: Desugaring) ==="
    putStrLn ""
    if null desugaredExprs
      then putStrLn "  (none)"
      else forM_ (zip [1 :: Int ..] desugaredExprs) $ \(i :: Int, mExpr) ->
        case mExpr of
          Nothing -> putStrLn $ "  [" ++ show i ++ "] (skipped)"
          Just expr -> putStrLn $ "  [" ++ show i ++ "] " ++ prettyStr expr
    putStrLn ""
    putStrLn "=== End of Desugared AST ==="

-- | Dump typed AST after Phase 6 (Type Inference & Check)
dumpTyped :: [Maybe TITopExpr] -> EvalM ()
dumpTyped typedExprs = do
  liftIO $ do
    putStrLn "=== Typed AST (Phase 5-6: Type Inference) ==="
    putStrLn ""
    if null typedExprs
      then putStrLn "  (none)"
      else forM_ (zip [1 :: Int ..] typedExprs) $ \(i :: Int, mExpr) ->
        case mExpr of
          Nothing -> putStrLn $ "  [" ++ show i ++ "] (skipped)"
          Just expr -> do
            putStrLn $ "  [" ++ show i ++ "] " ++ prettyStr expr
    putStrLn ""
    putStrLn "=== End of Typed AST ==="

dumpTi :: [Maybe TITopExpr] -> EvalM ()
dumpTi tiExprs = do
  liftIO $ do
    putStrLn "=== Typed AST after TensorMap Insertion (Phase 8a) ==="
    putStrLn ""
    if null tiExprs
      then putStrLn "  (none)"
      else forM_ (zip [1 :: Int ..] tiExprs) $ \(i :: Int, mExpr) ->
        case mExpr of
          Nothing -> putStrLn $ "  [" ++ show i ++ "] (skipped)"
          Just expr -> do
            putStrLn $ "  [" ++ show i ++ "] " ++ prettyStr expr
    putStrLn ""
    putStrLn "=== End of TensorMap Insertion AST ==="

dumpTc :: [Maybe TITopExpr] -> EvalM ()
dumpTc tcExprs = do
  liftIO $ do
    putStrLn "=== Typed AST after Type Class Expansion (Phase 8b) ==="
    putStrLn ""
    if null tcExprs
      then putStrLn "  (none)"
      else forM_ (zip [1 :: Int ..] tcExprs) $ \(i :: Int, mExpr) ->
        case mExpr of
          Nothing -> putStrLn $ "  [" ++ show i ++ "] (skipped)"
          Just expr -> do
            putStrLn $ "  [" ++ show i ++ "] " ++ prettyStr expr
    putStrLn ""
    putStrLn "=== End of Type Class Expansion AST ==="