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

This module implements Phase 8 of the processing flow: TypedDesugar.
It orchestrates type-driven transformations on TIExpr (Typed Internal Expressions)
by calling specialized expansion modules.

Type-Driven Transformations (Phase 8):
  1. Type class dictionary passing (via TypeClassExpand)
     - Instance selection based on types
     - Method call concretization
  2. Type information optimization and embedding
     - Preserve type info for better error messages during evaluation
     - Each node in TIExpr contains its type

Type information is preserved throughout desugaring, enabling:
  - Better runtime error messages with type information
  - Type-based dispatch during evaluation
  - Debugging support with type annotations
-}

module Language.Egison.Type.TypedDesugar
  ( desugarTypedExprT
  , desugarTypedTopExprT
  , desugarTypedTopExprT_TensorMapOnly
  , desugarTypedTopExprT_TypeClassOnly
  ) where

import           Language.Egison.Data       (EvalM)
import           Language.Egison.EvalState  (MonadEval(..))
import           Language.Egison.IExpr      (TIExpr(..), TITopExpr(..), extractNameFromVar, stringToVar)
import           Language.Egison.Type.Env   (lookupEnv)
import           Language.Egison.Type.TensorMapInsertion (insertTensorMaps)
import           Language.Egison.Type.TypeClassExpand (expandTypeClassMethodsT, expandTypeClassMethodsInPattern, addDictionaryParametersT, applyConcreteConstraintDictionaries, applyConcreteConstraintDictionariesInPattern)

-- | Desugar a typed expression (TIExpr) with type-driven transformations
-- This function orchestrates the transformation pipeline:
--   1. Insert tensorMap where needed (TensorMapInsertion)
--   2. Expand type class methods (dictionary passing)
--
-- The order matters: tensorMap insertion should happen before type class expansion
-- because after tensorMap insertion, argument types (scalar vs tensor) are determined,
-- which allows type class expansion to use unifyStrict for instance selection.
desugarTypedExprT :: TIExpr -> EvalM TIExpr
desugarTypedExprT :: TIExpr -> EvalM TIExpr
desugarTypedExprT TIExpr
tiexpr = do
  -- Step 1: Insert tensorMap where needed
  TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
insertTensorMaps TIExpr
tiexpr

  -- Step 2: Expand type class methods (dictionary passing)
  TIExpr
tiexpr'' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
tiexpr'

  TIExpr -> EvalM TIExpr
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return TIExpr
tiexpr''

-- | Desugar a top-level typed expression (TITopExpr)
-- This is the main entry point for Phase 8 transformations.
desugarTypedTopExprT :: TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT :: TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT TITopExpr
topExpr = case TITopExpr
topExpr of
  TIDefine TypeScheme
scheme Var
var TIExpr
tiexpr -> do
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
desugarTypedExprT TIExpr
tiexpr
    -- Apply dictionaries to right-hand side if it has concrete type constraints
    TIExpr
tiexpr'' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
tiexpr'
    -- Add dictionary parameters for constrained functions
    TIExpr
tiexpr''' <- TypeScheme -> TIExpr -> EvalM TIExpr
addDictionaryParametersT TypeScheme
scheme TIExpr
tiexpr''
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TypeScheme -> Var -> TIExpr -> TITopExpr
TIDefine TypeScheme
scheme Var
var TIExpr
tiexpr''')
  
  TITest TIExpr
tiexpr -> do
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
desugarTypedExprT TIExpr
tiexpr
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TIExpr -> TITopExpr
TITest TIExpr
tiexpr')
  
  TIExecute TIExpr
tiexpr -> do
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
desugarTypedExprT TIExpr
tiexpr
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TIExpr -> TITopExpr
TIExecute TIExpr
tiexpr')
  
  TILoadFile String
path -> 
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String -> TITopExpr
TILoadFile String
path)
  
  TILoad String
lib -> 
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String -> TITopExpr
TILoad String
lib)
  
  TIDefineMany [(Var, TIExpr)]
bindings -> do
    [(Var, TIExpr)]
bindings' <- ((Var, TIExpr)
 -> StateT EvalState (ExceptT EgisonError RuntimeM) (Var, TIExpr))
