xoptM::ExtensionFlag->TcRnIfgbllclBoolxoptMflag=do{dflags<-getDynFlags;return(xoptflagdflags)}doptM::DynFlag->TcRnIfgbllclBooldoptMflag=do{dflags<-getDynFlags;return(doptflagdflags)}woptM::WarningFlag->TcRnIfgbllclBoolwoptMflag=do{dflags<-getDynFlags;return(woptflagdflags)}setXOptM::ExtensionFlag->TcRnIfgbllcla->TcRnIfgbllclasetXOptMflag=updEnv(\env@(Env{env_top=top})->env{env_top=top{hsc_dflags=xopt_set(hsc_dflagstop)flag}})unsetDOptM::DynFlag->TcRnIfgbllcla->TcRnIfgbllclaunsetDOptMflag=updEnv(\env@(Env{env_top=top})->env{env_top=top{hsc_dflags=dopt_unset(hsc_dflagstop)flag}})unsetWOptM::WarningFlag->TcRnIfgbllcla->TcRnIfgbllclaunsetWOptMflag=updEnv(\env@(Env{env_top=top})->env{env_top=top{hsc_dflags=wopt_unset(hsc_dflagstop)flag}})-- | Do it flag is trueifDOptM::DynFlag->TcRnIfgbllcl()->TcRnIfgbllcl()ifDOptMflagthing_inside=do{b<-doptMflag;ifbthenthing_insideelsereturn()}ifWOptM::WarningFlag->TcRnIfgbllcl()->TcRnIfgbllcl()ifWOptMflagthing_inside=do{b<-woptMflag;ifbthenthing_insideelsereturn()}ifXOptM::ExtensionFlag->TcRnIfgbllcl()->TcRnIfgbllcl()ifXOptMflagthing_inside=do{b<-xoptMflag;ifbthenthing_insideelsereturn()}getGhcMode::TcRnIfgbllclGhcModegetGhcMode=do{env<-getTopEnv;return(ghcMode(hsc_dflagsenv))}

\end{code}
\begin{code}

getEpsVar::TcRnIfgbllcl(TcRefExternalPackageState)getEpsVar=do{env<-getTopEnv;return(hsc_EPSenv)}getEps::TcRnIfgbllclExternalPackageStategetEps=do{env<-getTopEnv;readMutVar(hsc_EPSenv)}-- | Update the external package state. Returns the second result of the-- modifier function.---- This is an atomic operation and forces evaluation of the modified EPS in-- order to avoid space leaks.updateEps::(ExternalPackageState->(ExternalPackageState,a))->TcRnIfgbllclaupdateEpsupd_fn=dotraceIf(text"updating EPS")eps_var<-getEpsVaratomicUpdMutVar'eps_varupd_fn-- | Update the external package state.---- This is an atomic operation and forces evaluation of the modified EPS in-- order to avoid space leaks.updateEps_::(ExternalPackageState->ExternalPackageState)->TcRnIfgbllcl()updateEps_upd_fn=dotraceIf(text"updating EPS_")eps_var<-getEpsVaratomicUpdMutVar'eps_var(\eps->(upd_fneps,()))getHpt::TcRnIfgbllclHomePackageTablegetHpt=do{env<-getTopEnv;return(hsc_HPTenv)}getEpsAndHpt::TcRnIfgbllcl(ExternalPackageState,HomePackageTable)getEpsAndHpt=do{env<-getTopEnv;eps<-readMutVar(hsc_EPSenv);return(eps,hsc_HPTenv)}

