{- |
Module      : Language.Egison.Type.TypeClassExpand
Licence     : MIT

This module expands type class method calls using type information from TIExpr.
It transforms TIExpr to TIExpr, replacing type class method calls with
dictionary-based dispatch.

Pipeline: Phase 8 (TypedDesugar) - TypeClassExpand (first step)
This is executed before TensorMapInsertion to resolve type class methods
to concrete functions first.

For example, if we have:
  class Eq a where (==) : a -> a -> Bool
  instance Eq Integer where (==) x y := x = y

Then a call like:
  autoEq 1 2  (with type constraint: Eq Integer)
becomes:
  eqIntegerEq 1 2  (dictionary-based dispatch)

This eliminates the need for runtime dispatch functions like resolveEq.
-}

module Language.Egison.Type.TypeClassExpand
  ( expandTypeClassMethodsT
  , expandTypeClassMethodsInPattern
  , addDictionaryParametersT
  , applyConcreteConstraintDictionaries
  , applyConcreteConstraintDictionariesInPattern
  ) where

import           Data.Char                  (toLower)
import           Data.List                  (find)
import           Data.Maybe                 (mapMaybe)
import           Data.Text                  (pack)
import           Control.Monad              (mplus)
import qualified Data.Set                   as Set

import           Language.Egison.AST        (ConstantExpr(..))
import           Language.Egison.Data       (EvalM)
import           Language.Egison.EvalState  (MonadEval(..))
import           Language.Egison.IExpr      (TIExpr(..), TIExprNode(..), IExpr(..), stringToVar,
                                             Index(..), tiExprType, tiScheme, tiExprNode,
                                             TIPattern(..), TIPatternNode(..), TILoopRange(..))
import           Language.Egison.Type.Env  (ClassEnv(..), ClassInfo(..), InstanceInfo(..),
                                             lookupInstances, lookupClass, lookupEnv)
import qualified Language.Egison.Type.Types as Types
import           Language.Egison.Type.Types (Type(..), TyVar(..), TypeScheme(..), Constraint(..), typeToName, typeConstructorName,
                                            sanitizeMethodName, freeTyVars)
import           Language.Egison.Type.Instance (findMatchingInstanceForType)

-- ============================================================================
-- Helper Functions (shared across the module)
-- ============================================================================

-- | Extract type variable substitutions from instance type and actual type
-- Example: [a] -> [[Integer]] gives [(a, [Integer])]
extractTypeSubstitutions :: Type -> Type -> [(TyVar, Type)]
extractTypeSubstitutions :: Type -> Type -> [(TyVar, Type)]
extractTypeSubstitutions Type
instTy Type
actualTy = Type -> Type -> [(TyVar, Type)]
go Type
instTy Type
actualTy
  where
    go :: Type -> Type -> [(TyVar, Type)]
go (TVar TyVar
v) Type
actual = [(TyVar
v, Type
actual)]
    go (TCollection Type
instElem) (TCollection Type
actualElem) = Type -> Type -> [(TyVar, Type)]
go Type
instElem Type
actualElem
    go (TTuple [Type]
instTypes) (TTuple [Type]
actualTypes)
      | [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
instTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
actualTypes =
          ((Type, Type) -> [(TyVar, Type)])
-> [(Type, Type)] -> [(TyVar, Type)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Type
i, Type
a) -> Type -> Type -> [(TyVar, Type)]
go Type
i Type
a) ([Type] -> [Type] -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
instTypes [Type]
actualTypes)
    go (TInductive String
_ [Type]
instArgs) (TInductive String
_ [Type]
actualArgs)
      | [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
instArgs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
actualArgs =
          ((Type, Type) -> [(TyVar, Type)])
-> [(Type, Type)] -> [(TyVar, Type)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Type
i, Type
a) -> Type -> Type -> [(TyVar, Type)]
go Type
i Type
a) ([Type] -> [Type] -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
instArgs [Type]
actualArgs)
    go (TTensor Type
instElem) (TTensor Type
actualElem) = Type -> Type -> [(TyVar, Type)]
go Type
instElem Type
actualElem
    go (TFun Type
instArg Type
instRet) (TFun Type
actualArg Type
actualRet) =
      Type -> Type -> [(TyVar, Type)]
go Type
instArg Type
actualArg [(TyVar, Type)] -> [(TyVar, Type)] -> [(TyVar, Type)]
forall a. [a] -> [a] -> [a]
++ Type -> Type -> [(TyVar, Type)]
go Type
instRet Type
actualRet
    go (THash Type
instK Type
instV) (THash Type
actualK Type
actualV) =
      Type -> Type -> [(TyVar, Type)]
go Type
instK Type
actualK [(TyVar, Type)] -> [(TyVar, Type)] -> [(TyVar, Type)]
forall a. [a] -> [a] -> [a]
++ Type -> Type -> [(TyVar, Type)]
go Type
instV Type
actualV
    go (TMatcher Type
instT) (TMatcher Type
actualT) = Type -> Type -> [(TyVar, Type)]
go Type
instT Type
actualT
    go (TIO Type
instT) (TIO Type
actualT) = Type -> Type -> [(TyVar, Type)]
go Type
instT Type
actualT
    go (TIORef Type
instT) (TIORef Type
actualT) = Type -> Type -> [(TyVar, Type)]
go Type
instT Type
actualT
    go Type
TPort Type
TPort = []
    go Type
_ Type
_ = []

-- | Apply type substitutions to a constraint
applySubstsToConstraint :: [(TyVar, Type)] -> Constraint -> Constraint
applySubstsToConstraint :: [(TyVar, Type)] -> Constraint -> Constraint
applySubstsToConstraint [(TyVar, Type)]
substs (Constraint String
cName Type
cType) =
  String -> Type -> Constraint
Constraint String
cName ([(TyVar, Type)] -> Type -> Type
applySubstsToType [(TyVar, Type)]
substs Type
cType)

-- | Apply type substitutions to a type
applySubstsToType :: [(TyVar, Type)] -> Type -> Type
applySubstsToType :: [(TyVar, Type)] -> Type -> Type
applySubstsToType [(TyVar, Type)]
substs = Type -> Type
go
  where
    go :: Type -> Type
go t :: Type
t@(TVar TyVar
v) = case TyVar -> [(TyVar, Type)] -> Maybe Type
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TyVar
v [(TyVar, Type)]
substs of
                      Just Type
newType -> Type
newType
                      Maybe Type
Nothing -> Type
t
    go Type
TInt = Type
TInt
    go Type
TFloat = Type
TFloat
    go Type
TBool = Type
TBool
    go Type
TChar = Type
TChar
    go Type
TString = Type
TString
    go (TCollection Type
t) = Type -> Type
TCollection (Type -> Type
go Type
t)
    go (TTuple [Type]
ts) = [Type] -> Type
TTuple ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
go [Type]
ts)
    go (TInductive String
name [Type]
ts) = String -> [Type] -> Type
TInductive String
name ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
go [Type]
ts)
    go (TTensor Type
t) = Type -> Type
TTensor (Type -> Type
go Type
t)
    go (THash Type
k Type
v) = Type -> Type -> Type
THash (Type -> Type
go Type
k) (Type -> Type
go Type
v)
    go (TMatcher Type
t) = Type -> Type
TMatcher (Type -> Type
go Type
t)
    go (TFun Type
t1 Type
t2) = Type -> Type -> Type
TFun (Type -> Type
go Type
t1) (Type -> Type
go Type
t2)
    go (TIO Type
t) = Type -> Type
TIO (Type -> Type
go Type
t)
    go (TIORef Type
t) = Type -> Type
TIORef (Type -> Type
go Type
t)
    go Type
TPort = Type
TPort
    go Type
TAny = Type
TAny

-- | Get the arity of a function type (number of parameters)
getMethodArity :: Type -> Int
getMethodArity :: Type -> Int
getMethodArity (TFun Type
_ Type
t2) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Type -> Int
getMethodArity Type
t2
getMethodArity Type
_ = Int
0

-- | Get parameter types from a function type
getParamTypes :: Type -> [Type]
getParamTypes :: Type -> [Type]
getParamTypes (TFun Type
t1 Type
t2) = Type
t1 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
getParamTypes Type
t2
getParamTypes Type
_ = []

-- | Apply N parameters to a function type and get the result type
-- applyParamsToType (a -> b -> c) 2 = c
-- applyParamsToType (a -> b -> c) 1 = b -> c
applyParamsToType :: Type -> Int -> Type
applyParamsToType :: Type -> Int -> Type
applyParamsToType (TFun Type
_ Type
t2) Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Type -> Int -> Type
applyParamsToType Type
t2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
applyParamsToType Type
t Int
_ = Type
t  -- n == 0 or no more function types

-- | Lowercase first character of a string
lowerFirst :: String -> String
lowerFirst :: String -> String
lowerFirst [] = []
lowerFirst (Char
c:String
cs) = Char -> Char
toLower Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs

-- | Find a constraint that provides the given method
findConstraintForMethod :: ClassEnv -> String -> [Constraint] -> Maybe Constraint
findConstraintForMethod :: ClassEnv -> String -> [Constraint] -> Maybe Constraint
findConstraintForMethod ClassEnv
env String
methodName [Constraint]
cs =
  (Constraint -> Bool) -> [Constraint] -> Maybe Constraint
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Constraint String
className Type
_) ->
    case String -> ClassEnv -> Maybe ClassInfo
lookupClass String
className ClassEnv
env of
      Just ClassInfo
classInfo -> String
methodName String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((String, Type) -> String) -> [(String, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> String
forall a b. (a, b) -> a
fst (ClassInfo -> [(String, Type)]
classMethods ClassInfo
classInfo)
      Maybe ClassInfo
Nothing -> Bool
False
  ) [Constraint]
cs

-- ============================================================================
-- Main Type Class Expansion
-- ============================================================================

-- | Expand type class method calls in a typed expression (TIExpr)
-- This function recursively processes TIExpr and replaces type class method calls
-- with dictionary-based dispatch.
expandTypeClassMethodsT :: TIExpr -> EvalM TIExpr
expandTypeClassMethodsT :: TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
tiExpr = do
  ClassEnv
classEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) ClassEnv
forall (m :: * -> *). MonadEval m => m ClassEnv
getClassEnv
  let scheme :: TypeScheme
scheme = TIExpr -> TypeScheme
tiScheme TIExpr
tiExpr
  -- Recursively process the TIExprNode with constraint information
  TIExprNode
expandedNode <- ClassEnv -> TypeScheme -> TIExprNode -> EvalM TIExprNode
expandTIExprNodeWithConstraints ClassEnv
classEnv TypeScheme
scheme (TIExpr -> TIExprNode
tiExprNode TIExpr
tiExpr)
  TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
scheme TIExprNode
expandedNode
  where
    -- Expand TIExprNode with constraint information from TypeScheme
    -- Note: Constraints from parent are not propagated - each node uses its own constraints
    expandTIExprNodeWithConstraints :: ClassEnv -> TypeScheme -> TIExprNode -> EvalM TIExprNode
    expandTIExprNodeWithConstraints :: ClassEnv -> TypeScheme -> TIExprNode -> EvalM TIExprNode
expandTIExprNodeWithConstraints ClassEnv
classEnv' (Forall [TyVar]
_vars [Constraint]
_constraints Type
_ty) TIExprNode
node =
      ClassEnv -> TIExprNode -> EvalM TIExprNode
expandTIExprNode ClassEnv
classEnv' TIExprNode
node

    -- Expand TIExprNode without parent constraints
    -- Each child expression uses only its own constraints from type inference
    expandTIExprNode :: ClassEnv -> TIExprNode -> EvalM TIExprNode
    expandTIExprNode :: ClassEnv -> TIExprNode -> EvalM TIExprNode
expandTIExprNode ClassEnv
classEnv' TIExprNode
node = case TIExprNode
node of
      -- Constants and variables: no expansion needed at node level
      -- (TIVarExpr expansion is handled at TIExpr level in expandTIExprWithConstraints)
      TIConstantExpr ConstantExpr
c -> TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ ConstantExpr -> TIExprNode
TIConstantExpr ConstantExpr
c
      TIVarExpr String
name -> TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ String -> TIExprNode
TIVarExpr String
name
      
      -- Lambda expressions: process body with its own constraints only
      TILambdaExpr Maybe Var
mVar [Var]
params TIExpr
body -> do
        -- Use only the body's own constraints (no parent constraints)
        -- Type inference has already assigned correct constraints to each expression
        TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
mVar [Var]
params TIExpr
body'
      
      -- Application: check if it's a method call or constrained function call
      TIApplyExpr TIExpr
