2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[TcMonad]{@TcMonad@: monad machinery for the typechecker}
7 #include "HsVersions.h"
10 TcM(..), TcResult{-abstract-},
11 thenTc, thenTc_, returnTc, failTc, checkTc,
12 listTc, mapTc, mapAndUnzipTc,
13 fixTc, foldlTc, initTc,
14 recoverTc, recoverQuietlyTc,
17 thenNF_Tc, thenLazilyNF_Tc, returnNF_Tc, listNF_Tc, mapNF_Tc,
20 Baby_TcM(..), Baby_TcResult{-abstract-},
21 returnB_Tc, thenB_Tc, thenB_Tc_,
22 failB_Tc, recoverIgnoreErrorsB_Tc,
24 babyTcMtoTcM, babyTcMtoNF_TcM,
25 getUniqueB_Tc, getUniquesB_Tc,
26 addSrcLocB_Tc, getSrcLocB_Tc,
27 getSwitchCheckerB_Tc, checkB_Tc,
31 getDefaultingTys, setDefaultingTys,
32 getUniquesTc, getUniqueTc,
35 getTyVarUniquesTc, getTyVarUniqueTc,
37 applyTcSubstToTy, applyTcSubstToTys,
38 --UNUSED: applyTcSubstToThetaTy,
39 applyTcSubstToTyVar, applyTcSubstToTyVars,
41 applyTcSubstToInst, applyTcSubstToInsts,
42 extendSubstTc, pruneSubstTc,
44 addSrcLocTc, getSrcLocTc,
45 checkMaybeTc, checkMaybesTc,
46 checkMaybeErrTc, -- UNUSED: checkMaybeErrsTc,
48 lookupInst_Tc, lookupNoBindInst_Tc,
50 -- and to make the interface self-sufficient ...
51 UniqueSupply, SplitUniqSupply,
52 Bag, Maybe, MaybeErr, Error(..), PprStyle, Pretty(..),
53 PrettyRep, SrcLoc, Subst, TyVar, TyVarTemplate, TyCon,
54 Class, UniType, TauType(..), ThetaType(..), SigmaType(..),
55 UnifyErrContext, Unique, Expr,
56 TypecheckedExpr(..), TypecheckedPat, Id, IdInfo, Inst,
57 GlobalSwitch, SUniqSM(..), Rn4M(..), GlobalNameFuns(..),
58 GlobalNameFun(..), Name, ProtoName
60 IF_ATTACK_PRAGMAS(COMMA getSUnique COMMA getSUniques)
61 IF_ATTACK_PRAGMAS(COMMA splitUniqSupply COMMA mkUniqueGrimily)
62 IF_ATTACK_PRAGMAS(COMMA applySubstToId)
63 IF_ATTACK_PRAGMAS(COMMA applySubstToInst)
64 IF_ATTACK_PRAGMAS(COMMA applySubstToThetaTy)
65 IF_ATTACK_PRAGMAS(COMMA applySubstToTy)
66 IF_ATTACK_PRAGMAS(COMMA applySubstToTyVar)
70 import AbsUniType ( TyVar, TyVarTemplate, TyCon, Class, UniType,
71 TauType(..), ThetaType(..), SigmaType(..)
72 IF_ATTACK_PRAGMAS(COMMA cmpUniType)
74 import Bag ( Bag, snocBag, emptyBag, isEmptyBag )
75 import CmdLineOpts ( GlobalSwitch )
76 import Errors ( noInstanceErr, unifyErr, pprBagOfErrors,
77 Error(..), UnifyErrInfo(..), UnifyErrContext(..)
79 import FiniteMap ( emptyFM, FiniteMap )
80 import Id ( applySubstToId )
81 import Inst ( applySubstToInst )
82 import InstEnv ( lookupInst, lookupNoBindInst, Inst )
83 import Maybes ( Maybe(..), MaybeErr(..) )
85 import RenameMonad4 ( Rn4M(..), GlobalNameFuns(..), GlobalNameFun(..) )
86 import SrcLoc ( mkUnknownSrcLoc )
93 infixr 9 `thenTc`, `thenTc_`, `thenNF_Tc`, `thenLazilyNF_Tc`
96 %************************************************************************
98 \subsection[TcM-TcM]{Plain @TcM@ monadery}
100 %************************************************************************
102 The following @TcM@ is of the garden variety which can fail, and does
106 -- internal use only...
108 = (GlobalSwitch -> Bool) -- so we can chk cmd-line switches
109 -> [UniType] -- types used for defaulting; down only
110 -> Subst -- substitution; threaded
111 -> SplitUniqSupply -- threaded
112 -> Bag Error -- threaded
113 -> SrcLoc -- only passed downwards
124 = InTcM (TcResult result)
126 #ifdef __GLASGOW_HASKELL__
127 {-# INLINE thenTc #-}
128 {-# INLINE thenTc_ #-}
129 {-# INLINE returnTc #-}
132 thenTc :: TcM a -> (a -> TcM b) -> TcM b
133 thenTc_ :: TcM a -> TcM b -> TcM b
135 thenTc expr cont sw_chkr dtys subst us errs src_loc
136 = case splitUniqSupply us of { (s1, s2) ->
137 case (expr sw_chkr dtys subst s1 errs src_loc) of
138 TcFailed subst errs -> TcFailed subst errs
139 TcSucceeded result subst2 errs2
140 -> cont result sw_chkr dtys subst2 s2 errs2 src_loc
143 thenTc_ expr cont sw_chkr dtys subst us errs src_loc
144 = case splitUniqSupply us of { (s1, s2) ->
145 case (expr sw_chkr dtys subst s1 errs src_loc) of
146 TcFailed subst errs -> TcFailed subst errs
147 TcSucceeded _ subst2 errs2
148 -> cont sw_chkr dtys subst2 s2 errs2 src_loc
151 returnTc :: a -> TcM a
152 returnTc result sw_chkr dtys subst us errs src_loc
153 = TcSucceeded result subst errs
155 failTc err sw_chkr dtys subst us errs src_loc
156 = TcFailed subst (errs `snocBag` err)
159 @recoverTc@ recovers from an error, by providing a value to use
160 instead. It is also lazy, in that it always succeeds immediately; the
161 thing inside is only even looked at when you pull on the errors, or on
164 @recoverQuietlyTc@ doesn't even report the errors found---it is used
165 when looking at pragmas.
168 recoverTc, recoverQuietlyTc :: a -> TcM a -> NF_TcM a
170 recoverTc use_this_if_err expr sw_chkr dtys subst uniqs_in errs_in src_loc
171 = case (expr sw_chkr dtys (pushSubstUndos subst) uniqs_in errs_in src_loc) of
172 TcSucceeded result subst_out errs_out ->
173 (result, combineSubstUndos subst_out, errs_out)
175 TcFailed subst_out errs_out ->
176 (use_this_if_err, undoSubstUndos subst_out, errs_out)
177 -- Note that we return the *undone* substitution
178 -- and the *incoming* UniqueSupply
180 recoverQuietlyTc use_this_if_err expr sw_chkr dtys subst uniqs_in errs_in src_loc
184 = case (expr sw_chkr dtys (pushSubstUndos subst) uniqs_in errs_in src_loc) of
185 TcSucceeded result subst_out errs_out ->
186 (result, combineSubstUndos subst_out, errs_out)
188 TcFailed subst_out errs_out ->
189 (use_this_if_err, undoSubstUndos subst_out, errs_in)
190 -- Note that we return the *undone* substitution,
191 -- the *incoming* UniqueSupply, and the *incoming* errors
194 The following @TcM@ checks a condition and fails with the given error
198 checkTc :: Bool -> Error -> TcM ()
200 checkTc True err = failTc err
201 checkTc False err = returnTc ()
203 listTc :: [TcM a] -> TcM [a]
205 listTc [] = returnTc []
208 listTc xs `thenTc` \ rs ->
211 mapTc :: (a -> TcM b) -> [a] -> TcM [b]
212 mapTc f [] = returnTc []
214 = f x `thenTc` \ r ->
215 mapTc f xs `thenTc` \ rs ->
218 mapAndUnzipTc :: (a -> TcM (b, c)) -> [a] -> TcM ([b], [c])
220 mapAndUnzipTc f [] = returnTc ([], [])
221 mapAndUnzipTc f (x:xs)
222 = f x `thenTc` \ (r1, r2) ->
223 mapAndUnzipTc f xs `thenTc` \ (rs1, rs2) ->
224 returnTc (r1:rs1, r2:rs2)
226 foldlTc :: (a -> b -> TcM a) -> a -> [b] -> TcM a
227 foldlTc f a [] = returnTc a
228 foldlTc f a (b:bs) = f a b `thenTc` \ a2 ->
231 fixTc :: (x -> TcM x) -> TcM x
232 fixTc m sw_chkr dtys subst us errs src_loc
235 lim = m result sw_chkr dtys subst us errs src_loc
237 TcSucceeded result _ _ -> result
239 TcFailed _ errs -> pprPanic "Failed in fixTc:\n" (pprBagOfErrors PprDebug errs)
243 And the machinery to start things up:
249 initTc :: (GlobalSwitch -> Bool)
252 -> MaybeErr result (Bag Error)
255 = case (tc sw_chkr [{-no defaults-}] init_subst us emptyBag mkUnknownSrcLoc) of
256 TcFailed _ errs -> Failed errs
257 TcSucceeded result subst2 errs
258 -> if isEmptyBag errs then
263 init_subst = mkEmptySubst aRRAY_SIZE -- out here to avoid initTc CAF...sigh
267 %************************************************************************
269 \subsection[TcM-NF_TcM]{No-fail @NF_TcM@ monadery}
271 %************************************************************************
273 This is a no-fail version of a TcM.
276 -- ToDo: re-order fields to match TcM?
277 type NF_TcM result = InTcM (result, Subst, Bag Error)
279 #ifdef __GLASGOW_HASKELL__
280 {-# INLINE thenNF_Tc #-}
281 {-# INLINE thenLazilyNF_Tc #-}
282 {-# INLINE returnNF_Tc #-}
285 thenNF_Tc, thenLazilyNF_Tc :: NF_TcM a -> (a -> InTcM b) -> InTcM b
286 -- ...Lazily... is purely a performance thing (WDP 95/09)
289 In particular, @thenNF_Tc@ has all of these types:
291 thenNF_Tc :: NF_TcM a -> (a -> TcM b) -> TcM b
292 thenNF_Tc :: NF_TcM a -> (a -> NF_TcM b) -> NF_TcM b
296 thenNF_Tc expr cont sw_chkr dtys subst us errs src_loc
297 = case splitUniqSupply us of { (s1, s2) ->
298 case (expr sw_chkr dtys subst s1 errs src_loc) of
299 (result, subst2, errs2)
300 -> cont result sw_chkr dtys subst2 s2 errs2 src_loc
303 thenLazilyNF_Tc expr cont sw_chkr dtys subst us errs src_loc
305 (s1, s2) = splitUniqSupply us
307 case (expr sw_chkr dtys subst s1 errs src_loc) of {
308 (result, subst2, errs2)
309 -> cont result sw_chkr dtys subst2 s2 errs2 src_loc
312 returnNF_Tc :: a -> NF_TcM a
313 returnNF_Tc result sw_chkr dtys subst us errs src_loc
314 = (result, subst, errs)
316 listNF_Tc :: [NF_TcM a] -> NF_TcM [a]
317 listNF_Tc [] = returnNF_Tc []
319 = x `thenNF_Tc` \ r ->
320 listNF_Tc xs `thenNF_Tc` \ rs ->
323 mapNF_Tc :: (a -> NF_TcM b) -> [a] -> NF_TcM [b]
324 mapNF_Tc f [] = returnNF_Tc []
326 = f x `thenNF_Tc` \ r ->
327 mapNF_Tc f xs `thenNF_Tc` \ rs ->
330 fixNF_Tc :: (a -> NF_TcM a) -> NF_TcM a
331 fixNF_Tc m sw_chkr dtys subst us errs src_loc
334 lim = m result sw_chkr dtys subst us errs src_loc
338 @noFailTc@ takes a \tr{TcM a} and returns a \tr{NF_TcM a}. You use it
339 when you are darn sure that the TcM won't actually fail!
342 noFailTc :: TcM a -> NF_TcM a
344 noFailTc expr sw_chkr dtys subst us errs src_loc
345 = case (expr sw_chkr dtys subst us errs src_loc) of
346 TcFailed _ _ -> panic "Failure in noFailTc!"
347 TcSucceeded result subst errs
348 -> (result, subst, errs)
351 %************************************************************************
353 \subsection[TcM-uniq-extract]{Extractings Uniques from the monad}
355 %************************************************************************
357 These functions extract uniques from the monad. There are two unique
358 supplies embedded in the monad.
363 special unique supply for TyVars (these index the substitution)
367 getUniquesTc :: Int -> NF_TcM [Unique]
368 getUniquesTc n sw_chkr dtys subst us errs src_loc
369 = case (getSUniques n us) of { uniques ->
370 (uniques, subst, errs) }
372 -- This simpler version is often adequate:
374 getUniqueTc :: NF_TcM Unique
375 getUniqueTc sw_chkr dtys subst us errs src_loc
376 = case (getSUnique us) of { unique ->
377 (unique, subst, errs) }
379 rn4MtoTcM :: GlobalNameFuns -> Rn4M a -> NF_TcM (a, Bag Error)
381 rn4MtoTcM name_funs rn_action sw_chkr dtys subst us errs src_loc
384 = rn_action sw_chkr name_funs emptyFM emptyBag us mkUnknownSrcLoc
385 -- laziness may be good for you (see below)
387 ((rn_result, rn_errs), subst, errs)
389 -- Special uniques for TyVars extracted from the substitution
391 getTyVarUniquesTc :: Int -> NF_TcM [Unique]
392 getTyVarUniquesTc n sw_chkr dtys subst us errs src_loc
393 = returnNF_Tc uniques sw_chkr dtys subst2 us errs src_loc
395 (subst2, uniques) = getSubstTyVarUniques n subst
397 getTyVarUniqueTc :: NF_TcM Unique
398 getTyVarUniqueTc sw_chkr dtys subst us errs src_loc
399 = returnNF_Tc unique sw_chkr dtys subst2 us errs src_loc
401 (subst2, unique) = getSubstTyVarUnique subst
404 %************************************************************************
406 \subsection[TcM-extract]{Extractings other things from the monad}
408 %************************************************************************
410 These are functions which extract things from the monad.
412 Extending and applying the substitution.
414 ToDo: Unify.lhs BackSubst.lhs Id.lhs Inst.lhs: The TcMonad is used in
415 a number of places where only the sequenced substitution is required.
416 A lighter weight sequence substitution monad would be more appropriate
417 with TcMonad interface functions defined here.
420 getTcSubst :: NF_TcM Subst
421 applyTcSubstToTy :: TauType -> NF_TcM TauType
422 --UNUSED:applyTcSubstToThetaTy :: ThetaType -> NF_TcM ThetaType
423 applyTcSubstToTyVar :: TyVar -> NF_TcM TauType
424 applyTcSubstToId :: Id -> NF_TcM Id
425 applyTcSubstToInst :: Inst -> NF_TcM Inst
427 getTcSubst sw_chkr dtys subst us errs src_loc
428 = returnNF_Tc subst sw_chkr dtys subst us errs src_loc
430 applyTcSubstToTy ty sw_chkr dtys subst us errs src_loc
431 = case (applySubstToTy subst ty) of { (subst2, new_tau_ty) ->
432 returnNF_Tc new_tau_ty sw_chkr dtys subst2 us errs src_loc
436 applyTcSubstToThetaTy theta_ty sw_chkr dtys subst us errs src_loc
437 = case (applySubstToThetaTy subst theta_ty) of { (subst2, new_theta_ty) ->
438 returnNF_Tc new_theta_ty sw_chkr dtys subst2 us errs src_loc
442 applyTcSubstToTyVar tyvar sw_chkr dtys subst us errs src_loc
443 = case (applySubstToTyVar subst tyvar) of { (subst2, new_tau_ty) ->
444 returnNF_Tc new_tau_ty sw_chkr dtys subst2 us errs src_loc
447 applyTcSubstToId tyvar sw_chkr dtys subst us errs src_loc
448 = case (applySubstToId subst tyvar) of { (subst2, new_tau_ty) ->
449 returnNF_Tc new_tau_ty sw_chkr dtys subst2 us errs src_loc
452 applyTcSubstToInst inst sw_chkr dtys subst us errs src_loc
453 = case (applySubstToInst subst inst) of { (subst2, new_inst) ->
454 returnNF_Tc new_inst sw_chkr dtys subst2 us errs src_loc
457 applyTcSubstToTyVars :: [TyVar] -> NF_TcM [UniType]
458 applyTcSubstToTys :: [TauType] -> NF_TcM [TauType]
460 applyTcSubstToTyVars tyvars = mapNF_Tc applyTcSubstToTyVar tyvars
461 applyTcSubstToTys tys = mapNF_Tc applyTcSubstToTy tys
462 applyTcSubstToInsts insts = mapNF_Tc applyTcSubstToInst insts
466 extendSubstTc :: TyVar -> UniType -> UnifyErrContext -> TcM ()
468 extendSubstTc tyvar ty err_ctxt sw_chkr dtys subst us errs src_loc
469 = case (extendSubst tyvar ty subst) of { (new_subst, extend_result) ->
470 case extend_result of
472 TcSucceeded () new_subst errs
474 OccursCheck tyvar ty ->
476 (errs `snocBag` (unifyErr (TypeRec tyvar ty) err_ctxt src_loc))
479 -- This should only happen in the case of a call to
480 -- extendSubstTc from the unifier! The way things are now
481 -- we can't check for the AlreadyBound case in other calls
482 -- to extendSubstTc, but we're confident it never shows up.
484 unifyTauTy ty1 ty err_ctxt sw_chkr dtys new_subst us errs src_loc
489 @pruneSubstTc@ does nothing with an array substitution implementation!!!
491 pruneSubstTc :: [TyVar] -- Type vars whose substitutions should be kept
492 -> TcM a -- Type-check this
493 -> TcM a -- Return same result but pruned subst
495 pruneSubstTc keep_tyvars m sw_chkr dtys subst uniqs errs src_loc
496 = m sw_chkr dtys subst uniqs errs src_loc
500 getSwitchCheckerTc :: NF_TcM (GlobalSwitch -> Bool)
501 getSwitchCheckerTc sw_chkr = returnNF_Tc sw_chkr sw_chkr
505 getDefaultingTys :: NF_TcM [UniType]
506 getDefaultingTys sw_chkr dtys = returnNF_Tc dtys sw_chkr dtys
508 setDefaultingTys :: [UniType] -> TcM a -> TcM a
509 setDefaultingTys dtys action sw_chkr _ subst us errs src_loc
510 = action sw_chkr dtys subst us errs src_loc
514 addSrcLocTc :: SrcLoc -> TcM a -> TcM a
515 addSrcLocTc new_locn expr sw_chkr dtys subst us errs src_loc
516 = expr sw_chkr dtys subst us errs new_locn
518 getSrcLocTc :: NF_TcM SrcLoc
519 getSrcLocTc sw_chkr dtys subst us errs src_loc
520 = (src_loc, subst, errs)
523 %************************************************************************
525 \subsection[TcM-check]{Error-detecting functions}
527 %************************************************************************
529 The following TcM checks a Maybe type and fails with the given
533 checkMaybeTc :: Maybe val -> Error -> TcM val
534 checkMaybeTc (Just result) err = returnTc result
535 checkMaybeTc Nothing err = failTc err
537 checkMaybesTc :: [Maybe val] -> Error -> TcM [val]
538 checkMaybesTc [] err = returnTc []
539 checkMaybesTc (Nothing:xs) err = failTc err
540 checkMaybesTc ((Just v):xs) err
541 = checkMaybesTc xs err `thenTc` \ xs2 ->
544 checkMaybeErrTc :: MaybeErr val err -> (err -> Error) -> TcM val
545 checkMaybeErrTc (Succeeded result) errfun = returnTc result
546 checkMaybeErrTc (Failed err) errfun = failTc (errfun err)
549 checkMaybeErrsTc :: [MaybeErr val err] -> (err -> Error) -> TcM [val]
551 checkMaybeErrsTc [] err_fun = returnTc []
552 checkMaybeErrsTc ((Failed err) :xs) err_fun = failTc (err_fun err)
553 checkMaybeErrsTc ((Succeeded v):xs) err_fun
554 = checkMaybeErrsTc xs err_fun `thenTc` \ xs2 ->
559 %************************************************************************
561 \subsection[TcM-Insts]{Looking up instances}
563 %************************************************************************
566 lookupInst_Tc :: Inst -> TcM (TypecheckedExpr, [Inst])
568 lookupInst_Tc inst sw_chkr dtys subst uniqs errs src_loc
569 = case (lookupInst uniqs inst) of
570 Nothing -> TcFailed subst (errs `snocBag` (noInstanceErr inst))
572 Just (expr, insts) -> TcSucceeded (expr, insts) subst errs
574 lookupNoBindInst_Tc :: Inst -> TcM [Inst]
576 lookupNoBindInst_Tc inst sw_chkr dtys subst uniqs errs src_loc
577 = case (lookupNoBindInst uniqs inst) of
578 Nothing -> TcFailed subst (errs `snocBag` (noInstanceErr inst))
580 Just insts -> TcSucceeded insts subst errs
589 %************************************************************************
591 \subsection[Baby_TcM]{``Baby'' @TcM@ monadery---when we don't need the full bang}
593 %************************************************************************
595 The "baby" Tc monad doesn't pass around the substitution.
596 That means you can't use it to type-check bindings, but you can use
597 if for everything else (interfaces, type decls, first pass of class and
600 Less importantly, it doesn't pass around the list of default decls either.
608 = (GlobalSwitch -> Bool)
610 -> Bag Error -- threaded
611 -> SrcLoc -- only passed downwards
612 -> Baby_TcResult result
614 data Baby_TcResult result
615 = BabyTcFailed (Bag Error)
617 | BabyTcSucceeded result (Bag Error)
625 thenB_Tc :: Baby_TcM a -> (a -> Baby_TcM b) -> Baby_TcM b
626 returnB_Tc :: a -> Baby_TcM a
628 #ifdef __GLASGOW_HASKELL__
629 {-# INLINE thenB_Tc #-}
630 {-# INLINE returnB_Tc #-}
633 thenB_Tc a b sw us errs loc
634 = case (splitUniqSupply us) of { (s1, s2) ->
635 case (a sw s1 errs loc) of
636 BabyTcFailed errs2 -> BabyTcFailed errs2
637 BabyTcSucceeded a_res errs2 -> b a_res sw s2 errs2 loc
640 returnB_Tc result sw us errs loc = BabyTcSucceeded result errs
641 failB_Tc err sw us errs loc = BabyTcFailed (errs `snocBag` err)
643 recoverIgnoreErrorsB_Tc return_on_failure try_this sw us errs loc
644 = BabyTcSucceeded result errs
646 result = case try_this sw us emptyBag loc of
647 BabyTcSucceeded result errs_from_branch -> result
648 BabyTcFailed errs_from_branch -> return_on_failure
650 fixB_Tc :: (a -> Baby_TcM a) -> Baby_TcM a
651 fixB_Tc k sw us errs loc
654 result = k val sw us errs loc
656 BabyTcSucceeded val errs -> val
657 BabyTcFailed errs -> panic "fixB_Tc failed"
659 babyTcMtoTcM :: Baby_TcM a -> TcM a
660 babyTcMtoTcM m sw_chkr dtys subst us errs src_loc
661 = case m sw_chkr us errs src_loc of
662 BabyTcSucceeded result errs2 -> TcSucceeded result subst errs2
663 BabyTcFailed errs2 -> TcFailed subst errs2
665 babyTcMtoNF_TcM :: Baby_TcM a -> NF_TcM a
666 babyTcMtoNF_TcM m sw_chkr dtys subst us errs src_loc
667 = case m sw_chkr us errs src_loc of
668 BabyTcSucceeded result errs2 -> (result, subst, errs2)
669 BabyTcFailed errs2 -> panic "babyTcMtoNF_TcM"
673 uniqSMtoBabyTcM :: SUniqSM a -> Baby_TcM a
675 uniqSMtoBabyTcM u_action sw us errs loc
677 u_result = u_action us
678 -- at least one use *needs* this laziness
680 BabyTcSucceeded u_result errs
684 thenB_Tc_ m k = m `thenB_Tc` \ _ ->
687 mapB_Tc :: (a -> Baby_TcM b) -> [a] -> Baby_TcM [b]
688 mapB_Tc f [] = returnB_Tc []
689 mapB_Tc f (x:xs) = f x `thenB_Tc` \ fx ->
690 mapB_Tc f xs `thenB_Tc` \ fxs ->
699 getUniqueB_Tc :: Baby_TcM Unique
700 getUniquesB_Tc :: Int -> Baby_TcM [Unique]
702 getUniqueB_Tc sw us errs loc
703 = case (getSUnique us) of { unique ->
704 BabyTcSucceeded unique errs }
706 getUniquesB_Tc n sw us errs loc
707 = case (getSUniques n us) of { uniques ->
708 BabyTcSucceeded uniques errs }
710 addSrcLocB_Tc :: SrcLoc -> Baby_TcM a -> Baby_TcM a
711 addSrcLocB_Tc new_locn m sw us errs loc
712 = m sw us errs new_locn
714 getSrcLocB_Tc sw us errs loc = BabyTcSucceeded loc errs
716 getSwitchCheckerB_Tc :: Baby_TcM (GlobalSwitch -> Bool)
717 getSwitchCheckerB_Tc sw_chkr us errs loc = BabyTcSucceeded sw_chkr errs
725 checkB_Tc :: Bool -> Error -> Baby_TcM ()
727 checkB_Tc True err = failB_Tc err
728 checkB_Tc False err = returnB_Tc ()