newMetaUnique::TcMUnique-- The uniques for TcMetaTyVars are allocated specially-- in guaranteed linear order, starting at zero for each modulenewMetaUnique=do{env<-getLclEnv;letmeta_var=tcl_metaenv;uniq<-readMutVarmeta_var;writeMutVarmeta_var(incrUniqueuniq);returnuniq}newUnique::TcRnIfgbllclUniquenewUnique=do{env<-getEnv;let{u_var=env_usenv};us<-readMutVaru_var;casetakeUniqFromSupplyusof{(uniq,us')->do{writeMutVaru_varus';return$!uniq}}}-- NOTE 1: we strictly split the supply, to avoid the possibility of leaving-- a chain of unevaluated supplies behind.-- NOTE 2: we use the uniq in the supply from the MutVar directly, and-- throw away one half of the new split supply. This is safe because this-- is the only place we use that unique. Using the other half of the split-- supply is safer, but slower.newUniqueSupply::TcRnIfgbllclUniqSupplynewUniqueSupply=do{env<-getEnv;let{u_var=env_usenv};us<-readMutVaru_var;casesplitUniqSupplyusof{(us1,us2)->do{writeMutVaru_varus1;returnus2}}}newLocalName::Name->TcRnIfgbllclNamenewLocalNamename-- Make a clone=do{uniq<-newUnique;return(mkInternalNameuniq(nameOccNamename)(getSrcSpanname))}newSysLocalIds::FastString->[TcType]->TcRnIfgbllcl[TcId]newSysLocalIdsfstys=do{us<-newUniqueSupply;return(zipWith(mkSysLocalfs)(uniqsFromSupplyus)tys)}newName::OccName->TcMNamenewNameocc=do{uniq<-newUnique;loc<-getSrcSpanM;return(mkInternalNameuniqoccloc)}instanceMonadUnique(IOEnv(Envgbllcl))wheregetUniqueM=newUniquegetUniqueSupplyM=newUniqueSupply

traceTc::String->SDoc->TcRn()traceTc=traceTcN1traceTcN::Int->String->SDoc->TcRn()traceTcNlevelheralddoc=dodflags<-getDynFlagswhen(level<=traceLeveldflags)$traceOptTcRnOpt_D_dump_tc_trace$hang(textherald)2doctraceRn,traceSplice::SDoc->TcRn()traceRn=traceOptTcRnOpt_D_dump_rn_tracetraceSplice=traceOptTcRnOpt_D_dump_splicestraceIf,traceHiDiffs::SDoc->TcRnIfmn()traceIf=traceOptIfOpt_D_dump_if_tracetraceHiDiffs=traceOptIfOpt_D_dump_hi_diffstraceOptIf::DynFlag->SDoc->TcRnIfmn()-- No RdrEnv available, so qualify everythingtraceOptIfflagdoc=ifDOptMflag$dodflags<-getDynFlagsliftIO(printInfoForUserdflagsalwaysQualifydoc)traceOptTcRn::DynFlag->SDoc->TcRn()-- Output the message, with current location if opt_PprStyle_DebugtraceOptTcRnflagdoc=ifDOptMflag$do{loc<-getSrcSpanM;letreal_doc|opt_PprStyle_Debug=mkLocMessageSevInfolocdoc|otherwise=doc-- The full location is-- usually way too much;dumpTcRnreal_doc}dumpTcRn::SDoc->TcRn()dumpTcRndoc=do{rdr_env<-getGlobalRdrEnv;dflags<-getDynFlags;liftIO(printInfoForUserdflags(mkPrintUnqualifieddflagsrdr_env)doc)}debugDumpTcRn::SDoc->TcRn()debugDumpTcRndoc|opt_NoDebugOutput=return()|otherwise=dumpTcRndocdumpOptTcRn::DynFlag->SDoc->TcRn()dumpOptTcRnflagdoc=ifDOptMflag(dumpTcRndoc)