func [TIExpr]
args -> do
        -- First, expand the arguments (each uses its own constraints)
        [TIExpr]
args' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv') [TIExpr]
args

        case TIExpr -> TIExprNode
tiExprNode TIExpr
func of
          TIVarExpr String
methodName -> do
            -- Try to resolve if func is a method call using func's own constraints
            let (Forall [TyVar]
_ [Constraint]
funcConstraints Type
_) = TIExpr -> TypeScheme
tiScheme TIExpr
func
            Maybe TIExprNode
resolved <- ClassEnv
-> [Constraint] -> String -> [TIExpr] -> EvalM (Maybe TIExprNode)
tryResolveMethodCall ClassEnv
classEnv' [Constraint]
funcConstraints String
methodName [TIExpr]
args'
            case Maybe TIExprNode
resolved of
              Just TIExprNode
result -> TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExprNode
result
              Maybe TIExprNode
Nothing -> do
                -- Not a method call - process recursively
                -- Note: Dictionary application for constrained functions
                -- is handled in TIVarExpr case of expandTIExprWithConstraints
                TIExpr
func' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
func
                TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
func' [TIExpr]
args'
          TIExprNode
_ -> do
            -- Not a simple variable: process recursively
            TIExpr
func' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
func
            TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
func' [TIExpr]
args'
      
      -- Collections
      TITupleExpr [TIExpr]
exprs -> do
        [TIExpr]
exprs' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv') [TIExpr]
exprs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIExpr] -> TIExprNode
TITupleExpr [TIExpr]
exprs'

      TICollectionExpr [TIExpr]
exprs -> do
        [TIExpr]
exprs' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv') [TIExpr]
exprs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIExpr] -> TIExprNode
TICollectionExpr [TIExpr]
exprs'

      -- Control flow
      TIIfExpr TIExpr
cond TIExpr
thenExpr TIExpr
elseExpr -> do
        TIExpr
cond' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
cond
        TIExpr
thenExpr' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
thenExpr
        TIExpr
elseExpr' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
elseExpr
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExpr -> TIExprNode
TIIfExpr TIExpr
cond' TIExpr
thenExpr' TIExpr
elseExpr'

      -- Let bindings
      TILetExpr [TIBindingExpr]
bindings TIExpr
body -> do
        [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
v, TIExpr
e) -> do
          TIExpr
e' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
e
          TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
v, TIExpr
e')) [TIBindingExpr]
bindings
        TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIExpr -> TIExprNode
TILetExpr [TIBindingExpr]
bindings' TIExpr
body'

      TILetRecExpr [TIBindingExpr]
bindings TIExpr
body -> do
        [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
v, TIExpr
e) -> do
          TIExpr
e' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
e
          TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
v, TIExpr
e')) [TIBindingExpr]
bindings
        TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIExpr -> TIExprNode
TILetRecExpr [TIBindingExpr]
bindings' TIExpr
body'

      TISeqExpr TIExpr
e1 TIExpr
e2 -> do
        TIExpr
e1' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
e1
        TIExpr
e2' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
e2
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExprNode
TISeqExpr TIExpr
e1' TIExpr
e2'

      -- Collections
      TIConsExpr TIExpr
h TIExpr
t -> do
        TIExpr
h' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
h
        TIExpr
t' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
t
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExprNode
TIConsExpr TIExpr
h' TIExpr
t'

      TIJoinExpr TIExpr
l TIExpr
r -> do
        TIExpr
l' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
l
        TIExpr
r' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
r
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExprNode
TIJoinExpr TIExpr
l' TIExpr
r'
      
      TIHashExpr [(TIExpr, TIExpr)]
pairs -> do
        -- Dictionary hashes: process keys but NOT values
        -- Values should remain as simple method references
        [(TIExpr, TIExpr)]
pairs' <- ((TIExpr, TIExpr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr))
-> [(TIExpr, TIExpr)]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [(TIExpr, TIExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(TIExpr
k, TIExpr
v) -> do
          TIExpr
k' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
k
          -- Do NOT process v - dictionary values should not be expanded
          (TIExpr, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr
k', TIExpr
v)) [(TIExpr, TIExpr)]
pairs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [(TIExpr, TIExpr)] -> TIExprNode
TIHashExpr [(TIExpr, TIExpr)]
pairs'

      TIVectorExpr [TIExpr]
exprs -> do
        [TIExpr]
exprs' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv') [TIExpr]
exprs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIExpr] -> TIExprNode
TIVectorExpr [TIExpr]
exprs'

      -- More lambda-like constructs
      TIMemoizedLambdaExpr [String]
vars TIExpr
body -> do
        TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [String] -> TIExpr -> TIExprNode
TIMemoizedLambdaExpr [String]
vars TIExpr
body'

      TICambdaExpr String
var TIExpr
body -> do
        TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ String -> TIExpr -> TIExprNode
TICambdaExpr String
var TIExpr
body'

      TIWithSymbolsExpr [String]
syms TIExpr
body -> do
        TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [String] -> TIExpr -> TIExprNode
TIWithSymbolsExpr [String]
syms TIExpr
body'

      TIDoExpr [TIBindingExpr]
bindings TIExpr
body -> do
        [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
v, TIExpr
e) -> do
          TIExpr
e' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
e
          TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
v, TIExpr
e')) [TIBindingExpr]
bindings
        TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIExpr -> TIExprNode
TIDoExpr [TIBindingExpr]
bindings' TIExpr
body'

      -- Pattern matching
      TIMatchExpr PMMode
mode TIExpr
target TIExpr
matcher [TIMatchClause]
clauses -> do
        TIExpr
target' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
target
        TIExpr
matcher' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
matcher
        [TIMatchClause]
clauses' <- (TIMatchClause
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIMatchClause)
-> [TIMatchClause]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIMatchClause]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(TIPattern
pat, TIExpr
body) -> do
          TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat
          TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
          TIMatchClause
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIMatchClause
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPattern
pat', TIExpr
body')) [TIMatchClause]
clauses
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ PMMode -> TIExpr -> TIExpr -> [TIMatchClause] -> TIExprNode
TIMatchExpr PMMode
mode TIExpr
target' TIExpr
matcher' [TIMatchClause]
clauses'

      TIMatchAllExpr PMMode
mode TIExpr
target TIExpr
matcher [TIMatchClause]
clauses -> do
        TIExpr
target' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
target
        TIExpr
matcher' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
matcher
        [TIMatchClause]
clauses' <- (TIMatchClause
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIMatchClause)
-> [TIMatchClause]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIMatchClause]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(TIPattern
pat, TIExpr
body) -> do
          TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat
          TIExpr
body' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
body
          TIMatchClause
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIMatchClause
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPattern
pat', TIExpr
body')) [TIMatchClause]
clauses
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ PMMode -> TIExpr -> TIExpr -> [TIMatchClause] -> TIExprNode
TIMatchAllExpr PMMode
mode TIExpr
target' TIExpr
matcher' [TIMatchClause]
clauses'

      -- Tensor operations
      TITensorMapExpr TIExpr
func TIExpr
tensor -> do
        TIExpr
func' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
func
        TIExpr
tensor' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
tensor
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExprNode
TITensorMapExpr TIExpr
func' TIExpr
tensor'

      TITensorMap2Expr TIExpr
func TIExpr
t1 TIExpr
t2 -> do
        TIExpr
func' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
func
        TIExpr
t1' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
t1
        TIExpr
t2' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
t2
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExpr -> TIExprNode
TITensorMap2Expr TIExpr
func' TIExpr
t1' TIExpr
t2'

      TITensorMap2WedgeExpr TIExpr
func TIExpr
t1 TIExpr
t2 -> do
        TIExpr
func' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
func
        TIExpr
t1' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
t1
        TIExpr
t2' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
t2
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExpr -> TIExprNode
TITensorMap2WedgeExpr TIExpr
func' TIExpr
t1' TIExpr
t2'

      TIGenerateTensorExpr TIExpr
func TIExpr
shape -> do
        TIExpr
func' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
func
        TIExpr
shape' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
shape
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExprNode
TIGenerateTensorExpr TIExpr
func' TIExpr
shape'

      TITensorExpr TIExpr
shape TIExpr
elems -> do
        TIExpr
shape' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
shape
        TIExpr
elems' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
elems
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExprNode
TITensorExpr TIExpr
shape' TIExpr
elems'

      TITensorContractExpr TIExpr
tensor -> do
        TIExpr
tensor' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
tensor
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExprNode
TITensorContractExpr TIExpr
tensor'

      TITransposeExpr TIExpr
perm TIExpr
tensor -> do
        TIExpr
perm' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
perm
        TIExpr
tensor' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
tensor
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExprNode
TITransposeExpr TIExpr
perm' TIExpr
tensor'

      TIFlipIndicesExpr TIExpr
tensor -> do
        TIExpr
tensor' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
tensor
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExprNode
TIFlipIndicesExpr TIExpr
tensor'

      -- Quote expressions
      TIQuoteExpr TIExpr
e -> do
        TIExpr
e' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
e
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExprNode
TIQuoteExpr TIExpr
e'

      TIQuoteSymbolExpr TIExpr
e -> do
        TIExpr
e' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
e
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExprNode
TIQuoteSymbolExpr TIExpr
e'

      -- Indexed expressions
      TISubrefsExpr Bool
b TIExpr
base TIExpr
ref -> do
        TIExpr
base' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
base
        TIExpr
ref' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
ref
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Bool -> TIExpr -> TIExpr -> TIExprNode
TISubrefsExpr Bool
b TIExpr
base' TIExpr
ref'
      
      TISuprefsExpr Bool
b TIExpr
base TIExpr
ref -> do
        TIExpr
base' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
base
        TIExpr
ref' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
ref
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Bool -> TIExpr -> TIExpr -> TIExprNode
TISuprefsExpr Bool
b TIExpr
base' TIExpr
ref'

      TIUserrefsExpr Bool
b TIExpr
base TIExpr
ref -> do
        TIExpr
base' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
base
        TIExpr
ref' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
ref
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Bool -> TIExpr -> TIExpr -> TIExprNode
TIUserrefsExpr Bool
b TIExpr
base' TIExpr
ref'

      -- Other cases: return unchanged for now
      TIInductiveDataExpr String
name [TIExpr]
exprs -> do
        [TIExpr]
exprs' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv') [TIExpr]
exprs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ String -> [TIExpr] -> TIExprNode
TIInductiveDataExpr String
name [TIExpr]
exprs'

      TIMatcherExpr [TIPatternDef]
patDefs -> do
        -- Expand expressions inside matcher definitions
        -- patDefs is a list of (PrimitivePatPattern, TIExpr, [TIBindingExpr])
        -- where TIBindingExpr is (IPrimitiveDataPattern, TIExpr)
        [TIPatternDef]
patDefs' <- (TIPatternDef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIPatternDef)
-> [TIPatternDef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPatternDef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(PrimitivePatPattern
pat, TIExpr
matcherExpr, [TIBindingExpr]
bindings) -> do
          -- Expand the next-matcher expression
          TIExpr
matcherExpr' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
matcherExpr
          -- Expand expressions in primitive-data-match clauses
          [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
dp, TIExpr
expr) -> do
            TIExpr
expr' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
expr
            TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
dp, TIExpr
expr')) [TIBindingExpr]
bindings
          TIPatternDef
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIPatternDef
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitivePatPattern
pat, TIExpr
matcherExpr', [TIBindingExpr]
bindings')) [TIPatternDef]
patDefs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIPatternDef] -> TIExprNode
TIMatcherExpr [TIPatternDef]
patDefs'
      TIIndexedExpr Bool
override TIExpr
base [Index TIExpr]
indices -> do
        TIExpr
base' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
base
        -- Expand indices (which are already typed as TIExpr)
        [Index TIExpr]
indices' <- (Index TIExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) (Index TIExpr))
-> [Index TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Index TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((TIExpr -> EvalM TIExpr)
-> Index TIExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Index TIExpr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Index a -> f (Index b)
traverse (\TIExpr
tiexpr -> ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
tiexpr)) [Index TIExpr]
indices
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
override TIExpr
base' [Index TIExpr]
indices'

      TIWedgeApplyExpr TIExpr
func [TIExpr]
args -> do
        TIExpr
func' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
func
        [TIExpr]
args' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv') [TIExpr]
args
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIWedgeApplyExpr TIExpr
func' [TIExpr]
args'
      
      TIFunctionExpr [String]