-> [(Var, TIExpr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [(Var, 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 (\(Var
var, TIExpr
tiexpr) -> do
      TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
desugarTypedExprT TIExpr
tiexpr
      -- Add dictionary parameters using the variable's type scheme from TypeEnv
      -- This is important for dictionary definitions where the expression (hash)
      -- may not have constraints, but the variable has constraints in its type scheme
      TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
      let varName :: String
varName = Var -> String
extractNameFromVar Var
var
          scheme :: TypeScheme
scheme = case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
varName) TypeEnv
typeEnv of
                     Just TypeScheme
ts -> TypeScheme
ts  -- Use type scheme from environment
                     Maybe TypeScheme
Nothing -> TIExpr -> TypeScheme
tiScheme TIExpr
tiexpr'  -- Fallback to expression's scheme
      TIExpr
tiexpr'' <- TypeScheme -> TIExpr -> EvalM TIExpr
addDictionaryParametersT TypeScheme
scheme TIExpr
tiexpr'
      (Var, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Var, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
var, TIExpr
tiexpr'')) [(Var, TIExpr)]
bindings
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just ([(Var, TIExpr)] -> TITopExpr
TIDefineMany [(Var, TIExpr)]
bindings')
  
  TIDeclareSymbol [String]
names Type
ty ->
    -- Symbol declarations don't need type-driven transformations
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just ([String] -> Type -> TITopExpr
TIDeclareSymbol [String]
names Type
ty)
  
  TIPatternFunctionDecl String
name TypeScheme
typeScheme [(String, Type)]
params Type
retType TIPattern
body -> do
    -- Pattern function declarations: apply type class expansion and dictionary application to body
    TIPattern
body' <- TIPattern -> EvalM TIPattern
expandTypeClassMethodsInPattern TIPattern
body
    TIPattern
body'' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
body'
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String
-> TypeScheme -> [(String, Type)] -> Type -> TIPattern -> TITopExpr
TIPatternFunctionDecl String
name TypeScheme
typeScheme [(String, Type)]
params Type
retType TIPattern
body'')

-- | Desugar a top-level typed expression with TensorMap insertion only
-- This is used for --dump-ti (intermediate dump after TensorMap insertion)
desugarTypedTopExprT_TensorMapOnly :: TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT_TensorMapOnly :: TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT_TensorMapOnly TITopExpr
topExpr = case TITopExpr
topExpr of
  TIDefine TypeScheme
scheme Var
var TIExpr
tiexpr -> do
    -- Only insert tensorMap (no type class expansion)
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
insertTensorMaps TIExpr
tiexpr
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TypeScheme -> Var -> TIExpr -> TITopExpr
TIDefine TypeScheme
scheme Var
var TIExpr
tiexpr')

  TITest TIExpr
tiexpr -> do
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
insertTensorMaps TIExpr
tiexpr
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TIExpr -> TITopExpr
TITest TIExpr
tiexpr')

  TIExecute TIExpr
tiexpr -> do
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
insertTensorMaps TIExpr
tiexpr
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TIExpr -> TITopExpr
TIExecute TIExpr
tiexpr')

  TILoadFile String
path ->
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String -> TITopExpr
TILoadFile String
path)

  TILoad String
lib ->
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String -> TITopExpr
TILoad String
lib)

  TIDefineMany [(Var, TIExpr)]
bindings -> do
    [(Var, TIExpr)]
bindings' <- ((Var, TIExpr)
 -> StateT EvalState (ExceptT EgisonError RuntimeM) (Var, TIExpr))