getErrsVar::TcRn(TcRefMessages)getErrsVar=do{env<-getLclEnv;return(tcl_errsenv)}setErrsVar::TcRefMessages->TcRna->TcRnasetErrsVarv=updLclEnv(\env->env{tcl_errs=v})addErr::MsgDoc->TcRn()-- Ignores the context stackaddErrmsg=do{loc<-getSrcSpanM;addErrAtlocmsg}failWith::MsgDoc->TcRnafailWithmsg=addErrmsg>>failMaddErrAt::SrcSpan->MsgDoc->TcRn()-- addErrAt is mainly (exclusively?) used by the renamer, where-- tidying is not an issue, but it's all lazy so the extra-- work doesn't matteraddErrAtlocmsg=do{ctxt<-getErrCtxt;tidy_env<-tcInitTidyEnv;err_info<-mkErrInfotidy_envctxt;addLongErrAtlocmsgerr_info}addErrs::[(SrcSpan,MsgDoc)]->TcRn()addErrsmsgs=mapM_addmsgswhereadd(loc,msg)=addErrAtlocmsgcheckErr::Bool->MsgDoc->TcRn()-- Add the error if the bool is FalsecheckErrokmsg=unlessok(addErrmsg)warnIf::Bool->MsgDoc->TcRn()warnIfTruemsg=addWarnmsgwarnIfFalse_=return()addMessages::Messages->TcRn()addMessages(m_warns,m_errs)=do{errs_var<-getErrsVar;(warns,errs)<-readTcReferrs_var;writeTcReferrs_var(warns`unionBags`m_warns,errs`unionBags`m_errs)}discardWarnings::TcRna->TcRna-- Ignore warnings inside the thing inside;-- used to ignore-unused-variable warnings inside derived codediscardWarningsthing_inside=do{errs_var<-getErrsVar;(old_warns,_)<-readTcReferrs_var;;result<-thing_inside-- Revert warnings to old_warns;(_new_warns,new_errs)<-readTcReferrs_var;writeTcReferrs_var(old_warns,new_errs);returnresult}

try_m::TcRnr->TcRn(EitherIOEnvFailurer)-- Does try_m, with a debug-trace on failuretry_mthing=do{mb_r<-tryMthing;casemb_rofLeftexn->do{traceTc"tryTc/recoverM recovering from"$text(showExceptionexn);returnmb_r}Right_->returnmb_r}-----------------------recoverM::TcRnr-- Recovery action; do this if the main one fails->TcRnr-- Main action: do this first->TcRnr-- Errors in 'thing' are retainedrecoverMrecoverthing=do{mb_res<-try_mthing;casemb_resofLeft_->recoverRightres->returnres}-----------------------mapAndRecoverM::(a->TcRnb)->[a]->TcRn[b]-- Drop elements of the input that fail, so the result-- list can be shorter than the argument listmapAndRecoverM_[]=return[]mapAndRecoverMf(x:xs)=do{mb_r<-try_m(fx);rs<-mapAndRecoverMfxs;return(casemb_rofLeft_->rsRightr->r:rs)}-----------------------tryTc::TcRna->TcRn(Messages,Maybea)-- (tryTc m) executes m, and returns-- Just r, if m succeeds (returning r)-- Nothing, if m fails-- It also returns all the errors and warnings accumulated by m-- It always succeeds (never raises an exception)tryTcm=do{errs_var<-newTcRefemptyMessages;res<-try_m(setErrsVarerrs_varm);msgs<-readTcReferrs_var;return(msgs,caseresofLeft_->NothingRightval->Justval)-- The exception is always the IOEnv built-in-- in exception; see IOEnv.failM}-----------------------tryTcErrs::TcRna->TcRn(Messages,Maybea)-- Run the thing, returning-- Just r, if m succceeds with no error messages-- Nothing, if m fails, or if it succeeds but has error messages-- Either way, the messages are returned; even in the Just case-- there might be warningstryTcErrsthing=do{(msgs,res)<-tryTcthing;dflags<-getDynFlags;leterrs_found=errorsFounddflagsmsgs;return(msgs,caseresofNothing->NothingJustval|errs_found->Nothing|otherwise->Justval)}-----------------------tryTcLIE::TcMa->TcM(Messages,Maybea)-- Just like tryTcErrs, except that it ensures that the LIE-- for the thing is propagated only if there are no errors-- Hence it's restricted to the type-check monadtryTcLIEthing_inside=do{((msgs,mb_res),lie)<-captureConstraints(tryTcErrsthing_inside);;casemb_resofNothing->return(msgs,Nothing)Justval->do{emitConstraintslie;return(msgs,Justval)}}-----------------------tryTcLIE_::TcMr->TcMr->TcMr-- (tryTcLIE_ r m) tries m;-- if m succeeds with no error messages, it's the answer-- otherwise tryTcLIE_ drops everything from m and tries r instead.tryTcLIE_recovermain=do{(msgs,mb_res)<-tryTcLIEmain;casemb_resofJustval->do{addMessagesmsgs-- There might be warnings;returnval}Nothing->recover-- Discard all msgs}-----------------------checkNoErrs::TcMr->TcMr-- (checkNoErrs m) succeeds iff m succeeds and generates no errors-- If m fails then (checkNoErrsTc m) fails.-- If m succeeds, it checks whether m generated any errors messages-- (it might have recovered internally)-- If so, it fails too.-- Regardless, any errors generated by m are propagated to the enclosing context.checkNoErrsmain=do{(msgs,mb_res)<-tryTcLIEmain;addMessagesmsgs;casemb_resofNothing->failMJustval->returnval}ifErrsM::TcRnr->TcRnr->TcRnr-- ifErrsM bale_out normal-- does 'bale_out' if there are errors in errors collection-- otherwise does 'normal'ifErrsMbale_outnormal=do{errs_var<-getErrsVar;msgs<-readTcReferrs_var;dflags<-getDynFlags;iferrorsFounddflagsmsgsthenbale_outelsenormal}failIfErrsM::TcRn()-- Useful to avoid error cascadesfailIfErrsM=ifErrsMfailM(return())