names -> TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [String] -> TIExprNode
TIFunctionExpr [String]
names  -- Built-in function, no expansion needed
    
    -- Helper: expand a TIExpr using only its own constraints
    -- Parent constraints are not passed to avoid constraint accumulation
    expandTIExprWithConstraints :: ClassEnv -> TIExpr -> EvalM TIExpr
    expandTIExprWithConstraints :: ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
expr = do
      let scheme :: TypeScheme
scheme@(Forall [TyVar]
_ [Constraint]
exprConstraints Type
exprType) = TIExpr -> TypeScheme
tiScheme TIExpr
expr
          -- Use only the expression's own constraints
          -- Type inference has already assigned correct constraints to each expression
          allConstraints :: [Constraint]
allConstraints = [Constraint]
exprConstraints

      -- Special handling for TIVarExpr: eta-expand methods or apply dictionaries
      TIExprNode
expandedNode <- case TIExpr -> TIExprNode
tiExprNode TIExpr
expr of
        TIVarExpr String
varName -> do
          -- Check if this is a type class method
          case ClassEnv -> String -> [Constraint] -> Maybe Constraint
findConstraintForMethod ClassEnv
classEnv' String
varName [Constraint]
allConstraints of
            Just (Constraint String
className Type
tyArg) -> do
              -- Get method type to determine arity
              TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
              case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
varName) TypeEnv
typeEnv of
                Just (Forall [TyVar]
_ [Constraint]
_ Type
_ty) -> do
                  -- Use the expression's actual type (exprType) instead of the method's declared type (ty)
                  -- because eta-expansion should create parameters matching the expected usage context
                  let arity :: Int
arity = Type -> Int
getMethodArity Type
exprType
                      paramTypes :: [Type]
paramTypes = Type -> [Type]
getParamTypes Type
exprType
                      paramNames :: [String]
paramNames = [String
"etaVar" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [Int
1..Int
arity]]
                      paramVars :: [Var]
paramVars = (String -> Var) -> [String] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map String -> Var
stringToVar [String]
paramNames
                      paramExprs :: [TIExpr]
paramExprs = (String -> Type -> TIExpr) -> [String] -> [Type] -> [TIExpr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
n Type
t -> TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
t) (String -> TIExprNode
TIVarExpr String
n)) [String]
paramNames [Type]
paramTypes
                      methodKey :: String
methodKey = String -> String
sanitizeMethodName String
varName
                  
                  -- Determine dictionary name based on type
                  case Type
tyArg of
                    TVar (TyVar String
_v) -> do
                      -- Type variable: use dictionary parameter name (without type parameter)
                      TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
                      let dictParamName :: String
dictParamName = String
"dict_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className
                      -- Look up dictionary type from type environment
                      Type
dictHashType <- case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
dictParamName) TypeEnv
typeEnv of
                        Just (Forall [TyVar]
_ [Constraint]
_ Type
dictType) -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
dictType
                        Maybe TypeScheme
Nothing -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type)
-> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
THash Type
TString Type
TAny  -- Fallback
                      -- Get method type from ClassEnv instead of dictHashType
                      let methodType :: Type
methodType = ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
classEnv' String
className String
methodKey Type
tyArg
                          methodConstraint :: Constraint
methodConstraint = String -> Type -> Constraint
Constraint String
className Type
tyArg
                          methodScheme :: TypeScheme
methodScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall (Set TyVar -> [TyVar]
forall a. Set a -> [a]
Set.toList (Set TyVar -> [TyVar]) -> Set TyVar -> [TyVar]
forall a b. (a -> b) -> a -> b
$ Type -> Set TyVar
freeTyVars Type
tyArg) [Constraint
methodConstraint] Type
methodType
                          dictExpr :: TIExpr
dictExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (String -> TIExprNode
TIVarExpr String
dictParamName)
                          indexExpr :: TIExpr
indexExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
TString)
                                            (ConstantExpr -> TIExprNode
TIConstantExpr (Text -> ConstantExpr
StringExpr (String -> Text
pack String
methodKey)))
                          dictAccess :: TIExpr
dictAccess = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme (TIExprNode -> TIExpr) -> TIExprNode -> TIExpr
forall a b. (a -> b) -> a -> b
$
                                       Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
False TIExpr
dictExpr [TIExpr -> Index TIExpr
forall a. a -> Index a
Sub TIExpr
indexExpr]
                          -- Calculate result type after applying all parameters
                          resultType :: Type
resultType = Type -> Int -> Type
applyParamsToType Type
methodType ([TIExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TIExpr]
paramExprs)
                          -- Fully applied results don't need constraints
                          bodyScheme :: TypeScheme
bodyScheme = case Type
resultType of
                                         TFun Type
_ Type
_ -> TypeScheme
methodScheme  -- Partial application
                                         Type
_ -> [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
resultType  -- Fully applied: no constraints
                          body :: TIExpr
body = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
bodyScheme (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictAccess [TIExpr]
paramExprs)
                      TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
forall a. Maybe a
Nothing [Var]
paramVars TIExpr
body
                    Type
_ -> do
                      -- Concrete type: find matching instance
                      let instances :: [InstanceInfo]
instances = String -> ClassEnv -> [InstanceInfo]
lookupInstances String
className ClassEnv
classEnv'
                      case Type -> [InstanceInfo] -> Maybe InstanceInfo
findMatchingInstanceForType Type
tyArg [InstanceInfo]
instances of
                        Just InstanceInfo
inst -> do
                          -- Found instance: eta-expand with concrete dictionary
                          TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
                          let instTypeName :: String
instTypeName = Type -> String
typeConstructorName (InstanceInfo -> Type
instType InstanceInfo
inst)
                              dictName :: String
dictName = String -> String
lowerFirst String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
instTypeName

                          -- Look up dictionary type from type environment
                          Type
dictHashType <- case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
dictName) TypeEnv
typeEnv of
                            Just (Forall [TyVar]
_ [Constraint]
_ Type
dictType) -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
dictType
                            Maybe TypeScheme
Nothing -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type)
-> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
THash Type
TString Type
TAny  -- Fallback

                          -- Get method type from ClassEnv instead of dictHashType
                          let methodType :: Type
methodType = ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
classEnv' String
className String
methodKey Type
tyArg
                              methodConstraint :: Constraint
methodConstraint = String -> Type -> Constraint
Constraint String
className Type
tyArg
                              methodScheme :: TypeScheme
methodScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall (Set TyVar -> [TyVar]
forall a. Set a -> [a]
Set.toList (Set TyVar -> [TyVar]) -> Set TyVar -> [TyVar]
forall a b. (a -> b) -> a -> b
$ Type -> Set TyVar
freeTyVars Type
tyArg) [Constraint
methodConstraint] Type
methodType

                          -- Check if instance has nested constraints
                          TIExpr
dictExprBase <- if [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)
                            then do
                              -- No constraints: dictionary is a simple hash
                              TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (String -> TIExprNode
TIVarExpr String
dictName)
                            else do
                              -- Has constraints: dictionary is a function that returns a hash
                              -- Get the result type (should be the hash type after applying arguments)
                              let dictFuncType :: Type
dictFuncType = case Type
dictHashType of
                                    TFun Type
_ Type
resultType -> Type -> Type -> Type
TFun Type
dictHashType Type
resultType
                                    Type
_ -> Type -> Type -> Type
TFun (Type -> Type -> Type
THash Type
TString Type
TAny) Type
dictHashType
                                  dictFuncExpr :: TIExpr
dictFuncExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictFuncType) (String -> TIExprNode
TIVarExpr String
dictName)
                              [TIExpr]
dictArgs <- (Constraint -> EvalM TIExpr)
-> [Constraint]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> Constraint -> EvalM TIExpr
resolveDictionaryArg ClassEnv
classEnv') (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)
                              TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictFuncExpr [TIExpr]
dictArgs)

                          let indexExpr :: TIExpr
indexExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
TString)
                                               (ConstantExpr -> TIExprNode
TIConstantExpr (Text -> ConstantExpr
StringExpr (String -> Text
pack String
methodKey)))
                              dictAccess :: TIExpr
dictAccess = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme (TIExprNode -> TIExpr) -> TIExprNode -> TIExpr
forall a b. (a -> b) -> a -> b
$
                                           Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
False TIExpr
dictExprBase [TIExpr -> Index TIExpr
forall a. a -> Index a
Sub TIExpr
indexExpr]
                              -- Calculate result type after applying all parameters
                              resultType :: Type
resultType = Type -> Int -> Type
applyParamsToType Type
methodType ([TIExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TIExpr]
paramExprs)
                              -- Fully applied results don't need constraints
                              bodyScheme :: TypeScheme
bodyScheme = case Type
resultType of
                                             TFun Type
_ Type
_ -> TypeScheme
methodScheme  -- Partial application
                                             Type
_ -> [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
resultType  -- Fully applied: no constraints
                              body :: TIExpr
body = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
bodyScheme (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictAccess [TIExpr]
paramExprs)
                          TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
forall a. Maybe a
Nothing [Var]
paramVars TIExpr
body
                        Maybe InstanceInfo
Nothing -> EvalM TIExprNode
checkConstrainedVariable
                Maybe TypeScheme
Nothing -> EvalM TIExprNode
checkConstrainedVariable
            Maybe Constraint
Nothing -> EvalM TIExprNode
checkConstrainedVariable
          where
            -- Check if this is a constrained variable (not a method)
            -- IMPORTANT: Only apply dictionaries if the variable was DEFINED with constraints,
            -- not just if the expression has propagated constraints from usage context.
            checkConstrainedVariable :: EvalM TIExprNode
checkConstrainedVariable = do
              TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
              -- Look up the variable's original type scheme from TypeEnv
              case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
varName) TypeEnv
typeEnv of
                Just (Forall [TyVar]
_ [Constraint]
originalConstraints Type
_)
                  | Bool -> Bool
not ([Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint]
originalConstraints) -> do
                      -- Variable was defined with constraints - apply dictionaries
                      -- Check if all constraints are on concrete types
                      let hasOnlyConcreteConstraints :: Bool
hasOnlyConcreteConstraints = (Constraint -> Bool) -> [Constraint] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Constraint -> Bool
isConcreteConstraint [Constraint]
exprConstraints
                      if Bool
hasOnlyConcreteConstraints
                        then do
                          -- This is a constrained variable with concrete types - apply dictionaries
                          [TIExpr]
dictArgs <- (Constraint -> EvalM TIExpr)
-> [Constraint]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> Constraint -> EvalM TIExpr
resolveDictionaryArg ClassEnv
classEnv') [Constraint]
exprConstraints
                          -- Create application: varName dict1 dict2 ...
                          let varExpr :: TIExpr
varExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
scheme (String -> TIExprNode
TIVarExpr String
varName)
                          TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
varExpr [TIExpr]
dictArgs
                        else do
                          -- Has type variable constraints - pass dictionary parameters
                          -- This handles recursive calls in polymorphic functions
                          -- Generate dictionary argument expressions for each constraint
                          let makeDict :: Constraint -> TIExpr
makeDict Constraint
c =
                                let dictName :: String
dictName = Constraint -> String
constraintToDictParam Constraint
c
                                    dictType :: Type
dictType = TyVar -> Type
TVar (String -> TyVar
TyVar String
"dict")
                                in TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictType) (String -> TIExprNode
TIVarExpr String
dictName)
                              dictArgs :: [TIExpr]
dictArgs = (Constraint -> TIExpr) -> [Constraint] -> [TIExpr]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> TIExpr
makeDict [Constraint]
exprConstraints
                              varExpr :: TIExpr
varExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
scheme (String -> TIExprNode
TIVarExpr String
varName)
                          TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
varExpr [TIExpr]
dictArgs
                Maybe TypeScheme
_ ->
                  -- Variable was defined without constraints, or not found in TypeEnv
                  -- Don't apply dictionaries - just process normally
                  ClassEnv -> TIExprNode -> EvalM TIExprNode
expandTIExprNode ClassEnv
classEnv' (TIExpr -> TIExprNode
tiExprNode TIExpr
expr)

            isConcreteConstraint :: Constraint -> Bool
isConcreteConstraint (Constraint String
_ (TVar TyVar
_)) = Bool
False
            isConcreteConstraint Constraint
_ = Bool
True
        TIExprNode
_ -> ClassEnv -> TIExprNode -> EvalM TIExprNode
expandTIExprNode ClassEnv
classEnv' (TIExpr -> TIExprNode
tiExprNode TIExpr
expr)

      TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
