-#include "HsVersions.h"
-
-module TcMonad (
- TcM(..), TcResult{-abstract-},
- thenTc, thenTc_, returnTc, failTc, checkTc,
- listTc, mapTc, mapAndUnzipTc,
- fixTc, foldlTc, initTc,
- recoverTc, recoverQuietlyTc,
-
- NF_TcM(..),
- thenNF_Tc, returnNF_Tc, listNF_Tc, mapNF_Tc,
- fixNF_Tc, noFailTc,
-
- Baby_TcM(..), Baby_TcResult{-abstract-},
- returnB_Tc, thenB_Tc, thenB_Tc_,
- failB_Tc, recoverIgnoreErrorsB_Tc,
- fixB_Tc, mapB_Tc,
- babyTcMtoTcM, babyTcMtoNF_TcM,
- getUniqueB_Tc, getUniquesB_Tc,
- addSrcLocB_Tc, getSrcLocB_Tc,
- getSwitchCheckerB_Tc, checkB_Tc,
- uniqSMtoBabyTcM,
-
- getSwitchCheckerTc,
- getDefaultingTys, setDefaultingTys,
- getUniquesTc, getUniqueTc,
- rn4MtoTcM,
-
- getTyVarUniquesTc, getTyVarUniqueTc,
-
- applyTcSubstToTy, applyTcSubstToTys,
---UNUSED: applyTcSubstToThetaTy,
- applyTcSubstToTyVar, applyTcSubstToTyVars,
- applyTcSubstToId,
- applyTcSubstToInst, applyTcSubstToInsts,
- extendSubstTc, pruneSubstTc,
-
- addSrcLocTc, getSrcLocTc,
- checkMaybeTc, checkMaybesTc,
- checkMaybeErrTc, -- UNUSED: checkMaybeErrsTc,
-
- lookupInst_Tc, lookupNoBindInst_Tc,
-
- -- and to make the interface self-sufficient ...
- UniqueSupply, SplitUniqSupply,
- Bag, Maybe, MaybeErr, Error(..), PprStyle, Pretty(..),
- PrettyRep, SrcLoc, Subst, TyVar, TyVarTemplate, TyCon,
- Class, UniType, TauType(..), ThetaType(..), SigmaType(..),
- UnifyErrContext, Unique, Expr,
- TypecheckedExpr(..), TypecheckedPat, Id, IdInfo, Inst,
- GlobalSwitch, SUniqSM(..), Rn4M(..), GlobalNameFuns(..),
- GlobalNameFun(..), Name, ProtoName
-
- IF_ATTACK_PRAGMAS(COMMA getSUnique COMMA getSUniques)
- IF_ATTACK_PRAGMAS(COMMA splitUniqSupply COMMA mkUniqueGrimily)
- IF_ATTACK_PRAGMAS(COMMA applySubstToId)
- IF_ATTACK_PRAGMAS(COMMA applySubstToInst)
- IF_ATTACK_PRAGMAS(COMMA applySubstToThetaTy)
- IF_ATTACK_PRAGMAS(COMMA applySubstToTy)
- IF_ATTACK_PRAGMAS(COMMA applySubstToTyVar)
- ) where
-
-import AbsSyn
-import AbsUniType ( TyVar, TyVarTemplate, TyCon, Class, UniType,
- TauType(..), ThetaType(..), SigmaType(..)
- IF_ATTACK_PRAGMAS(COMMA cmpUniType)
- )
-import Bag ( Bag, snocBag, emptyBag, isEmptyBag )
-import CmdLineOpts ( GlobalSwitch )
-import Errors ( noInstanceErr, unifyErr, pprBagOfErrors,
- Error(..), UnifyErrInfo(..), UnifyErrContext(..)
- )
-import FiniteMap ( emptyFM, FiniteMap )
-import Id ( applySubstToId )
-import Inst ( applySubstToInst )
-import InstEnv ( lookupInst, lookupNoBindInst, Inst )
-import Maybes ( Maybe(..), MaybeErr(..) )
-import Pretty
-import RenameMonad4 ( Rn4M(..), GlobalNameFuns(..), GlobalNameFun(..) )
-import SrcLoc ( mkUnknownSrcLoc )
-import Subst
-import Unify
-import SplitUniq
-import Unique
-import Util
-
-infixr 9 `thenTc`, `thenTc_`, `thenNF_Tc`
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[TcM-TcM]{Plain @TcM@ monadery}
-%* *
-%************************************************************************
-
-The following @TcM@ is of the garden variety which can fail, and does
-as soon as possible.
-
-\begin{code}
--- internal use only...
-type InTcM output
- = (GlobalSwitch -> Bool) -- so we can chk cmd-line switches
- -> [UniType] -- types used for defaulting; down only
- -> Subst -- substitution; threaded
- -> SplitUniqSupply -- threaded
- -> Bag Error -- threaded
- -> SrcLoc -- only passed downwards
- -> output
-
-data TcResult result
- = TcSucceeded result
- Subst
- (Bag Error)
- | TcFailed Subst
- (Bag Error)
-
-type TcM result
- = InTcM (TcResult result)
-
-#ifdef __GLASGOW_HASKELL__
-{-# INLINE thenTc #-}
-{-# INLINE thenTc_ #-}
-{-# INLINE returnTc #-}
-#endif
-
-thenTc :: TcM a -> (a -> TcM b) -> TcM b
-thenTc_ :: TcM a -> TcM b -> TcM b
-
-thenTc expr cont sw_chkr dtys subst us errs src_loc
- = case splitUniqSupply us of { (s1, s2) ->
- case (expr sw_chkr dtys subst s1 errs src_loc) of
- TcFailed subst errs -> TcFailed subst errs
- TcSucceeded result subst2 errs2
- -> cont result sw_chkr dtys subst2 s2 errs2 src_loc
- }
-
-thenTc_ expr cont sw_chkr dtys subst us errs src_loc
- = case splitUniqSupply us of { (s1, s2) ->
- case (expr sw_chkr dtys subst s1 errs src_loc) of
- TcFailed subst errs -> TcFailed subst errs
- TcSucceeded _ subst2 errs2
- -> cont sw_chkr dtys subst2 s2 errs2 src_loc
- }
-
-returnTc :: a -> TcM a
-returnTc result sw_chkr dtys subst us errs src_loc
- = TcSucceeded result subst errs
-
-failTc err sw_chkr dtys subst us errs src_loc
- = TcFailed subst (errs `snocBag` err)
-\end{code}