getErrCtxt::TcM[ErrCtxt]getErrCtxt=do{env<-getLclEnv;return(tcl_ctxtenv)}setErrCtxt::[ErrCtxt]->TcMa->TcMasetErrCtxtctxt=updLclEnv(\env->env{tcl_ctxt=ctxt})addErrCtxt::MsgDoc->TcMa->TcMaaddErrCtxtmsg=addErrCtxtM(\env->return(env,msg))addErrCtxtM::(TidyEnv->TcM(TidyEnv,MsgDoc))->TcMa->TcMaaddErrCtxtMctxt=updCtxt(\ctxts->(False,ctxt):ctxts)addLandmarkErrCtxt::MsgDoc->TcMa->TcMaaddLandmarkErrCtxtmsg=updCtxt(\ctxts->(True,\env->return(env,msg)):ctxts)-- Helper function for the aboveupdCtxt::([ErrCtxt]->[ErrCtxt])->TcMa->TcMaupdCtxtupd=updLclEnv(\env@(TcLclEnv{tcl_ctxt=ctxt})->env{tcl_ctxt=updctxt})popErrCtxt::TcMa->TcMapopErrCtxt=updCtxt(\msgs->casemsgsof{[]->[];(_:ms)->ms})getCtLoc::orig->TcM(CtLocorig)getCtLocorigin=do{loc<-getSrcSpanM;env<-getLclEnv;return(CtLocoriginloc(tcl_ctxtenv))}setCtLoc::CtLocorig->TcMa->TcMasetCtLoc(CtLoc_src_locctxt)thing_inside=setSrcSpansrc_loc(setErrCtxtctxtthing_inside)

\end{code}
%************************************************************************
%* *
Error message generation (type checker)
%* *
%************************************************************************
The addErrTc functions add an error message, but do not cause failure.
The 'M' variants pass a TidyEnv that has already been used to
tidy up the message; we then use it to tidy the context messages
\begin{code}

failWithTc::MsgDoc->TcMa-- Add an error message and failfailWithTcerr_msg=addErrTcerr_msg>>failMfailWithTcM::(TidyEnv,MsgDoc)->TcMa-- Add an error message and failfailWithTcMlocal_and_msg=addErrTcMlocal_and_msg>>failMcheckTc::Bool->MsgDoc->TcM()-- Check that the boolean is truecheckTcTrue_=return()checkTcFalseerr=failWithTcerr