scheme TIExprNode
expandedNode

    -- Expand type class methods in patterns (no parent constraints)
    expandTIPattern :: ClassEnv -> TIPattern -> EvalM TIPattern
    expandTIPattern :: ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' (TIPattern TypeScheme
scheme TIPatternNode
node) = do
      TIPatternNode
node' <- ClassEnv -> TIPatternNode -> EvalM TIPatternNode
expandTIPatternNode ClassEnv
classEnv' TIPatternNode
node
      TIPattern -> EvalM TIPattern
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPattern -> EvalM TIPattern) -> TIPattern -> EvalM TIPattern
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIPatternNode -> TIPattern
TIPattern TypeScheme
scheme TIPatternNode
node'

    -- Expand pattern nodes recursively (no parent constraints)
    expandTIPatternNode :: ClassEnv -> TIPatternNode -> EvalM TIPatternNode
    expandTIPatternNode :: ClassEnv -> TIPatternNode -> EvalM TIPatternNode
expandTIPatternNode ClassEnv
classEnv' TIPatternNode
node = case TIPatternNode
node of
      -- Loop pattern: expand the loop range expressions
      TILoopPat String
var TILoopRange
loopRange TIPattern
pat1 TIPattern
pat2 -> do
        TILoopRange
loopRange' <- ClassEnv -> TILoopRange -> EvalM TILoopRange
expandTILoopRange ClassEnv
classEnv' TILoopRange
loopRange
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TILoopRange -> TIPattern -> TIPattern -> TIPatternNode
TILoopPat String
var TILoopRange
loopRange' TIPattern
pat1' TIPattern
pat2'

      -- Recursive pattern constructors
      TIAndPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIAndPat TIPattern
pat1' TIPattern
pat2'

      TIOrPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIOrPat TIPattern
pat1' TIPattern
pat2'

      TIForallPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIForallPat TIPattern
pat1' TIPattern
pat2'

      TINotPat TIPattern
pat -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPatternNode
TINotPat TIPattern
pat'

      TITuplePat [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ [TIPattern] -> TIPatternNode
TITuplePat [TIPattern]
pats'

      TIInductivePat String
name [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> [TIPattern] -> TIPatternNode
TIInductivePat String
name [TIPattern]
pats'

      TIIndexedPat TIPattern
pat [TIExpr]
exprs -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat
        [TIExpr]
exprs' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv') [TIExpr]
exprs
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> [TIExpr] -> TIPatternNode
TIIndexedPat TIPattern
pat' [TIExpr]
exprs'

      TILetPat [TIBindingExpr]
bindings TIPattern
pat -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIPattern -> TIPatternNode
TILetPat [TIBindingExpr]
bindings TIPattern
pat'  -- TODO: Expand binding expressions
      
      TIPApplyPat TIExpr
funcExpr [TIPattern]
argPats -> do
        TIExpr
funcExpr' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
funcExpr
        [TIPattern]
argPats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv') [TIPattern]
argPats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIPattern] -> TIPatternNode
TIPApplyPat TIExpr
funcExpr' [TIPattern]
argPats'

      TIDApplyPat TIPattern
pat [TIPattern]
pats -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> [TIPattern] -> TIPatternNode
TIDApplyPat TIPattern
pat' [TIPattern]
pats'

      TISeqConsPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TISeqConsPat TIPattern
pat1' TIPattern
pat2'

      TIPatternNode
TISeqNilPat -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TISeqNilPat

      TIVarPat String
name -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TIPatternNode
TIVarPat String
name

      TIInductiveOrPApplyPat String
name [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> [TIPattern] -> TIPatternNode
TIInductiveOrPApplyPat String
name [TIPattern]
pats'

      -- Leaf patterns: no expansion needed
      TIPatternNode
TIWildCard -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TIWildCard
      TIPatVar String
name -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TIPatternNode
TIPatVar String
name
      TIValuePat TIExpr
expr -> do
        TIExpr
expr' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
expr
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIPatternNode
TIValuePat TIExpr
expr'
      TIPredPat TIExpr
pred -> do
        TIExpr
pred' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
pred
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIPatternNode
TIPredPat TIExpr
pred'
      TIPatternNode
TIContPat -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TIContPat
      TIPatternNode
TILaterPatVar -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TILaterPatVar

    -- Expand loop range expressions (no parent constraints)
    expandTILoopRange :: ClassEnv -> TILoopRange -> EvalM TILoopRange
    expandTILoopRange :: ClassEnv -> TILoopRange -> EvalM TILoopRange
expandTILoopRange ClassEnv
classEnv' (TILoopRange TIExpr
start TIExpr
end TIPattern
rangePat) = do
      TIExpr
start' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
start
      TIExpr
end' <- ClassEnv -> TIExpr -> EvalM TIExpr
expandTIExprWithConstraints ClassEnv
classEnv' TIExpr
end
      TIPattern
rangePat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandTIPattern ClassEnv
classEnv' TIPattern
rangePat
      TILoopRange -> EvalM TILoopRange
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TILoopRange -> EvalM TILoopRange)
-> TILoopRange -> EvalM TILoopRange
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIPattern -> TILoopRange
TILoopRange TIExpr
start' TIExpr
end' TIPattern
rangePat'

    -- Try to resolve a method call using type class constraints
    -- Dictionary passing: convert method calls to dictionary access
    tryResolveMethodCall :: ClassEnv -> [Constraint] -> String -> [TIExpr] -> EvalM (Maybe TIExprNode)
    tryResolveMethodCall :: ClassEnv
-> [Constraint] -> String -> [TIExpr] -> EvalM (Maybe TIExprNode)
tryResolveMethodCall ClassEnv
classEnv' [Constraint]
cs String
methodName [TIExpr]
expandedArgs = do
      -- Find a constraint that provides this method
      case ClassEnv -> String -> [Constraint] -> Maybe Constraint
findConstraintForMethod ClassEnv
classEnv' String
methodName [Constraint]
cs of
        Maybe Constraint
Nothing -> Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TIExprNode
forall a. Maybe a
Nothing
        Just (Constraint String
className Type
tyArg) -> do
          -- Look up the class to check if methodName is a method
          case String -> ClassEnv -> Maybe ClassInfo
lookupClass String
className ClassEnv
classEnv' of
            Just ClassInfo
classInfo -> do
              if String
methodName String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((String, Type) -> String) -> [(String, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> String
forall a b. (a, b) -> a
fst (ClassInfo -> [(String, Type)]
classMethods ClassInfo
classInfo)
                then do
                  let methodKey :: String
methodKey = String -> String
sanitizeMethodName String
methodName
                  -- Check if this is a type variable constraint
                  case Type
tyArg of
                    TVar (TyVar String
_v) -> do
                      -- Type variable: use dictionary parameter
                      -- e.g., for {Eq a}, use dict_Eq (without type parameter)
                      TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
                      let dictParamName :: String
dictParamName = String
"dict_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className
                      -- Look up dictionary type from type environment
                      Type
dictHashType <- case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
dictParamName) TypeEnv
typeEnv of
                        Just (Forall [TyVar]
_ [Constraint]
_ Type
dictType) -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
dictType
                        Maybe TypeScheme
Nothing -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type)
-> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
THash Type
TString Type
TAny  -- Fallback
                      -- Get method type from ClassEnv instead of dictHashType
                      let methodType :: Type
methodType = ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
classEnv' String
className String
methodKey Type
tyArg
                          -- No constraints: dictionary access resolves the constraint
                          methodScheme :: TypeScheme
methodScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
methodType
                          dictExpr :: TIExpr
dictExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (String -> TIExprNode
TIVarExpr String
dictParamName)
                          indexExpr :: TIExpr
indexExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
TString) 
                                            (ConstantExpr -> TIExprNode
TIConstantExpr (Text -> ConstantExpr
StringExpr (String -> Text
pack String
methodKey)))
                          dictAccess :: TIExpr
dictAccess = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme (TIExprNode -> TIExpr) -> TIExprNode -> TIExpr
forall a b. (a -> b) -> a -> b
$
                                       Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
False TIExpr
dictExpr [TIExpr -> Index TIExpr
forall a. a -> Index a
Sub TIExpr
indexExpr]
                      -- Apply arguments: dictAccess arg1 arg2 ...
                      Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TIExprNode -> EvalM (Maybe TIExprNode))
-> Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a b. (a -> b) -> a -> b
$ TIExprNode -> Maybe TIExprNode
forall a. a -> Maybe a
Just (TIExprNode -> Maybe TIExprNode) -> TIExprNode -> Maybe TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictAccess [TIExpr]
expandedArgs
                    Type
_ -> do
                      -- Concrete type: try to find matching instance
                      let instances :: [InstanceInfo]
instances = String -> ClassEnv -> [InstanceInfo]
lookupInstances String
className ClassEnv
classEnv'
                      -- Use actual argument type if needed
                      let argTypes :: [Type]
argTypes = (TIExpr -> Type) -> [TIExpr] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Type
tiExprType [TIExpr]
expandedArgs
                          actualType :: Type
actualType = case (Type
tyArg, [Type]
argTypes) of
                            (TVar TyVar
_, (Type
t:[Type]
_)) -> Type
t  -- Use first argument's type
                            (Type, [Type])
_ -> Type
tyArg
                      -- Check if actualType is still a type variable
                      case Type
actualType of
                        TVar (TyVar String
_v') -> do
                          -- Still a type variable: use dictionary parameter
                          TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
                          let dictParamName :: String
dictParamName = String
"dict_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className
                          -- Look up dictionary type from type environment
                          Type
dictHashType <- case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
dictParamName) TypeEnv
typeEnv of
                            Just (Forall [TyVar]
_ [Constraint]
_ Type
dictType) -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
dictType
                            Maybe TypeScheme
Nothing -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type)
-> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
THash Type
TString Type
TAny  -- Fallback
                          -- Get method type from ClassEnv instead of dictHashType
                          let methodType :: Type
methodType = ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
classEnv' String
className String
methodKey Type
actualType
                              -- No constraints: dictionary access resolves the constraint
                              methodScheme :: TypeScheme
methodScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
methodType
                              dictExpr :: TIExpr
dictExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (String -> TIExprNode
TIVarExpr String
dictParamName)
                              indexExpr :: TIExpr
indexExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
TString) 
                                                (ConstantExpr -> TIExprNode
TIConstantExpr (Text -> ConstantExpr
StringExpr (String -> Text
pack String
methodKey)))
                              dictAccess :: TIExpr
dictAccess = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme (TIExprNode -> TIExpr) -> TIExprNode -> TIExpr
forall a b. (a -> b) -> a -> b
$
                                           Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
False TIExpr
dictExpr [TIExpr -> Index TIExpr
forall a. a -> Index a
Sub TIExpr
indexExpr]
                          -- Apply arguments: dictAccess arg1 arg2 ...
                          Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TIExprNode -> EvalM (Maybe TIExprNode))
-> Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a b. (a -> b) -> a -> b
$ TIExprNode -> Maybe TIExprNode
forall a. a -> Maybe a
Just (TIExprNode -> Maybe TIExprNode) -> TIExprNode -> Maybe TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictAccess [TIExpr]
expandedArgs
                        Type
_ -> case Type -> [InstanceInfo] -> Maybe InstanceInfo
findMatchingInstanceForType Type
actualType [InstanceInfo]
instances of
                          Just InstanceInfo
inst -> do
                            -- Found an instance: generate dictionary access
                            -- e.g., numInteger_"plus" for Num Integer instance
                            TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
                            let instTypeName :: String
instTypeName = Type -> String
typeConstructorName (InstanceInfo -> Type
instType InstanceInfo
inst)
                                dictName :: String
dictName = String -> String
lowerFirst String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
instTypeName

                            -- Look up dictionary type from type environment
                            Type
dictHashType <- case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
dictName) TypeEnv
typeEnv of
                              Just (Forall [TyVar]
_ [Constraint]
_ Type
dictType) -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
dictType
                              Maybe TypeScheme
Nothing -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type)
-> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
THash Type
TString Type
TAny  -- Fallback

                            -- Get method type from ClassEnv instead of dictHashType
                            let methodType :: Type
methodType = ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
classEnv' String
className String
methodKey Type
actualType
                                -- No constraints: dictionary access resolves the constraint
                                methodScheme :: TypeScheme
methodScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
methodType
                            
                            -- Check if instance has nested constraints
                            -- If so, dictionary is a function that takes dict parameters
                            TIExpr
dictExprBase <- if [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)
                                  then do
                                    -- No constraints: dictionary is a simple hash
                                    let dictExpr :: TIExpr
dictExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (String -> TIExprNode
TIVarExpr String
dictName)
                                    TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