-> [(Var, TIExpr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [(Var, 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 (\(Var
var, TIExpr
tiexpr) -> do
      TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
insertTensorMaps TIExpr
tiexpr
      (Var, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Var, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
var, TIExpr
tiexpr')) [(Var, TIExpr)]
bindings
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just ([(Var, TIExpr)] -> TITopExpr
TIDefineMany [(Var, TIExpr)]
bindings')

  TIDeclareSymbol [String]
names Type
ty ->
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just ([String] -> Type -> TITopExpr
TIDeclareSymbol [String]
names Type
ty)
  
  TIPatternFunctionDecl String
name TypeScheme
typeScheme [(String, Type)]
params Type
retType TIPattern
body ->
    -- Pattern function declarations: TensorMap insertion only
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String
-> TypeScheme -> [(String, Type)] -> Type -> TIPattern -> TITopExpr
TIPatternFunctionDecl String
name TypeScheme
typeScheme [(String, Type)]
params Type
retType TIPattern
body)

-- | Expand type class methods only (assumes TensorMap insertion is already done)
-- This is used internally to perform type class expansion after TensorMap insertion
desugarTypedTopExprT_TypeClassOnly :: TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT_TypeClassOnly :: TITopExpr -> EvalM (Maybe TITopExpr)
desugarTypedTopExprT_TypeClassOnly TITopExpr
topExpr = case TITopExpr
topExpr of
  TIDefine TypeScheme
scheme Var
var TIExpr
tiexpr -> do
    -- Only expand type class methods (assumes tensorMap is already inserted)
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
tiexpr
    -- Apply dictionaries to right-hand side if it has concrete type constraints
    TIExpr
tiexpr'' <- TIExpr -> EvalM TIExpr
applyConcreteConstraintDictionaries TIExpr
tiexpr'
    -- Add dictionary parameters for constrained functions
    TIExpr
tiexpr''' <- TypeScheme -> TIExpr -> EvalM TIExpr
addDictionaryParametersT TypeScheme
scheme TIExpr
tiexpr''
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TypeScheme -> Var -> TIExpr -> TITopExpr
TIDefine TypeScheme
scheme Var
var TIExpr
tiexpr''')

  TITest TIExpr
tiexpr -> do
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
tiexpr
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TIExpr -> TITopExpr
TITest TIExpr
tiexpr')

  TIExecute TIExpr
tiexpr -> do
    TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
tiexpr
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (TIExpr -> TITopExpr
TIExecute TIExpr
tiexpr')

  TILoadFile String
path ->
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String -> TITopExpr
TILoadFile String
path)

  TILoad String
lib ->
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String -> TITopExpr
TILoad String
lib)

  TIDefineMany [(Var, TIExpr)]
bindings -> do
    [(Var, TIExpr)]
bindings' <- ((Var, TIExpr)
 -> StateT EvalState (ExceptT EgisonError RuntimeM) (Var, TIExpr))
-> [(Var, TIExpr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [(Var, 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 (\(Var
var, TIExpr
tiexpr) -> do
      TIExpr
tiexpr' <- TIExpr -> EvalM TIExpr
expandTypeClassMethodsT TIExpr
tiexpr
      -- Add dictionary parameters using the variable's type scheme from TypeEnv
      TypeEnv
typeEnv <- StateT EvalState (ExceptT EgisonError RuntimeM) TypeEnv
forall (m :: * -> *). MonadEval m => m TypeEnv
getTypeEnv
      let varName :: String
varName = Var -> String
extractNameFromVar Var
var
          scheme :: TypeScheme
scheme = case Var -> TypeEnv -> Maybe TypeScheme
lookupEnv (String -> Var
stringToVar String
varName) TypeEnv
typeEnv of
                     Just TypeScheme
ts -> TypeScheme
ts
                     Maybe TypeScheme
Nothing -> TIExpr -> TypeScheme
tiScheme TIExpr
tiexpr'
      TIExpr
tiexpr'' <- TypeScheme -> TIExpr -> EvalM TIExpr
addDictionaryParametersT TypeScheme
scheme TIExpr
tiexpr'
      (Var, TIExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Var, TIExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
var, TIExpr
tiexpr'')) [(Var, TIExpr)]
bindings
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just ([(Var, TIExpr)] -> TITopExpr
TIDefineMany [(Var, TIExpr)]
bindings')
  
  TIDeclareSymbol [String]
names Type
ty ->
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just ([String] -> Type -> TITopExpr
TIDeclareSymbol [String]
names Type
ty)
  
  TIPatternFunctionDecl String
name TypeScheme
typeScheme [(String, Type)]
params Type
retType TIPattern
body -> do
    -- Pattern function declarations: expand type class methods and apply dictionaries in body
    TIPattern
body' <- TIPattern -> EvalM TIPattern
expandTypeClassMethodsInPattern TIPattern
body
    TIPattern
body'' <- TIPattern -> EvalM TIPattern
applyConcreteConstraintDictionariesInPattern TIPattern
body'
    Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TITopExpr -> EvalM (Maybe TITopExpr))
-> Maybe TITopExpr -> EvalM (Maybe TITopExpr)
forall a b. (a -> b) -> a -> b
$ TITopExpr -> Maybe TITopExpr
forall a. a -> Maybe a
Just (String
-> TypeScheme -> [(String, Type)] -> Type -> TIPattern -> TITopExpr
TIPatternFunctionDecl String
name TypeScheme
typeScheme [(String, Type)]
params Type
retType TIPattern
body'')