newTcEvBinds::TcMEvBindsVarnewTcEvBinds=do{ref<-newTcRefemptyEvBindMap;uniq<-newUnique;return(EvBindsVarrefuniq)}addTcEvBind::EvBindsVar->EvVar->EvTerm->TcM()-- Add a binding to the TcEvBinds by side effectaddTcEvBind(EvBindsVarev_ref_)vart=do{bnds<-readTcRefev_ref;writeTcRefev_ref(extendEvBindsbndsvart)}getTcEvBinds::EvBindsVar->TcM(BagEvBind)getTcEvBinds(EvBindsVarev_ref_)=do{bnds<-readTcRefev_ref;return(evBindMapBindsbnds)}chooseUniqueOccTc::(OccSet->OccName)->TcMOccNamechooseUniqueOccTcfn=do{env<-getGblEnv;letdfun_n_var=tcg_dfun_nenv;set<-readTcRefdfun_n_var;letocc=fnset;writeTcRefdfun_n_var(extendOccSetsetocc);returnocc}getConstraintVar::TcM(TcRefWantedConstraints)getConstraintVar=do{env<-getLclEnv;return(tcl_lieenv)}setConstraintVar::TcRefWantedConstraints->TcMa->TcMasetConstraintVarlie_var=updLclEnv(\env->env{tcl_lie=lie_var})emitConstraints::WantedConstraints->TcM()emitConstraintsct=do{lie_var<-getConstraintVar;updTcReflie_var(`andWC`ct)}emitFlat::Ct->TcM()emitFlatct=do{lie_var<-getConstraintVar;updTcReflie_var(`addFlats`unitBagct)}emitFlats::Cts->TcM()emitFlatscts=do{lie_var<-getConstraintVar;updTcReflie_var(`addFlats`cts)}emitImplication::Implication->TcM()emitImplicationct=do{lie_var<-getConstraintVar;updTcReflie_var(`addImplics`unitBagct)}emitImplications::BagImplication->TcM()emitImplicationsct=do{lie_var<-getConstraintVar;updTcReflie_var(`addImplics`ct)}captureConstraints::TcMa->TcM(a,WantedConstraints)-- (captureConstraints m) runs m, and returns the type constraints it generatescaptureConstraintsthing_inside=do{lie_var<-newTcRefemptyWC;res<-updLclEnv(\env->env{tcl_lie=lie_var})thing_inside;lie<-readTcReflie_var;return(res,lie)}captureUntouchables::TcMa->TcM(a,Untouchables)captureUntouchablesthing_inside=do{env<-getLclEnv;low_meta<-readTcRef(tcl_metaenv);res<-setLclEnv(env{tcl_untch=low_meta})thing_inside;high_meta<-readTcRef(tcl_metaenv);return(res,TouchableRangelow_metahigh_meta)}isUntouchable::TcTyVar->TcMBoolisUntouchabletv-- Kind variables are always touchable|isSuperKind(tyVarKindtv)=returnFalse|otherwise=do{env<-getLclEnv;return(varUniquetv<tcl_untchenv)}getLclTypeEnv::TcMTcTypeEnvgetLclTypeEnv=do{env<-getLclEnv;return(tcl_envenv)}setLclTypeEnv::TcLclEnv->TcMa->TcMa-- Set the local type envt, but do *not* disturb other fields,-- notably the lie_varsetLclTypeEnvlcl_envthing_inside=updLclEnvupdthing_insidewhereupdenv=env{tcl_env=tcl_envlcl_env,tcl_tyvars=tcl_tyvarslcl_env}traceTcConstraints::String->TcM()traceTcConstraintsmsg=do{lie_var<-getConstraintVar;lie<-readTcReflie_var;traceTc(msg++"LIE:")(pprlie)}

recordThUse::TcM()recordThUse=do{env<-getGblEnv;writeTcRef(tcg_th_usedenv)True}recordThSpliceUse::TcM()recordThSpliceUse=do{env<-getGblEnv;writeTcRef(tcg_th_splice_usedenv)True}keepAliveTc::Id->TcM()-- Record the name in the keep-alive setkeepAliveTcid|isLocalIdid=do{env<-getGblEnv;;updTcRef(tcg_keepenv)(`addOneToNameSet`idNameid)}|otherwise=return()keepAliveSetTc::NameSet->TcM()-- Record the name in the keep-alive setkeepAliveSetTcns=do{env<-getGblEnv;;updTcRef(tcg_keepenv)(`unionNameSets`ns)}getStage::TcMThStagegetStage=do{env<-getLclEnv;return(tcl_th_ctxtenv)}setStage::ThStage->TcMa->TcMasetStages=updLclEnv(\env->env{tcl_th_ctxt=s})