dictExpr
                                  else do
                                    -- Has constraints: dictionary is a function
                                    -- Need to resolve constraint arguments and apply them
                                    -- e.g., eqCollection eqInteger
                                    let dictFuncType :: Type
dictFuncType = case Type
dictHashType of
                                          TFun Type
_ Type
resultType -> Type -> Type -> Type
TFun Type
dictHashType Type
resultType
                                          Type
_ -> Type -> Type -> Type
TFun (Type -> Type -> Type
THash Type
TString Type
TAny) Type
dictHashType
                                        dictFuncExpr :: TIExpr
dictFuncExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictFuncType) (String -> TIExprNode
TIVarExpr String
dictName)

                                    -- Substitute type variables in constraints with actual types
                                    -- e.g., for instance {Eq a} Eq [a] matched with [Integer]
                                    -- instType inst = [a], actualType = [Integer]
                                    -- constraint {Eq a} should become {Eq Integer}
                                    -- Substitute type variables in constraints
                                    -- e.g., instance {Eq a} Eq [a] matched with [[Integer]]
                                    -- instType = [a], actualType = [[Integer]]
                                    -- Extract a -> [Integer], apply to {Eq a} -> {Eq [Integer]}
                                    let substitutedConstraints :: [Constraint]
substitutedConstraints = Type -> Type -> [Constraint] -> [Constraint]
substituteInstanceConstraints (InstanceInfo -> Type
instType InstanceInfo
inst) Type
actualType (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)
                                    -- Resolve each substituted constraint (depth is managed internally)
                                    [TIExpr]
dictArgs <- (Constraint -> EvalM TIExpr)
-> [Constraint]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> Constraint -> EvalM TIExpr
resolveDictionaryArg ClassEnv
classEnv') [Constraint]
substitutedConstraints
                                    -- Apply dictionary function to constraint dictionaries
                                    TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictFuncExpr [TIExpr]
dictArgs)

                                -- Now index into the dictionary (which is now a hash)
                            let indexExpr :: TIExpr
indexExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
TString) 
                                                  (ConstantExpr -> TIExprNode
TIConstantExpr (Text -> ConstantExpr
StringExpr (String -> Text
pack String
methodKey)))
                                dictAccess :: TIExpr
dictAccess = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme (TIExprNode -> TIExpr) -> TIExprNode -> TIExpr
forall a b. (a -> b) -> a -> b
$
                                             Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
False TIExpr
dictExprBase [TIExpr -> Index TIExpr
forall a. a -> Index a
Sub TIExpr
indexExpr]
                            -- Apply arguments: dictAccess arg1 arg2 ...
                            Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TIExprNode -> EvalM (Maybe TIExprNode))
-> Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a b. (a -> b) -> a -> b
$ TIExprNode -> Maybe TIExprNode
forall a. a -> Maybe a
Just (TIExprNode -> Maybe TIExprNode) -> TIExprNode -> Maybe TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictAccess [TIExpr]
expandedArgs
                          Maybe InstanceInfo
Nothing -> Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TIExprNode
forall a. Maybe a
Nothing
                else Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TIExprNode
forall a. Maybe a
Nothing
            Maybe ClassInfo
Nothing -> Maybe TIExprNode -> EvalM (Maybe TIExprNode)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TIExprNode
forall a. Maybe a
Nothing
    
    -- Substitute type variables in instance constraints based on actual type
    -- e.g., for instance {Eq a} Eq [a] matched with [[Integer]]
    -- instType = [a], actualType = [[Integer]]
    -- Extract: a -> [Integer], then apply to constraints {Eq a} -> {Eq [Integer]}
    substituteInstanceConstraints :: Type -> Type -> [Constraint] -> [Constraint]
    substituteInstanceConstraints :: Type -> Type -> [Constraint] -> [Constraint]
substituteInstanceConstraints Type
instType Type
actualType [Constraint]
constraints =
      let substs :: [(TyVar, Type)]
substs = Type -> Type -> [(TyVar, Type)]
extractTypeSubstitutions Type
instType Type
actualType
      in (Constraint -> Constraint) -> [Constraint] -> [Constraint]
forall a b. (a -> b) -> [a] -> [b]
map ([(TyVar, Type)] -> Constraint -> Constraint
applySubstsToConstraint [(TyVar, Type)]
substs) [Constraint]
constraints

    -- Resolve a constraint to a dictionary argument (with depth limit to prevent infinite recursion)
    resolveDictionaryArg :: ClassEnv -> Constraint -> EvalM TIExpr
    resolveDictionaryArg :: ClassEnv -> Constraint -> EvalM TIExpr
resolveDictionaryArg ClassEnv
classEnv Constraint
constraint = ClassEnv -> Int -> Constraint -> EvalM TIExpr
resolveDictionaryArgWithDepth ClassEnv
classEnv Int
50 Constraint
constraint
    
    resolveDictionaryArgWithDepth :: ClassEnv -> Int -> Constraint -> EvalM TIExpr
    resolveDictionaryArgWithDepth :: ClassEnv -> Int -> Constraint -> EvalM TIExpr
resolveDictionaryArgWithDepth ClassEnv
_ Int
0 (Constraint String
className Type
_) = do
      -- Depth limit reached, return error placeholder
      TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] (TyVar -> Type
TVar (String -> TyVar
TyVar String
"error"))) (String -> TIExprNode
TIVarExpr (String
"dict_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_TOO_DEEP"))
    
    resolveDictionaryArgWithDepth ClassEnv
classEnv Int
depth (Constraint String
className Type
tyArg) = do
      case Type
tyArg of
        TVar (TyVar String
_v) -> do
          -- Type variable: use dictionary parameter name (without type parameter)
          -- e.g., for {Eq a}, return dict_Eq
          let dictParamName :: String
dictParamName = String
"dict_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className
              dictType :: Type
dictType = TyVar -> Type
TVar (String -> TyVar
TyVar String
"dict")
          TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictType) (String -> TIExprNode
TIVarExpr String
dictParamName)
        Type
_ -> do
          -- Concrete type: try to find matching instance
          let instances :: [InstanceInfo]
instances = String -> ClassEnv -> [InstanceInfo]
lookupInstances String
className ClassEnv
classEnv
          case Type -> [InstanceInfo] -> Maybe InstanceInfo
findMatchingInstanceForType Type
tyArg [InstanceInfo]
instances of
            Just InstanceInfo
inst -> do
              -- Found instance: generate dictionary name (e.g., "numInteger", "eqCollection")
              let instTypeName :: String
instTypeName = Type -> String
typeConstructorName (InstanceInfo -> Type
instType InstanceInfo
inst)
                  dictName :: String
dictName = String -> String
lowerFirst String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
instTypeName
                  dictType :: Type
dictType = TyVar -> Type
TVar (String -> TyVar
TyVar String
"dict")
                  dictExpr :: TIExpr
dictExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictType) (String -> TIExprNode
TIVarExpr String
dictName)
              
              -- Check if this instance has nested constraints
              -- e.g., instance {Eq a} Eq [a] has constraint {Eq a}
              if [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)
                then do
                  -- No constraints: return simple dictionary reference
                  TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
dictExpr
                else do
                  -- Has constraints: need to resolve them and apply to dictionary
                  -- e.g., for Eq [Integer], resolve {Eq Integer} -> eqInteger
                  -- then return: eqCollection eqInteger

                  -- Substitute type variables in constraints with actual types
                  -- e.g., for instance {Eq a} Eq [a] matched with [[Integer]]
                  -- instType inst = [a], tyArg = [[Integer]]
                  -- Extract: a -> [Integer]
                  -- Apply to constraints: {Eq a} -> {Eq [Integer]}
                  let substs :: [(TyVar, Type)]
substs = Type -> Type -> [(TyVar, Type)]
extractTypeSubstitutions (InstanceInfo -> Type
instType InstanceInfo
inst) Type
tyArg
                      substitutedConstraints :: [Constraint]
substitutedConstraints = (Constraint -> Constraint) -> [Constraint] -> [Constraint]
forall a b. (a -> b) -> [a] -> [b]
map ([(TyVar, Type)] -> Constraint -> Constraint
applySubstsToConstraint [(TyVar, Type)]
substs) (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)

                  -- Recursively resolve each constraint with reduced depth
                  [TIExpr]
dictArgs <- (Constraint -> EvalM TIExpr)
-> [Constraint]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> Int -> Constraint -> EvalM TIExpr
resolveDictionaryArgWithDepth ClassEnv
classEnv (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [Constraint]
substitutedConstraints

                  -- Apply dictionary function to resolved dictionaries
                  -- e.g., eqCollection eqInteger (when resolving Eq [Integer])
                  --       eqCollection (eqCollection eqInteger) (when resolving Eq [[Integer]])
                  TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictType) (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictExpr [TIExpr]
dictArgs)
            Maybe InstanceInfo
Nothing -> do
              -- No instance found - this is an error, but return a dummy for now
              TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] (TyVar -> Type
TVar (String -> TyVar
TyVar String
"error"))) (String -> TIExprNode
TIVarExpr String
"undefined")

-- | Generate dictionary parameter name from constraint
-- Used for both dictionary parameter generation and dictionary argument passing
-- Type parameters are not included in the dictionary parameter name
constraintToDictParam :: Constraint -> String
constraintToDictParam :: Constraint -> String
constraintToDictParam (Constraint String
className Type
_constraintType) =
  String
"dict_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className

-- | Get method type from ClassEnv
-- This retrieves the method type from the class definition and substitutes type variables
-- Note: methodKey is the sanitized name (e.g., "plus"), but classMethods uses original names (e.g., "+")
-- We need to try both the sanitized and original names
getMethodTypeFromClass :: ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass :: ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
classEnv String
className String
methodKey Type
constraintType =
  case String -> ClassEnv -> Maybe ClassInfo
lookupClass String
className ClassEnv
classEnv of
    Just ClassInfo
classInfo ->
      -- Try to find the method by sanitized name first, then try unsanitizing
      case String -> [(String, Type)] -> Maybe Type
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
methodKey (ClassInfo -> [(String, Type)]
classMethods ClassInfo
classInfo) Maybe Type -> Maybe Type -> Maybe Type
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> [(String, Type)] -> Maybe Type
forall a. String -> [(String, a)] -> Maybe a
lookupUnsanitized String
methodKey (ClassInfo -> [(String, Type)]
classMethods ClassInfo
classInfo) of
        Just Type
classMethodType ->
          -- Substitute class type parameter with actual constraint type
          -- e.g., class Num a has plus : a -> a -> a
          --       constraint Num t0 → plus : t0 -> t0 -> t0
          [(TyVar, Type)] -> Type -> Type
applySubstsToType [(ClassInfo -> TyVar
classParam ClassInfo
classInfo, Type
constraintType)] Type
classMethodType
        Maybe Type
Nothing -> Type
TAny  -- Method not found in class
    Maybe ClassInfo
Nothing -> Type
TAny  -- Class not found
  where
    -- Lookup by unsanitizing the method key (reverse of sanitizeMethodName)
    -- e.g., "plus" -> "+", "times" -> "*"
    lookupUnsanitized :: String -> [(String, a)] -> Maybe a
    lookupUnsanitized :: forall a. String -> [(String, a)] -> Maybe a
lookupUnsanitized String
key [(String, a)]
methods =
      case String -> Maybe String
unsanitizeMethodName String
key of
        Just String
originalName -> String -> [(String, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
originalName [(String, a)]
methods
        Maybe String
Nothing -> Maybe a
forall a. Maybe a
Nothing

    -- Reverse of sanitizeMethodName
    unsanitizeMethodName :: String -> Maybe String
    unsanitizeMethodName :: String -> Maybe String
unsanitizeMethodName String
"eq" = String -> Maybe String
forall a. a -> Maybe a
Just String
"=="
    unsanitizeMethodName String
"neq" = String -> Maybe String
forall a. a -> Maybe a
Just String
"/="
    unsanitizeMethodName String
"lt" = String -> Maybe String
forall a. a -> Maybe a
Just String
"<"
    unsanitizeMethodName String
"le" = String -> Maybe String
forall a. a -> Maybe a
Just String
"<="
    unsanitizeMethodName String
"gt" = String -> Maybe String
forall a. a -> Maybe a
Just String
">"
    unsanitizeMethodName String
"ge" = String -> Maybe String
forall a. a -> Maybe a
Just String
">="
    unsanitizeMethodName String
"plus" = String -> Maybe String
forall a. a -> Maybe a
Just String
"+"
    unsanitizeMethodName String
"minus" = String -> Maybe String
forall a. a -> Maybe a
Just String
"-"
    unsanitizeMethodName String
"times" = String -> Maybe String
forall a. a -> Maybe a
Just String
"*"
    unsanitizeMethodName String
"div" = String -> Maybe String
forall a. a -> Maybe a
Just String
"/"
    unsanitizeMethodName String
_ = Maybe String
forall a. Maybe a
Nothing

-- | Add dictionary parameters to a function based on its type scheme constraints
-- This transforms constrained functions into dictionary-passing style
addDictionaryParametersT :: TypeScheme -> TIExpr -> EvalM TIExpr
addDictionaryParametersT :: TypeScheme -> TIExpr -> EvalM TIExpr
addDictionaryParametersT (Forall [TyVar]
_vars [Constraint]
constraints Type
_ty) TIExpr
tiExpr
  | [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint]
constraints = TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
tiExpr  -- No constraints, no change
  | Bool
otherwise = do
      ClassEnv
classEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) ClassEnv
forall (m :: * -> *). MonadEval m => m ClassEnv
getClassEnv
      -- Note: No need to resolve Tensor constraints here because TensorMapInsertion
      -- runs before TypeClassExpand, so tensor operations are already handled.
      -- The execution order is: insertTensorMaps -> expandTypeClassMethodsT
      ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
addDictParamsToTIExpr ClassEnv
classEnv [Constraint]
constraints TIExpr
tiExpr
  where
    -- Add dictionary parameters to a TIExpr
    addDictParamsToTIExpr :: ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
    addDictParamsToTIExpr :: ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
addDictParamsToTIExpr ClassEnv
env [Constraint]
cs TIExpr
expr = case TIExpr -> TIExprNode
tiExprNode TIExpr
expr of
      -- Lambda: add dictionary parameters before regular parameters
      TILambdaExpr Maybe Var
mVar [Var]
params TIExpr
body -> do
        let dictParams :: [String]
dictParams = (Constraint -> String) -> [Constraint] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> String
constraintToDictParam [Constraint]
cs
            dictVars :: [Var]
dictVars = (String -> Var) -> [String] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map String -> Var
stringToVar [String]
dictParams
        -- Replace method calls in body with dictionary access
        -- BUT: if body is a hash (dictionary), don't process it
        TIExpr
body' <- case TIExpr -> TIExprNode
tiExprNode TIExpr
body of
                   TIHashExpr [(TIExpr, TIExpr)]
_ -> TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
body  -- Dictionary body, don't process
                   TIExprNode
_ -> ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
body
        let newNode :: TIExprNode
newNode = Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
mVar ([Var]
dictVars [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
params) TIExpr
body'
        TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr (TIExpr -> TypeScheme
tiScheme TIExpr
expr) TIExprNode
newNode
      
      -- Hash (dictionary definition): wrap in lambda AND apply dict params to methods
      -- Dictionary values are method references that need dictionary parameters
      TIHashExpr [(TIExpr, TIExpr)]
pairs -> do
        let dictParams :: [String]
dictParams = (Constraint -> String) -> [Constraint] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> String
constraintToDictParam [Constraint]
cs
            dictVars :: [Var]
dictVars = (String -> Var) -> [String] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map String -> Var
stringToVar [String]
dictParams
            wrapperType :: Type
wrapperType = TIExpr -> Type
tiExprType TIExpr
expr
        
        -- For each value in the hash (which is a method reference),
        -- if it has constraints, apply dictionary parameters to it
        [(TIExpr, TIExpr)]
pairs' <- ((TIExpr, TIExpr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr))
-> [(TIExpr, TIExpr)]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [(TIExpr, TIExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(TIExpr
k, TIExpr
v) -> do
          -- Check if the value (method) has constraints
          TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
          let vNode :: TIExprNode
vNode = TIExpr -> TIExprNode
tiExprNode TIExpr
v
          case TIExprNode
vNode of
            TIVarExpr String
methodName -> do
              case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
methodName) TypeEnv
typeEnv of
                Just (Forall [TyVar]
_ [Constraint]
vConstraints Type
_) | Bool -> Bool
not ([Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint]
vConstraints) -> do
                  -- Method has constraints, apply dictionary parameters
                  let dictArgExprs :: [TIExpr]
dictArgExprs = (String -> TIExpr) -> [String] -> [TIExpr]
forall a b. (a -> b) -> [a] -> [b]
map (\String
p -> TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] (TyVar -> Type
TVar (String -> TyVar
TyVar String
"dict"))) (String -> TIExprNode
TIVarExpr String
p)) [String]
dictParams
                      vApplied :: TIExpr
vApplied = TypeScheme -> TIExprNode -> TIExpr
TIExpr (TIExpr -> TypeScheme
tiScheme TIExpr
v) (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
v [TIExpr]
dictArgExprs)
                  (TIExpr, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr
k, TIExpr
vApplied)
                Maybe TypeScheme
_ -> (TIExpr, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr
k, TIExpr
v)  -- No constraints, keep as-is
            TIExprNode
_ -> (TIExpr, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr
k, TIExpr
v)  -- Not a variable, keep as-is
          ) [(TIExpr, TIExpr)]
pairs
        
        let hashExpr' :: TIExpr
hashExpr' = TypeScheme -> TIExprNode -> TIExpr
TIExpr (TIExpr -> TypeScheme
tiScheme TIExpr
expr) ([(TIExpr, TIExpr)] -> TIExprNode
TIHashExpr [(TIExpr, TIExpr)]
pairs')
            newNode :: TIExprNode
newNode = Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
forall a. Maybe a
Nothing [Var]
dictVars TIExpr
hashExpr'
            newScheme :: TypeScheme
newScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
wrapperType
        TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
newScheme TIExprNode
newNode
      
      -- Not a lambda: wrap in a lambda with dictionary parameters
      TIExprNode
_ -> do
        let dictParams :: [String]
dictParams = (Constraint -> String) -> [Constraint] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> String
constraintToDictParam [Constraint]
cs
            dictVars :: [Var]
dictVars = (String -> Var) -> [String] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map String -> Var
stringToVar [String]
dictParams
        -- Special handling for TIVarExpr: if it's a constrained variable, apply dictionaries
        TIExpr
expr' <- case TIExpr -> TIExprNode
tiExprNode TIExpr
expr of
          TIVarExpr String
varName -> do
            -- Check if this variable has constraints that match our constraints
            TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
            case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
varName) TypeEnv
typeEnv of
              Just (Forall [TyVar]
_ [Constraint]
varConstraints Type
_) | Bool -> Bool
not ([Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint]
varConstraints) -> do
                -- Check which constraints from varConstraints match parent constraints cs
                let (Forall [TyVar]
_ [Constraint]
exprConstraints Type
exprType) = TIExpr -> TypeScheme
tiScheme TIExpr
expr
                    matchingConstraints :: [Constraint]
matchingConstraints = (Constraint -> Bool) -> [Constraint] -> [Constraint]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Constraint String
eName Type
eType) ->
                          (Constraint -> Bool) -> [Constraint] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Constraint String
pName Type
pType) ->
                            String
eName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pName Bool -> Bool -> Bool
&& Type
eType Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
pType) [Constraint]
cs) [Constraint]
exprConstraints
                if [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint]
matchingConstraints
                  then ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
expr
                  else do
                    -- Apply matching dictionary parameters
                    let dictArgExprs :: [TIExpr]
dictArgExprs = (String -> TIExpr) -> [String] -> [TIExpr]
forall a b. (a -> b) -> [a] -> [b]
map (\String
p -> TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] (TyVar -> Type
TVar (String -> TyVar
TyVar String
"dict"))) (String -> TIExprNode
TIVarExpr String
p))
                                           ((Constraint -> String) -> [Constraint] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> String
constraintToDictParam [Constraint]
matchingConstraints)
                        varExpr :: TIExpr
varExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr (TIExpr -> TypeScheme
tiScheme TIExpr
expr) (String -> TIExprNode
TIVarExpr String
varName)
                    TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr (TIExpr -> TypeScheme
tiScheme TIExpr
expr) (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
varExpr [TIExpr]
dictArgExprs)
              Maybe TypeScheme
_ -> ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
expr
          TIExprNode
_ -> ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
expr
        let wrapperType :: Type
wrapperType = TIExpr -> Type
tiExprType TIExpr
expr
            newNode :: TIExprNode
newNode = Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
forall a. Maybe a
Nothing [Var]
dictVars TIExpr
expr'
            newScheme :: TypeScheme
newScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
wrapperType
        TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
newScheme TIExprNode
newNode
    
    -- Replace method calls with dictionary access in TIExpr
    replaceMethodCallsWithDictAccessT :: ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
    replaceMethodCallsWithDictAccessT :: ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
tiExpr = do
      let scheme :: TypeScheme
scheme@(Forall [TyVar]
_ [Constraint]
exprConstraints Type
exprType) = TIExpr -> TypeScheme
tiScheme TIExpr
tiExpr
      TIExprNode
newNode <- ClassEnv
-> [Constraint]
-> [Constraint]
-> Type
-> TIExprNode
-> EvalM TIExprNode
replaceMethodCallsInNode ClassEnv
env [Constraint]
cs [Constraint]
exprConstraints Type
exprType (TIExpr -> TIExprNode
tiExprNode TIExpr
tiExpr)
      TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
scheme TIExprNode
newNode
    
    -- Replace method calls in TIExprNode
    replaceMethodCallsInNode :: ClassEnv -> [Constraint] -> [Constraint] -> Type -> TIExprNode -> EvalM TIExprNode
    replaceMethodCallsInNode :: ClassEnv
-> [Constraint]
-> [Constraint]
-> Type
-> TIExprNode
-> EvalM TIExprNode
replaceMethodCallsInNode ClassEnv
env [Constraint]
cs [Constraint]
exprConstraints Type
exprType TIExprNode
node = case TIExprNode
node of
      -- Standalone method reference: eta-expand
      TIVarExpr String
methodName -> do
        case ClassEnv -> String -> [Constraint] -> Maybe Constraint
findConstraintForMethod ClassEnv
env String
methodName [Constraint]
cs of
          Just Constraint
constraint -> do
            -- Get method type to determine arity
            TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
            case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
methodName) TypeEnv
typeEnv of
              Just (Forall [TyVar]
_ [Constraint]
_ Type
_ty) -> do
                -- Use the expression's actual type (exprType) instead of the method's declared type (ty)
                -- because eta-expansion should create parameters matching the expected usage context
                let arity :: Int
arity = Type -> Int
getMethodArity Type
exprType
                    paramTypes :: [Type]
paramTypes = Type -> [Type]
getParamTypes Type
exprType
                    paramNames :: [String]
paramNames = [String
"etaVar" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [Int
1..Int
arity]]
                    paramVars :: [Var]
paramVars = (String -> Var) -> [String] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map String -> Var
stringToVar [String]
paramNames
                    paramExprs :: [TIExpr]
paramExprs = (String -> Type -> TIExpr) -> [String] -> [Type] -> [TIExpr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
n Type
t -> TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
t) (String -> TIExprNode
TIVarExpr String
n)) [String]
paramNames [Type]
paramTypes
                    -- Create dictionary access
                    dictParam :: String
dictParam = Constraint -> String
constraintToDictParam Constraint
constraint
                    Constraint String
className Type
tyArg = Constraint
constraint
                -- Look up dictionary type from type environment
                Type
dictHashType <- case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
dictParam) TypeEnv
typeEnv of
                  Just (Forall [TyVar]
_ [Constraint]
_ Type
dictType) -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
dictType
                  Maybe TypeScheme
Nothing -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type)
-> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
THash Type
TString Type
TAny  -- Fallback
                -- Get method type from ClassEnv instead of dictHashType
                let methodType :: Type
methodType = ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
env String
className (String -> String
sanitizeMethodName String
methodName) Type
tyArg
                    methodConstraint :: Constraint
methodConstraint = String -> Type -> Constraint
Constraint String
className Type
tyArg
                    methodScheme :: TypeScheme
methodScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall (Set TyVar -> [TyVar]
forall a. Set a -> [a]
Set.toList (Set TyVar -> [TyVar]) -> Set TyVar -> [TyVar]
forall a b. (a -> b) -> a -> b
$ Type -> Set TyVar
freeTyVars Type
tyArg) [Constraint
methodConstraint] Type
methodType
                    indexExpr :: TIExpr
indexExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
TString) 
                                      (ConstantExpr -> TIExprNode
TIConstantExpr (Text -> ConstantExpr
StringExpr (String -> Text
pack (String -> String
sanitizeMethodName String
methodName))))
                    dictAccess :: TIExpr