mkIfLclEnv::Module->SDoc->IfLclEnvmkIfLclEnvmodloc=IfLclEnv{if_mod=mod,if_loc=loc,if_tv_env=emptyUFM,if_id_env=emptyUFM}initIfaceTcRn::IfGa->TcRnainitIfaceTcRnthing_inside=do{tcg_env<-getGblEnv;let{if_env=IfGblEnv{if_rec_types=Just(tcg_modtcg_env,get_type_env)};get_type_env=readTcRef(tcg_type_env_vartcg_env)};setEnvs(if_env,())thing_inside}initIfaceExtCore::IfLa->TcRnainitIfaceExtCorething_inside=do{tcg_env<-getGblEnv;let{mod=tcg_modtcg_env;doc=ptext(sLit"External Core file for")<+>quotes(pprmod);if_env=IfGblEnv{if_rec_types=Just(mod,return(tcg_type_envtcg_env))};if_lenv=mkIfLclEnvmoddoc};setEnvs(if_env,if_lenv)thing_inside}initIfaceCheck::HscEnv->IfGa->IOa-- Used when checking the up-to-date-ness of the old Iface-- Initialise the environment with no useful info at allinitIfaceCheckhsc_envdo_this=doletrec_types=casehsc_type_env_varhsc_envofJust(mod,var)->Just(mod,readTcRefvar)Nothing->Nothinggbl_env=IfGblEnv{if_rec_types=rec_types}initTcRnIf'i'hsc_envgbl_env()do_thisinitIfaceTc::ModIface->(TcRefTypeEnv->IfLa)->TcRnIfgbllcla-- Used when type-checking checking an up-to-date interface file-- No type envt from the current module, but we do know the module dependenciesinitIfaceTcifacedo_this=do{tc_env_var<-newTcRefemptyTypeEnv;let{gbl_env=IfGblEnv{if_rec_types=Just(mod,readTcReftc_env_var)};;if_lenv=mkIfLclEnvmoddoc};setEnvs(gbl_env,if_lenv)(do_thistc_env_var)}wheremod=mi_moduleifacedoc=ptext(sLit"The interface for")<+>quotes(pprmod)initIfaceLcl::Module->SDoc->IfLa->IfMlclainitIfaceLclmodloc_docthing_inside=setLclEnv(mkIfLclEnvmodloc_doc)thing_insidegetIfModule::IfLModulegetIfModule=do{env<-getLclEnv;return(if_modenv)}--------------------failIfM::MsgDoc->IfLa-- The Iface monad doesn't have a place to accumulate errors, so we-- just fall over fast if one happens; it "shouldnt happen".-- We use IfL here so that we can get context info out of the local envfailIfMmsg=do{env<-getLclEnv;letfull_msg=(if_locenv<>colon)$$nest2msg;dflags<-getDynFlags;liftIO(log_actiondflagsdflagsSevFatalnoSrcSpan(defaultErrStyledflags)full_msg);failM}--------------------forkM_maybe::SDoc->IfLa->IfL(Maybea)-- Run thing_inside in an interleaved thread.-- It shares everything with the parent thread, so this is DANGEROUS.---- It returns Nothing if the computation fails---- It's used for lazily type-checking interface-- signatures, which is pretty benignforkM_maybedocthing_inside=do{unsafeInterleaveM$do{traceIf(text"Starting fork {"<+>doc);mb_res<-tryM$updLclEnv(\env->env{if_loc=if_locenv$$doc})$thing_inside;casemb_resofRightr->do{traceIf(text"} ending fork"<+>doc);return(Justr)}Leftexn->do{-- Bleat about errors in the forked thread, if -ddump-if-trace is on-- Otherwise we silently discard errors. Errors can legitimately-- happen when compiling interface signatures (see tcInterfaceSigs)ifDOptMOpt_D_dump_if_trace$dodflags<-getDynFlagsletmsg=hang(text"forkM failed:"<+>doc)2(text(showexn))liftIO$log_actiondflagsdflagsSevFatalnoSrcSpan(defaultErrStyledflags)msg;traceIf(text"} ending fork (badly)"<+>doc);returnNothing}}}forkM::SDoc->IfLa->IfLaforkMdocthing_inside=do{mb_res<-forkM_maybedocthing_inside;return(casemb_resofNothing->pgmError"Cannot continue after interface file error"-- pprPanic "forkM" docJustr->r)}