dictAccess = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme (TIExprNode -> TIExpr) -> TIExprNode -> TIExpr
forall a b. (a -> b) -> a -> b
$
                                 Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
False
                                   (TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (String -> TIExprNode
TIVarExpr String
dictParam))
                                   [TIExpr -> Index TIExpr
forall a. a -> Index a
Sub TIExpr
indexExpr]
                    -- Create: dictAccess etaVar1 etaVar2 ... etaVarN
                    body :: TIExpr
body = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictAccess [TIExpr]
paramExprs)
                TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
forall a. Maybe a
Nothing [Var]
paramVars TIExpr
body
              Maybe TypeScheme
Nothing -> TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ String -> TIExprNode
TIVarExpr String
methodName
          Maybe Constraint
Nothing -> do
            -- Not a method - just return the variable as-is
            -- Dictionary application for constrained variables is handled by expandTypeClassMethodsT
            TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ String -> TIExprNode
TIVarExpr String
methodName
      
      -- Method call: replace with dictionary access
      TIApplyExpr TIExpr
func [TIExpr]
args -> do
        case TIExpr -> TIExprNode
tiExprNode TIExpr
func of
          TIVarExpr String
methodName -> do
            case ClassEnv -> String -> [Constraint] -> Maybe Constraint
findConstraintForMethod ClassEnv
env String
methodName [Constraint]
cs of
              Just Constraint
constraint -> do
                -- Replace with dictionary access
                TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
                let dictParam :: String
dictParam = Constraint -> String
constraintToDictParam Constraint
constraint
                    Constraint String
className Type
tyArg = Constraint
constraint
                -- Look up dictionary type from type environment
                Type
dictHashType <- case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
dictParam) TypeEnv
typeEnv of
                  Just (Forall [TyVar]
_ [Constraint]
_ Type
dictType) -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
dictType
                  Maybe TypeScheme
Nothing -> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type)
-> Type -> StateT EvalState (ExceptT EgisonError RuntimeM) Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
THash Type
TString Type
TAny  -- Fallback
                -- Get method type from ClassEnv instead of dictHashType
                let methodType :: Type
methodType = ClassEnv -> String -> String -> Type -> Type
getMethodTypeFromClass ClassEnv
env String
className (String -> String
sanitizeMethodName String
methodName) Type
tyArg
                    methodConstraint :: Constraint
methodConstraint = String -> Type -> Constraint
Constraint String
className Type
tyArg
                    methodScheme :: TypeScheme
methodScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall (Set TyVar -> [TyVar]
forall a. Set a -> [a]
Set.toList (Set TyVar -> [TyVar]) -> Set TyVar -> [TyVar]
forall a b. (a -> b) -> a -> b
$ Type -> Set TyVar
freeTyVars Type
tyArg) [Constraint
methodConstraint] Type
methodType
                    indexExpr :: TIExpr
indexExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
TString) 
                                      (ConstantExpr -> TIExprNode
TIConstantExpr (Text -> ConstantExpr
StringExpr (String -> Text
pack (String -> String
sanitizeMethodName String
methodName))))
                    dictAccessNode :: TIExprNode
dictAccessNode = Bool -> TIExpr -> [Index TIExpr] -> TIExprNode
TIIndexedExpr Bool
False
                                     (TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictHashType) (String -> TIExprNode
TIVarExpr String
dictParam))
                                     [TIExpr -> Index TIExpr
forall a. a -> Index a
Sub TIExpr
indexExpr]
                    dictAccess :: TIExpr
dictAccess = TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
methodScheme TIExprNode
dictAccessNode
                -- Recursively process arguments
                [TIExpr]
args' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs) [TIExpr]
args
                TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictAccess [TIExpr]
args'
              Maybe Constraint
Nothing -> do
                -- Not a method, process recursively
                TIExpr
func' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
func
                [TIExpr]
args' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs) [TIExpr]
args
                TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
func' [TIExpr]
args'
          TIExprNode
_ -> do
            -- Not a simple variable, process recursively
            TIExpr
func' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
func
            [TIExpr]
args' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs) [TIExpr]
args
            TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
func' [TIExpr]
args'
      
      -- Lambda: recursively process body
      TILambdaExpr Maybe Var
mVar [Var]
params TIExpr
body -> do
        TIExpr
body' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ Maybe Var -> [Var] -> TIExpr -> TIExprNode
TILambdaExpr Maybe Var
mVar [Var]
params TIExpr
body'
      
      -- If: recursively process
      TIIfExpr TIExpr
cond TIExpr
thenExpr TIExpr
elseExpr -> do
        TIExpr
cond' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
cond
        TIExpr
thenExpr' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
thenExpr
        TIExpr
elseExpr' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
elseExpr
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIExpr -> TIExprNode
TIIfExpr TIExpr
cond' TIExpr
thenExpr' TIExpr
elseExpr'
      
      -- Let: recursively process
      TILetExpr [TIBindingExpr]
bindings TIExpr
body -> do
        [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
pat, TIExpr
e) -> do
          TIExpr
e' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
e
          TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
pat, TIExpr
e')) [TIBindingExpr]
bindings
        TIExpr
body' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIExpr -> TIExprNode
TILetExpr [TIBindingExpr]
bindings' TIExpr
body'
      
      -- LetRec: recursively process
      TILetRecExpr [TIBindingExpr]
bindings TIExpr
body -> do
        [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
pat, TIExpr
e) -> do
          TIExpr
e' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
e
          TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
pat, TIExpr
e')) [TIBindingExpr]
bindings
        TIExpr
body' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
body
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIExpr -> TIExprNode
TILetRecExpr [TIBindingExpr]
bindings' TIExpr
body'
      
      -- Hash: do NOT process values inside dictionary hashes
      -- Dictionary values should remain as simple references
      -- e.g., {| ("eq", eqCollectionEq), ... |} not {| ("eq", eqCollectionEq dict_Eq), ... |}
      -- We return the node as-is without recursively processing the pairs
      TIHashExpr [(TIExpr, TIExpr)]
pairs -> do
        -- Process only keys, not values (values should remain as method references)
        [(TIExpr, TIExpr)]
pairs' <- ((TIExpr, TIExpr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr))
-> [(TIExpr, TIExpr)]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [(TIExpr, TIExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(TIExpr
k, TIExpr
v) -> do
          TIExpr
k' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
k
          -- Do NOT process v - keep it as a simple reference
          (TIExpr, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (TIExpr, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr
k', TIExpr
v)) [(TIExpr, TIExpr)]
pairs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [(TIExpr, TIExpr)] -> TIExprNode
TIHashExpr [(TIExpr, TIExpr)]
pairs'
      
      -- Matcher: recursively process expressions inside matcher definitions
      TIMatcherExpr [TIPatternDef]
patDefs -> do
        [TIPatternDef]
patDefs' <- (TIPatternDef
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIPatternDef)
-> [TIPatternDef]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPatternDef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(PrimitivePatPattern
pat, TIExpr
matcherExpr, [TIBindingExpr]
bindings) -> do
          -- Process the next-matcher expression
          TIExpr
matcherExpr' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
matcherExpr
          -- Process expressions in primitive-data-match clauses
          [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
dp, TIExpr
expr) -> do
            TIExpr
expr' <- ClassEnv -> [Constraint] -> TIExpr -> EvalM TIExpr
replaceMethodCallsWithDictAccessT ClassEnv
env [Constraint]
cs TIExpr
expr
            TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
dp, TIExpr
expr')) [TIBindingExpr]
bindings
          TIPatternDef
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIPatternDef
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitivePatPattern
pat, TIExpr
matcherExpr', [TIBindingExpr]
bindings')) [TIPatternDef]
patDefs
        TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExprNode -> EvalM TIExprNode) -> TIExprNode -> EvalM TIExprNode
forall a b. (a -> b) -> a -> b
$ [TIPatternDef] -> TIExprNode
TIMatcherExpr [TIPatternDef]
patDefs'
      
      -- Other expressions: return as-is for now
      TIExprNode
_ -> TIExprNode -> EvalM TIExprNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExprNode
node

-- | Apply dictionaries to expressions with concrete type constraints
-- This is used for top-level definitions like: def integer : Matcher Integer := eq
-- where the right-hand side (eq) has concrete type constraints {Eq Integer}
applyConcreteConstraintDictionaries :: TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries :: TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
expr = do
  ClassEnv
classEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) ClassEnv
forall (m :: * -> *). MonadEval m => m ClassEnv
getClassEnv
  let scheme :: TypeScheme
scheme@(Forall [TyVar]
vars [Constraint]
constraints Type
_) = TIExpr -> TypeScheme
tiScheme TIExpr
expr

  -- First, recursively process sub-expressions
  TIExpr
expr' <- case TIExpr -> TIExprNode
tiExprNode TIExpr
expr of
    TIApplyExpr TIExpr
func [TIExpr]
args -> do
      TIExpr
func' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
func
      [TIExpr]
args' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries [TIExpr]
args
      TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
scheme (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
func' [TIExpr]
args')
    TIExprNode
_ -> TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
expr

  -- Then check if this expression has concrete constraints
  let isConcreteConstraint :: Constraint -> Bool
isConcreteConstraint (Constraint String
_ (TVar TyVar
_)) = Bool
False
      isConcreteConstraint Constraint
_ = Bool
True
      hasOnlyConcreteConstraints :: Bool
hasOnlyConcreteConstraints = Bool -> Bool
not ([Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint]
constraints) Bool -> Bool -> Bool
&& (Constraint -> Bool) -> [Constraint] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Constraint -> Bool
isConcreteConstraint [Constraint]
constraints

  if Bool
hasOnlyConcreteConstraints
    then do
      -- Apply dictionaries for concrete constraints
      [TIExpr]
dictArgs <- (Constraint -> EvalM TIExpr)
-> [Constraint]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> Constraint -> EvalM TIExpr
resolveDictionaryForConstraint ClassEnv
classEnv) [Constraint]
constraints
      -- Create application: expr dict1 dict2 ...
      let resultType :: Type
resultType = TIExpr -> Type
tiExprType TIExpr
expr'
          -- Update scheme to remove constraints since they are now applied
          -- Keep type variables (vars) as they may be needed for polymorphism
          newScheme :: TypeScheme
newScheme = [TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [TyVar]
vars [] Type
resultType
      TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr TypeScheme
newScheme (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
expr' [TIExpr]
dictArgs)
    else
      -- No concrete constraints, return as-is
      TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
expr'
  where
    -- Resolve dictionary for a concrete constraint
    resolveDictionaryForConstraint :: ClassEnv -> Constraint -> EvalM TIExpr
    resolveDictionaryForConstraint :: ClassEnv -> Constraint -> EvalM TIExpr
resolveDictionaryForConstraint ClassEnv
classEnv (Constraint String
className Type
tyArg) = do
      -- Normalize TInt to TMathExpr for instance matching
      -- Integer and MathExpr are the same type in Egison
      let normalizedType :: Type
normalizedType = case Type
tyArg of
                             Type
TInt -> Type
TMathExpr
                             Type
_ -> Type
tyArg
      let instances :: [InstanceInfo]
instances = String -> ClassEnv -> [InstanceInfo]
lookupInstances String
className ClassEnv
classEnv
      case Type -> [InstanceInfo] -> Maybe InstanceInfo
findMatchingInstanceForType Type
normalizedType [InstanceInfo]
instances of
        Just InstanceInfo
inst -> do
          -- Generate dictionary name (e.g., "eqInteger", "numInteger")
          let instTypeName :: String
instTypeName = Type -> String
typeConstructorName (InstanceInfo -> Type
instType InstanceInfo
inst)
              dictName :: String
dictName = String -> String
lowerFirst String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
instTypeName
              dictType :: Type
dictType = TyVar -> Type
TVar (String -> TyVar
TyVar String
"dict")
              dictExpr :: TIExpr
dictExpr = TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictType) (String -> TIExprNode
TIVarExpr String
dictName)
          
          -- Check if instance has nested constraints
          if [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)
            then do
              -- No constraints: return simple dictionary reference
              TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
dictExpr
            else do
              -- Has constraints: need to resolve them recursively
              [TIExpr]
nestedDictArgs <- (Constraint -> EvalM TIExpr)
-> [Constraint]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> Constraint -> EvalM TIExpr
resolveDictionaryForConstraint ClassEnv
classEnv) (InstanceInfo -> [Constraint]
instContext InstanceInfo
inst)
              TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictType) (TIExpr -> [TIExpr] -> TIExprNode
TIApplyExpr TIExpr
dictExpr [TIExpr]
nestedDictArgs)
        Maybe InstanceInfo
Nothing -> do
          -- No instance found - return dummy dictionary
          let dictName :: String
dictName = String
"dict_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
className String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_NOT_FOUND"
              dictType :: Type
dictType = TyVar -> Type
TVar (String -> TyVar
TyVar String
"dict")
          TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIExpr -> EvalM TIExpr) -> TIExpr -> EvalM TIExpr
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIExprNode -> TIExpr
TIExpr ([TyVar] -> [Constraint] -> Type -> TypeScheme
Forall [] [] Type
dictType) (String -> TIExprNode
TIVarExpr String
dictName)

-- | Expand type class method calls in patterns
-- This is a public wrapper for expandTIPattern used by TypedDesugar
expandTypeClassMethodsInPattern :: TIPattern -> EvalM TIPattern
expandTypeClassMethodsInPattern :: TIPattern -> EvalM TIPattern
expandTypeClassMethodsInPattern TIPattern
tipat = do
  ClassEnv
classEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) ClassEnv
forall (m :: * -> *). MonadEval m => m ClassEnv
getClassEnv
  ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv TIPattern
tipat
  where
    expandPatternWithClassEnv :: ClassEnv -> TIPattern -> EvalM TIPattern
    expandPatternWithClassEnv :: ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' (TIPattern TypeScheme
scheme TIPatternNode
node) = do
      TIPatternNode
node' <- ClassEnv -> TIPatternNode -> EvalM TIPatternNode
expandPatternNode ClassEnv
classEnv' TIPatternNode
node
      TIPattern -> EvalM TIPattern
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPattern -> EvalM TIPattern) -> TIPattern -> EvalM TIPattern
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIPatternNode -> TIPattern
TIPattern TypeScheme
scheme TIPatternNode
node'
    
    expandPatternNode :: ClassEnv -> TIPatternNode -> EvalM TIPatternNode
    expandPatternNode :: ClassEnv -> TIPatternNode -> EvalM TIPatternNode
expandPatternNode ClassEnv
classEnv' TIPatternNode
node = case TIPatternNode
node of
      TILoopPat String
var TILoopRange
loopRange TIPattern
pat1 TIPattern
pat2 -> do
        TILoopRange
loopRange' <- ClassEnv -> TILoopRange -> EvalM TILoopRange
expandLoopRange ClassEnv
classEnv' TILoopRange
loopRange
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TILoopRange -> TIPattern -> TIPattern -> TIPatternNode
TILoopPat String
var TILoopRange
loopRange' TIPattern
pat1' TIPattern
pat2'
      
      TIAndPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIAndPat TIPattern
pat1' TIPattern
pat2'
      
      TIOrPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIOrPat TIPattern
pat1' TIPattern
pat2'
      
      TIForallPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIForallPat TIPattern
pat1' TIPattern
pat2'
      
      TINotPat TIPattern
pat -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPatternNode
TINotPat TIPattern
pat'
      
      TITuplePat [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ [TIPattern] -> TIPatternNode
TITuplePat [TIPattern]
pats'
      
      TIInductivePat String
name [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> [TIPattern] -> TIPatternNode
TIInductivePat String
name [TIPattern]
pats'
      
      TIIndexedPat TIPattern
pat [TIExpr]
exprs -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat
        [TIExpr]
exprs' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIExpr -> EvalM TIExpr
expandTypeClassMethodsT [TIExpr]
exprs
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> [TIExpr] -> TIPatternNode
TIIndexedPat TIPattern
pat' [TIExpr]
exprs'
      
      TILetPat [TIBindingExpr]
bindings TIPattern
pat -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat
        [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
pd, TIExpr
e) -> do
          TIExpr
e' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
e
          TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
pd, TIExpr
e')) [TIBindingExpr]
bindings
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIPattern -> TIPatternNode
TILetPat [TIBindingExpr]
bindings' TIPattern
pat'
      
      TIPApplyPat TIExpr
funcExpr [TIPattern]
argPats -> do
        TIExpr
funcExpr' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
funcExpr
        [TIPattern]
argPats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv') [TIPattern]
argPats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIPattern] -> TIPatternNode
TIPApplyPat TIExpr
funcExpr' [TIPattern]
argPats'
      
      TIDApplyPat TIPattern
pat [TIPattern]
pats -> do
        TIPattern
pat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> [TIPattern] -> TIPatternNode
TIDApplyPat TIPattern
pat' [TIPattern]
pats'
      
      TISeqConsPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat1
        TIPattern
pat2' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TISeqConsPat TIPattern
pat1' TIPattern
pat2'
      
      TIInductiveOrPApplyPat String
name [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv') [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> [TIPattern] -> TIPatternNode
TIInductiveOrPApplyPat String
name [TIPattern]
pats'
      
      TIValuePat TIExpr
expr -> do
        TIExpr
expr' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
expr
        TIExpr
expr'' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
expr'
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIPatternNode
TIValuePat TIExpr
expr''
      
      TIPredPat TIExpr
pred -> do
        TIExpr
pred' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
pred
        TIExpr
pred'' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
pred'
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIPatternNode
TIPredPat TIExpr
pred''
      
      -- Leaf patterns
      TIPatternNode
TISeqNilPat -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TISeqNilPat
      TIVarPat String
name -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TIPatternNode
TIVarPat String
name
      TIPatternNode
TIWildCard -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TIWildCard
      TIPatVar String
name -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TIPatternNode
TIPatVar String
name
      TIPatternNode
TIContPat -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TIContPat
      TIPatternNode
TILaterPatVar -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TILaterPatVar
    
    expandLoopRange :: ClassEnv -> TILoopRange -> EvalM TILoopRange
    expandLoopRange :: ClassEnv -> TILoopRange -> EvalM TILoopRange
expandLoopRange ClassEnv
classEnv' (TILoopRange TIExpr
start TIExpr
end TIPattern
rangePat) = do
      TIExpr
start' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
start
      TIExpr
end' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
end
      TIPattern
rangePat' <- ClassEnv -> TIPattern -> EvalM TIPattern
expandPatternWithClassEnv ClassEnv
classEnv' TIPattern
rangePat
      TILoopRange -> EvalM TILoopRange
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TILoopRange -> EvalM TILoopRange)
-> TILoopRange -> EvalM TILoopRange
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIPattern -> TILoopRange
TILoopRange TIExpr
start' TIExpr
end' TIPattern
rangePat'

-- | Apply dictionaries to expressions with concrete constraints in patterns
-- This is used to apply dictionaries to value patterns like #(n + 1)
applyConcreteConstraintDictionariesInPattern :: TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern :: TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern (TIPattern TypeScheme
scheme TIPatternNode
node) = do
  TIPatternNode
node' <- TIPatternNode -> EvalM TIPatternNode
applyDictInPatternNode TIPatternNode
node
  TIPattern -> EvalM TIPattern
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPattern -> EvalM TIPattern) -> TIPattern -> EvalM TIPattern
forall a b. (a -> b) -> a -> b
$ TypeScheme -> TIPatternNode -> TIPattern
TIPattern TypeScheme
scheme TIPatternNode
node'
  where
    applyDictInPatternNode :: TIPatternNode -> EvalM TIPatternNode
    applyDictInPatternNode :: TIPatternNode -> EvalM TIPatternNode
applyDictInPatternNode TIPatternNode
pnode = case TIPatternNode
pnode of
      TIValuePat TIExpr
expr -> do
        TIExpr
expr' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
expr
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIPatternNode
TIValuePat TIExpr
expr'
      
      TIPredPat TIExpr
expr -> do
        TIExpr
expr' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
expr
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIPatternNode
TIPredPat TIExpr
expr'
      
      TIIndexedPat TIPattern
pat [TIExpr]
exprs -> do
        TIPattern
pat' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat
        [TIExpr]
exprs' <- (TIExpr -> EvalM TIExpr)
-> [TIExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries [TIExpr]
exprs
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> [TIExpr] -> TIPatternNode
TIIndexedPat TIPattern
pat' [TIExpr]
exprs'
      
      TILetPat [TIBindingExpr]
bindings TIPattern
pat -> do
        TIPattern
pat' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat
        [TIBindingExpr]
bindings' <- (TIBindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr)
-> [TIBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(IPrimitiveDataPattern
pd, TIExpr
e) -> do
          TIExpr
e' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
e
          TIBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) TIBindingExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPrimitiveDataPattern
pd, TIExpr
e')) [TIBindingExpr]
bindings
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ [TIBindingExpr] -> TIPattern -> TIPatternNode
TILetPat [TIBindingExpr]
bindings' TIPattern
pat'
      
      TILoopPat String
var TILoopRange
loopRange TIPattern
pat1 TIPattern
pat2 -> do
        TILoopRange
loopRange' <- TILoopRange -> EvalM TILoopRange
applyDictInLoopRange TILoopRange
loopRange
        TIPattern
pat1' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat1
        TIPattern
pat2' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TILoopRange -> TIPattern -> TIPattern -> TIPatternNode
TILoopPat String
var TILoopRange
loopRange' TIPattern
pat1' TIPattern
pat2'
      
      TIAndPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat1
        TIPattern
pat2' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIAndPat TIPattern
pat1' TIPattern
pat2'
      
      TIOrPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat1
        TIPattern
pat2' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIOrPat TIPattern
pat1' TIPattern
pat2'
      
      TIForallPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat1
        TIPattern
pat2' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TIForallPat TIPattern
pat1' TIPattern
pat2'
      
      TINotPat TIPattern
pat -> do
        TIPattern
pat' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPatternNode
TINotPat TIPattern
pat'
      
      TITuplePat [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ [TIPattern] -> TIPatternNode
TITuplePat [TIPattern]
pats'
      
      TIInductivePat String
name [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> [TIPattern] -> TIPatternNode
TIInductivePat String
name [TIPattern]
pats'
      
      TIPApplyPat TIExpr
funcExpr [TIPattern]
argPats -> do
        TIExpr
funcExpr' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
funcExpr
        [TIPattern]
argPats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern [TIPattern]
argPats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIExpr -> [TIPattern] -> TIPatternNode
TIPApplyPat TIExpr
funcExpr' [TIPattern]
argPats'
      
      TIDApplyPat TIPattern
pat [TIPattern]
pats -> do
        TIPattern
pat' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> [TIPattern] -> TIPatternNode
TIDApplyPat TIPattern
pat' [TIPattern]
pats'
      
      TISeqConsPat TIPattern
pat1 TIPattern
pat2 -> do
        TIPattern
pat1' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat1
        TIPattern
pat2' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
pat2
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ TIPattern -> TIPattern -> TIPatternNode
TISeqConsPat TIPattern
pat1' TIPattern
pat2'
      
      TIInductiveOrPApplyPat String
name [TIPattern]
pats -> do
        [TIPattern]
pats' <- (TIPattern -> EvalM TIPattern)
-> [TIPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [TIPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern [TIPattern]
pats
        TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> [TIPattern] -> TIPatternNode
TIInductiveOrPApplyPat String
name [TIPattern]
pats'
      
      -- Leaf patterns
      TIPatternNode
TISeqNilPat -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TISeqNilPat
      TIVarPat String
name -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TIPatternNode
TIVarPat String
name
      TIPatternNode
TIWildCard -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TIWildCard
      TIPatVar String
name -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TIPatternNode -> EvalM TIPatternNode)
-> TIPatternNode -> EvalM TIPatternNode
forall a b. (a -> b) -> a -> b
$ String -> TIPatternNode
TIPatVar String
name
      TIPatternNode
TIContPat -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TIContPat
      TIPatternNode
TILaterPatVar -> TIPatternNode -> EvalM TIPatternNode
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIPatternNode
TILaterPatVar
    
    applyDictInLoopRange :: TILoopRange -> EvalM TILoopRange
    applyDictInLoopRange :: TILoopRange -> EvalM TILoopRange
applyDictInLoopRange (TILoopRange TIExpr
start TIExpr
end TIPattern
rangePat) = do
      TIExpr
start' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
start
      TIExpr
end' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
end
      TIPattern
rangePat' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
rangePat
      TILoopRange -> EvalM TILoopRange
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TILoopRange -> EvalM TILoopRange)
-> TILoopRange -> EvalM TILoopRange
forall a b. (a -> b) -> a -> b
$ TIExpr -> TIExpr -> TIPattern -> TILoopRange
TILoopRange TIExpr
start' TIExpr
end' TIPattern
rangePat'