%%(c)TheUniversityofGlasgow2006%(c)TheGRASP/AQUAProject,GlasgowUniversity,1992-1998%\section[TcBinds]{TcBinds}\begin{code}moduleTcBinds(tcLocalBinds,tcTopBinds,tcHsBootSigs,tcMonoBinds,tcPolyBinds,TcPragFun,tcPrags,mkPragFun,TcSigInfo(..),TcSigFun,mkTcSigFun,badBootDeclErr)whereimport{-# SOURCE #-}TcMatches(tcGRHSsPat,tcMatchesFun)import{-# SOURCE #-}TcExpr(tcMonoExpr)importDynFlagsimportHsSynimportTcRnMonadimportInstimportTcEnvimportTcUnifyimportTcSimplifyimportTcHsTypeimportTcPatimportTcMTypeimportTcTypeimportCoercionimportVarEnvimportTysPrimimportIdimportVarimportNameimportNameSetimportNameEnvimportVarSetimportSrcLocimportBagimportErrUtilsimportDigraphimportMaybesimportUtilimportBasicTypesimportOutputableimportFastStringimportControl.Monad\end{code}%************************************************************************%**\subsection{Type-checkingbindings}%**%************************************************************************@tcBindsAndThen@typechecksa@HsBinds@.The"and then"partisbecauseitneedstoknowsomethingaboutthe{\emusage}ofthethingsbound,sothatitcancreatespecialisationsofthem.So@tcBindsAndThen@takesafunctionwhich,givenanextendedenvironment,E,typechecksthescopeofthebindingsreturningatypecheckedthingand(mostimportant)anLIE.ItisthisLIEwhichisthenusedasthebasisforspecialisingthethingsbound.@tcBindsAndThen@alsotakesa"combiner"whichgluestogetherthebindingsandthe"thing"tomakeanew"thing".Therealworkisdoneby@tcBindWithSigsAndThen@.Recursiveandnon-recursivebindsarehandledinessentiallythesameway:becauseofuniquestherearenoscopingissuesleft.Theonlydifferenceisthatnon-recursivebindingscanbindprimitivevalues.Evenfornon-recursivebindinggroupsweaddtypingsforeachbindertotheLVEforthefollowingreason.WheneachindividualbindingischeckedthetypeofitsLHSisunifiedwiththatofitsRHS;andtype-checkingtheLHSofcourserequiresthatthebinderisinscope.Atthetop-leveltheLIEissuretocontainnothingbutconstantdictionaries,whichweresolveatthemodulelevel.\begin{code}tcTopBinds::HsValBindsName->TcM(LHsBindsTcId,TcLclEnv)-- Note: returning the TcLclEnv is more than we really-- want. The bit we care about is the local bindings-- and the free type variables thereoftcTopBindsbinds=do{(ValBindsOutprs_,env)<-tcValBindsTopLevelbindsgetLclEnv;return(foldr(unionBags.snd)emptyBagprs,env)}-- The top level bindings are flattened into a giant -- implicitly-mutually-recursive LHsBindstcHsBootSigs::HsValBindsName->TcM[Id]-- A hs-boot file has only one BindGroup, and it only has type-- signatures in it. The renamer checked all thistcHsBootSigs(ValBindsOutbindssigs)=do{checkTc(nullbinds)badBootDeclErr;mapM(addLocMtc_boot_sig)(filterisTypeLSigsigs)}wheretc_boot_sig(TypeSig(L_name)ty)=do{sigma_ty<-tcHsSigType(FunSigCtxtname)ty;return(mkVanillaGlobalnamesigma_ty)}-- Notice that we make GlobalIds, not LocalIdstc_boot_sigs=pprPanic"tcHsBootSigs/tc_boot_sig"(pprs)tcHsBootSigsgroups=pprPanic"tcHsBootSigs"(pprgroups)badBootDeclErr::MessagebadBootDeclErr=ptext(sLit"Illegal declarations in an hs-boot file")------------------------tcLocalBinds::HsLocalBindsName->TcMthing->TcM(HsLocalBindsTcId,thing)tcLocalBindsEmptyLocalBindsthing_inside=do{thing<-thing_inside;return(EmptyLocalBinds,thing)}tcLocalBinds(HsValBindsbinds)thing_inside=do{(binds',thing)<-tcValBindsNotTopLevelbindsthing_inside;return(HsValBindsbinds',thing)}tcLocalBinds(HsIPBinds(IPBindsip_binds_))thing_inside=do{(thing,lie)<-getLIEthing_inside;(avail_ips,ip_binds')<-mapAndUnzipM(wrapLocSndMtc_ip_bind)ip_binds-- If the binding binds ?x = E, we must now -- discharge any ?x constraints in expr_lie;dict_binds<-tcSimplifyIPsavail_ipslie;return(HsIPBinds(IPBindsip_binds'dict_binds),thing)}where-- I wonder if we should do these one at at time-- Consider ?x = 4-- ?y = ?x + 1tc_ip_bind(IPBindipexpr)=doty<-newFlexiTyVarTyargTypeKind(ip',ip_inst)<-newIPDict(IPBindOriginip)iptyexpr'<-tcMonoExprexprtyreturn(ip_inst,(IPBindip'expr'))------------------------tcValBinds::TopLevelFlag->HsValBindsName->TcMthing->TcM(HsValBindsTcId,thing)tcValBinds_(ValBindsInbinds_)_=pprPanic"tcValBinds"(pprbinds)tcValBindstop_lvl(ValBindsOutbindssigs)thing_inside=do{-- Typecheck the signature;let{prag_fn=mkPragFunsigs;ty_sigs=filterisTypeLSigsigs;sig_fn=mkTcSigFunty_sigs};poly_ids<-checkNoErrs(mapAndRecoverMtcTySigty_sigs)-- No recovery from bad signatures, because the type sigs-- may bind type variables, so proceeding without them-- can lead to a cascade of errors-- ToDo: this means we fall over immediately if any type sig-- is wrong, which is over-conservative, see Trac bug #745-- Extend the envt right away with all -- the Ids declared with type signatures;poly_rec<-doptMOpt_RelaxedPolyRec;(binds',thing)<-tcExtendIdEnvpoly_ids$tcBindGroupspoly_rectop_lvlsig_fnprag_fnbindsthing_inside;return(ValBindsOutbinds'sigs,thing)}------------------------tcBindGroups::Bool->TopLevelFlag->TcSigFun->TcPragFun->[(RecFlag,LHsBindsName)]->TcMthing->TcM([(RecFlag,LHsBindsTcId)],thing)-- Typecheck a whole lot of value bindings,-- one strongly-connected component at a time-- Here a "strongly connected component" has the strightforward-- meaning of a group of bindings that mention each other, -- ignoring type signatures (that part comes later)tcBindGroups____[]thing_inside=do{thing<-thing_inside;return([],thing)}tcBindGroupspoly_rectop_lvlsig_fnprag_fn(group:groups)thing_inside=do{(group',(groups',thing))<-tc_grouppoly_rectop_lvlsig_fnprag_fngroup$tcBindGroupspoly_rectop_lvlsig_fnprag_fngroupsthing_inside;return(group'++groups',thing)}------------------------tc_group::Bool->TopLevelFlag->TcSigFun->TcPragFun->(RecFlag,LHsBindsName)->TcMthing->TcM([(RecFlag,LHsBindsTcId)],thing)-- Typecheck one strongly-connected component of the original program.-- We get a list of groups back, because there may -- be specialisations etc as welltc_group_top_lvlsig_fnprag_fn(NonRecursive,binds)thing_inside-- A single non-recursive binding-- We want to keep non-recursive things non-recursive-- so that we desugar unlifted bindings correctly=do{(binds1,lie_binds,thing)<-tc_haskell98top_lvlsig_fnprag_fnNonRecursivebindsthing_inside;return([(NonRecursive,unitBagb)|b<-bagToListbinds1]++[(Recursive,lie_binds)]-- TcDictBinds have scrambled dependency order,thing)}tc_grouppoly_rectop_lvlsig_fnprag_fn(Recursive,binds)thing_inside|notpoly_rec-- Recursive group, normal Haskell 98 route=do{(binds1,lie_binds,thing)<-tc_haskell98top_lvlsig_fnprag_fnRecursivebindsthing_inside;return([(Recursive,binds1`unionBags`lie_binds)],thing)}|otherwise-- Recursive group, with -XRelaxedPolyRec=-- To maximise polymorphism (with -XRelaxedPolyRec), we do a new -- strongly-connected-component analysis, this time omitting -- any references to variables with type signatures.---- Notice that the bindInsts thing covers *all* the bindings in-- the original group at once; an earlier one may use a later one!do{traceTc(text"tc_group rec"<+>pprLHsBindsbinds);(binds1,lie_binds,thing)<-bindLocalInststop_lvl$go(stronglyConnCompFromEdgedVertices(mkEdgessig_fnbinds));return([(Recursive,binds1`unionBags`lie_binds)],thing)}-- Rec them all togetherwhere-- go :: SCC (LHsBind Name) -> TcM (LHsBinds TcId, [TcId], thing)go(scc:sccs)=do{(binds1,ids1)<-tc_sccscc;(binds2,ids2,thing)<-tcExtendIdEnvids1$gosccs;return(binds1`unionBags`binds2,ids1++ids2,thing)}go[]=do{thing<-thing_inside;return(emptyBag,[],thing)}tc_scc(AcyclicSCCbind)=tc_sub_groupNonRecursive(unitBagbind)tc_scc(CyclicSCCbinds)=tc_sub_groupRecursive(listToBagbinds)tc_sub_group=tcPolyBindstop_lvlsig_fnprag_fnRecursivetc_haskell98::TopLevelFlag->TcSigFun->TcPragFun->RecFlag->LHsBindsName->TcMa->TcM(LHsBindsTcId,TcDictBinds,a)tc_haskell98top_lvlsig_fnprag_fnrec_flagbindsthing_inside=bindLocalInststop_lvl$do{(binds1,ids)<-tcPolyBindstop_lvlsig_fnprag_fnrec_flagrec_flagbinds;thing<-tcExtendIdEnvidsthing_inside;return(binds1,ids,thing)}------------------------bindLocalInsts::TopLevelFlag->TcM(LHsBindsTcId,[TcId],a)->TcM(LHsBindsTcId,TcDictBinds,a)bindLocalInststop_lvlthing_inside|isTopLeveltop_lvl=do{(binds,_,thing)<-thing_inside;return(binds,emptyBag,thing)}-- For the top level don't bother with all this bindInstsOfLocalFuns stuff. -- All the top level things are rec'd together anyway, so it's fine to-- leave them to the tcSimplifyTop, and quite a bit faster too|otherwise-- Nested case=do{((binds,ids,thing),lie)<-getLIEthing_inside;lie_binds<-bindInstsOfLocalFunslieids;return(binds,lie_binds,thing)}------------------------mkEdges::TcSigFun->LHsBindsName->[(LHsBindName,BKey,[BKey])]typeBKey=Int-- Just number off the bindingsmkEdgessig_fnbinds=[(bind,key,[key|n<-nameSetToList(bind_fvs(unLocbind)),Justkey<-[lookupNameEnvkey_mapn],no_sign])|(bind,key)<-keyd_binds]whereno_sig::Name->Boolno_sign=isNothing(sig_fnn)keyd_binds=bagToListbinds`zip`[0::BKey..]key_map::NameEnvBKey-- Which binding it comes fromkey_map=mkNameEnv[(bndr,key)|(L_bind,key)<-keyd_binds,bndr<-bindersOfHsBindbind]bindersOfHsBind::HsBindName->[Name]bindersOfHsBind(PatBind{pat_lhs=pat})=collectPatBinderspatbindersOfHsBind(FunBind{fun_id=L_f})=[f]bindersOfHsBind(AbsBinds{})=panic"bindersOfHsBind AbsBinds"bindersOfHsBind(VarBind{})=panic"bindersOfHsBind VarBind"------------------------tcPolyBinds::TopLevelFlag->TcSigFun->TcPragFun->RecFlag-- Whether the group is really recursive->RecFlag-- Whether it's recursive after breaking-- dependencies based on type signatures->LHsBindsName->TcM(LHsBindsTcId,[TcId])-- Typechecks a single bunch of bindings all together, -- and generalises them. The bunch may be only part of a recursive-- group, because we use type signatures to maximise polymorphism---- Returns a list because the input may be a single non-recursive binding,-- in which case the dependency order of the resulting bindings is-- important. -- -- Knows nothing about the scope of the bindingstcPolyBindstop_lvlsig_fnprag_fnrec_grouprec_tcbinds=letbind_list=bagToListbindsbinder_names=collectHsBindBindersbindsloc=getLoc(headbind_list)-- TODO: location a bit awkward, but the mbinds have been-- dependency analysed and may no longer be adjacentin-- SET UP THE MAIN RECOVERY; take advantage of any type sigssetSrcSpanloc$recoverM(recoveryCodebinder_namessig_fn)$do{traceTc(ptext(sLit"------------------------------------------------"));traceTc(ptext(sLit"Bindings for")<+>pprbinder_names)-- TYPECHECK THE BINDINGS;((binds',mono_bind_infos),lie_req)<-getLIE(tcMonoBindsbind_listsig_fnrec_tc);traceTc(text"temp"<+>(pprbinds'$$pprlie_req))-- CHECK FOR UNLIFTED BINDINGS-- These must be non-recursive etc, and are not generalised-- They desugar to a case expression in the end;zonked_mono_tys<-zonkTcTypes(mapgetMonoTypemono_bind_infos);is_strict<-checkStrictBindstop_lvlrec_groupbinds'zonked_mono_tysmono_bind_infos;ifis_strictthendo{extendLIEslie_req;letexports=zipWithmk_exportmono_bind_infoszonked_mono_tysmk_export(name,Nothing,mono_id)mono_ty=([],mkLocalIdnamemono_ty,mono_id,[])mk_export(_,Justsig,mono_id)_=([],sig_idsig,mono_id,[])-- ToDo: prags for unlifted bindings;return(unitBag$Lloc$AbsBinds[][]exportsbinds',[poly_id|(_,poly_id,_,_)<-exports])}-- Guaranteed zonkedelsedo-- The normal lifted case: GENERALISE{dflags<-getDOpts;(tyvars_to_gen,dicts,dict_binds)<-addErrCtxt(genCtxt(bndrNamesmono_bind_infos))$generalisedflagstop_lvlbind_listsig_fnmono_bind_infoslie_req-- BUILD THE POLYMORPHIC RESULT IDs;letdict_vars=mapinstToVardicts-- May include equality constraints;exports<-mapM(mkExporttop_lvlprag_fntyvars_to_gen(mapvarTypedict_vars))mono_bind_infos;letpoly_ids=[poly_id|(_,poly_id,_,_)<-exports];traceTc(text"binding:"<+>ppr(poly_ids`zip`mapidTypepoly_ids));letabs_bind=Lloc$AbsBindstyvars_to_gendict_varsexports(dict_binds`unionBags`binds');return(unitBagabs_bind,poly_ids)-- poly_ids are guaranteed zonked by mkExport}}--------------mkExport::TopLevelFlag->TcPragFun->[TyVar]->[TcType]->MonoBindInfo->TcM([TyVar],Id,Id,[LPrag])-- mkExport generates exports with -- zonked type variables, -- zonked poly_ids-- The former is just because no further unifications will change-- the quantified type variables, so we can fix their final form-- right now.-- The latter is needed because the poly_ids are used to extend the-- type environment; see the invariant on TcEnv.tcExtendIdEnv -- Pre-condition: the inferred_tvs are already zonkedmkExporttop_lvlprag_fninferred_tvsdict_tys(poly_name,mb_sig,mono_id)=do{warn_missing_sigs<-doptMOpt_WarnMissingSigs;letwarn=isTopLeveltop_lvl&&warn_missing_sigs;(tvs,poly_id)<-mk_poly_idwarnmb_sig-- poly_id has a zonked type;prags<-tcPragspoly_id(prag_fnpoly_name)-- tcPrags requires a zonked poly_id;return(tvs,poly_id,mono_id,prags)}wherepoly_ty=mkForAllTysinferred_tvs(mkFunTysdict_tys(idTypemono_id))mk_poly_idwarnNothing=do{poly_ty'<-zonkTcTypepoly_ty;missingSigWarnwarnpoly_namepoly_ty';return(inferred_tvs,mkLocalIdpoly_namepoly_ty')}mk_poly_id_(Justsig)=do{tvs<-mapMzonk_tv(sig_tvssig);return(tvs,sig_idsig)}zonk_tvtv=do{ty<-zonkTcTyVartv;return(tcGetTyVar"mkExport"ty)}------------------------typeTcPragFun=Name->[LSigName]mkPragFun::[LSigName]->TcPragFunmkPragFunsigs=\n->lookupNameEnvenvn`orElse`[]whereprs=[(expectJust"mkPragFun"(sigNamesig),sig)|sig<-sigs,isPragLSigsig]env=foldladdemptyNameEnvprsaddenv(n,p)=extendNameEnv_Acc(:)singletonenvnptcPrags::Id->[LSigName]->TcM[LPrag]tcPragspoly_idprags=mapM(wrapLocMtc_prag)pragswheretc_pragprag=addErrCtxt(pragSigCtxtprag)$tcPragpoly_idpragpragSigCtxt::SigName->SDocpragSigCtxtprag=hang(ptext(sLit"In the pragma"))2(pprprag)tcPrag::TcId->SigName->TcMPrag-- Pre-condition: the poly_id is zonked-- Reason: required by tcSubExp-- Most of the work of specialisation is done by -- the desugarer, guided by the SpecPragtcPragpoly_id(SpecSig_hs_tyinl)=do{letname=idNamepoly_id;spec_ty<-tcHsSigType(FunSigCtxtname)hs_ty;co_fn<-tcSubExp(SpecPragOriginname)(idTypepoly_id)spec_ty;return(SpecPrag(mkHsWrapco_fn(HsVarpoly_id))spec_tyinl)}tcPragpoly_id(SpecInstSighs_ty)=do{letname=idNamepoly_id;(tyvars,theta,tau)<-tcHsInstHeadhs_ty;letspec_ty=mkSigmaTytyvarsthetatau;co_fn<-tcSubExp(SpecPragOriginname)(idTypepoly_id)spec_ty;return(SpecPrag(mkHsWrapco_fn(HsVarpoly_id))spec_tydefaultInlineSpec)}tcPrag_(InlineSig_inl)=return(InlinePraginl)tcPrag_sig=pprPanic"tcPrag"(pprsig)---------------- If typechecking the binds fails, then return with each-- signature-less binder given type (forall a.a), to minimise -- subsequent error messagesrecoveryCode::[Name]->(Name->Maybe[Name])->TcM(LHsBindsTcId,[Id])recoveryCodebinder_namessig_fn=do{traceTc(text"tcBindsWithSigs: error recovery"<+>pprbinder_names);poly_ids<-mapMmk_dummybinder_names;return(emptyBag,poly_ids)}wheremk_dummyname|isJust(sig_fnname)=tcLookupIdname-- Had signature; look it up|otherwise=return(mkLocalIdnameforall_a_a)-- No signatureforall_a_a::TcTypeforall_a_a=mkForAllTyalphaTyVar(mkTyVarTyalphaTyVar)-- Check that non-overloaded unlifted bindings are-- a) non-recursive,-- b) not top level, -- c) not a multiple-binding group (more or less implied by (a))checkStrictBinds::TopLevelFlag->RecFlag->LHsBindsTcId->[TcType]->[MonoBindInfo]->TcMBoolcheckStrictBindstop_lvlrec_groupmbindmono_tysinfos|unlifted||bang_pat=do{checkTc(isNotTopLeveltop_lvl)(strictBindErr"Top-level"unliftedmbind);checkTc(isNonRecrec_group)(strictBindErr"Recursive"unliftedmbind);checkTc(isSingletonBagmbind)(strictBindErr"Multiple"unliftedmbind)-- This should be a checkTc, not a warnTc, but as of GHC 6.11-- the versions of alex and happy available have non-conforming-- templates, so the GHC build fails if it's an error:;warnUnlifted<-doptMOpt_WarnLazyUnliftedBindings;warnTc(warnUnlifted&&notbang_pat)(unliftedMustBeBangmbind);mapM_check_siginfos;returnTrue}|otherwise=returnFalsewhereunlifted=anyisUnLiftedTypemono_tysbang_pat=anyBag(isBangHsBind.unLoc)mbindcheck_sig(_,Justsig,_)=checkTc(null(sig_tvssig)&&null(sig_thetasig))(badStrictSigunliftedsig)check_sig_=return()unliftedMustBeBang::LHsBindsLRVarVar->SDocunliftedMustBeBangmbind=hang(text"Bindings containing unlifted types must use an outermost bang pattern:")4(pprLHsBindsmbind)$$text"*** This will be an error in GHC 6.14! Fix your code now!"strictBindErr::String->Bool->LHsBindsLRVarVar->SDocstrictBindErrflavourunliftedmbind=hang(textflavour<+>msg<+>ptext(sLit"aren't allowed:"))4(pprLHsBindsmbind)wheremsg|unlifted=ptext(sLit"bindings for unlifted types")|otherwise=ptext(sLit"bang-pattern bindings")badStrictSig::Bool->TcSigInfo->SDocbadStrictSigunliftedsig=hang(ptext(sLit"Illegal polymorphic signature in")<+>msg)4(pprsig)wheremsg|unlifted=ptext(sLit"an unlifted binding")|otherwise=ptext(sLit"a bang-pattern binding")\end{code}%************************************************************************%**\subsection{tcMonoBind}%**%************************************************************************@tcMonoBinds@dealswithaperhaps-recursivegroupofHsBinds.Thesignatureshavebeendealtwithalready.\begin{code}tcMonoBinds::[LHsBindName]->TcSigFun->RecFlag-- Whether the binding is recursive for typechecking purposes-- i.e. the binders are mentioned in their RHSs, and-- we are not resuced by a type signature->TcM(LHsBindsTcId,[MonoBindInfo])tcMonoBinds[Lb_loc(FunBind{fun_id=Lnm_locname,fun_infix=inf,fun_matches=matches,bind_fvs=fvs})]sig_fn-- Single function binding,NonRecursive-- binder isn't mentioned in RHS,|Nothing<-sig_fnname-- ...with no type signature=-- In this very special case we infer the type of the-- right hand side first (it may have a higher-rank type)-- and *then* make the monomorphic Id for the LHS-- e.g. f = \(x::forall a. a->a) -> <body>-- We want to infer a higher-rank type for fsetSrcSpanb_loc$do{((co_fn,matches'),rhs_ty)<-tcInfer(tcMatchesFunnameinfmatches)-- Check for an unboxed tuple type-- f = (# True, False #)-- Zonk first just in case it's hidden inside a meta type variable-- (This shows up as a (more obscure) kind error -- in the 'otherwise' case of tcMonoBinds.);zonked_rhs_ty<-zonkTcTyperhs_ty;checkTc(not(isUnboxedTupleTypezonked_rhs_ty))(unboxedTupleErrnamezonked_rhs_ty);mono_name<-newLocalNamename;letmono_id=mkLocalIdmono_namezonked_rhs_ty;return(unitBag(Lb_loc(FunBind{fun_id=Lnm_locmono_id,fun_infix=inf,fun_matches=matches',bind_fvs=fvs,fun_co_fn=co_fn,fun_tick=Nothing})),[(name,Nothing,mono_id)])}tcMonoBinds[Lb_loc(FunBind{fun_id=Lnm_locname,fun_infix=inf,fun_matches=matches})]sig_fn-- Single function binding_|Justscoped_tvs<-sig_fnname-- ...with a type signature=-- When we have a single function binding, with a type signature-- we can (a) use genuine, rigid skolem constants for the type variables-- (b) bring (rigid) scoped type variables into scopesetSrcSpanb_loc$do{tc_sig<-tcInstSigTruename;mono_name<-newLocalNamename;letmono_ty=sig_tautc_sigmono_id=mkLocalIdmono_namemono_tyrhs_tvs=[(name,mkTyVarTytv)|(name,tv)<-scoped_tvs`zip`sig_tvstc_sig]-- See Note [More instantiated than scoped]-- Note that the scoped_tvs and the (sig_tvs sig) -- may have different Names. That's quite ok.;traceTc(text"tcMoonBinds"<+>pprscoped_tvs$$pprtc_sig);(co_fn,matches')<-tcExtendTyVarEnv2rhs_tvs$tcMatchesFunmono_nameinfmatchesmono_ty-- Note that "mono_ty" might actually be a polymorphic type,-- if the original function had a signature like-- forall a. Eq a => forall b. Ord b => ....-- But that's ok: tcMatchesFun can deal with that-- It happens, too! See Note [Polymorphic methods] in TcClassDcl.;letfun_bind'=FunBind{fun_id=Lnm_locmono_id,fun_infix=inf,fun_matches=matches',bind_fvs=placeHolderNames,fun_co_fn=co_fn,fun_tick=Nothing};return(unitBag(Lb_locfun_bind'),[(name,Justtc_sig,mono_id)])}tcMonoBindsbindssig_fn_=do{tc_binds<-mapM(wrapLocM(tcLhssig_fn))binds-- Bring the monomorphic Ids, into scope for the RHSs;letmono_info=getMonoBindInfotc_bindsrhs_id_env=[(name,mono_id)|(name,Nothing,mono_id)<-mono_info]-- A monomorphic binding for each term variable that lacks -- a type sig. (Ones with a sig are already in scope.);binds'<-tcExtendIdEnv2rhs_id_env$dotraceTc(text"tcMonoBinds"<+>vcat[pprn<+>pprid<+>ppr(idTypeid)|(n,id)<-rhs_id_env])mapM(wrapLocMtcRhs)tc_binds;return(listToBagbinds',mono_info)}-------------------------- tcLhs typechecks the LHS of the bindings, to construct the environment in which-- we typecheck the RHSs. Basically what we are doing is this: for each binder:-- if there's a signature for it, use the instantiated signature type-- otherwise invent a type variable-- You see that quite directly in the FunBind case.-- -- But there's a complication for pattern bindings:-- data T = MkT (forall a. a->a)-- MkT f = e-- Here we can guess a type variable for the entire LHS (which will be refined to T)-- but we want to get (f::forall a. a->a) as the RHS environment.-- The simplest way to do this is to typecheck the pattern, and then look up the-- bound mono-ids. Then we want to retain the typechecked pattern to avoid re-doing-- it; hence the TcMonoBind data type in which the LHS is done but the RHS isn'tdataTcMonoBind-- Half completed; LHS done, RHS not done=TcFunBindMonoBindInfo(LocatedTcId)Bool(MatchGroupName)|TcPatBind[MonoBindInfo](LPatTcId)(GRHSsName)TcSigmaTypetypeMonoBindInfo=(Name,MaybeTcSigInfo,TcId)-- Type signature (if any), and-- the monomorphic bound thingsbndrNames::[MonoBindInfo]->[Name]bndrNamesmbi=[n|(n,_,_)<-mbi]getMonoType::MonoBindInfo->TcTauTypegetMonoType(_,_,mono_id)=idTypemono_idtcLhs::TcSigFun->HsBindName->TcMTcMonoBindtcLhssig_fn(FunBind{fun_id=Lnm_locname,fun_infix=inf,fun_matches=matches})=do{mb_sig<-tcInstSig_maybesig_fnname;mono_name<-newLocalNamename;mono_ty<-mk_mono_tymb_sig;letmono_id=mkLocalIdmono_namemono_ty;return(TcFunBind(name,mb_sig,mono_id)(Lnm_locmono_id)infmatches)}wheremk_mono_ty(Justsig)=return(sig_tausig)mk_mono_tyNothing=newFlexiTyVarTyargTypeKindtcLhssig_fn(PatBind{pat_lhs=pat,pat_rhs=grhss})=do{mb_sigs<-mapM(tcInstSig_maybesig_fn)names;mono_pat_binds<-doptMOpt_MonoPatBinds-- With -XMonoPatBinds, we do no generalisation of pattern bindings-- But the signature can still be polymoprhic!-- data T = MkT (forall a. a->a)-- x :: forall a. a->a-- MkT x = <rhs>-- The function get_sig_ty decides whether the pattern-bound variables-- should have exactly the type in the type signature (-XMonoPatBinds), -- or the instantiated version (-XMonoPatBinds);letnm_sig_prs=names`zip`mb_sigsget_sig_ty|mono_pat_binds=idType.sig_id|otherwise=sig_tautau_sig_env=mkNameEnv[(name,get_sig_tysig)|(name,Justsig)<-nm_sig_prs]sig_tau_fn=lookupNameEnvtau_sig_envtc_patexp_ty=tcLetPatsig_tau_fnpatexp_ty$mapMlookup_infonm_sig_prs-- After typechecking the pattern, look up the binder-- names, which the pattern has brought into scope.lookup_info::(Name,MaybeTcSigInfo)->TcMMonoBindInfolookup_info(name,mb_sig)=do{mono_id<-tcLookupIdname;return(name,mb_sig,mono_id)};((pat',infos),pat_ty)<-addErrCtxt(patMonoBindsCtxtpatgrhss)$tcInfertc_pat;return(TcPatBindinfospat'grhsspat_ty)}wherenames=collectPatBinderspattcLhs_other_bind=pprPanic"tcLhs"(pprother_bind)-- AbsBind, VarBind impossible-------------------tcRhs::TcMonoBind->TcM(HsBindTcId)-- When we are doing pattern bindings, or multiple function bindings at a time-- we *don't* bring any scoped type variables into scope-- Wny not? They are not completely rigid.-- That's why we have the special case for a single FunBind in tcMonoBindstcRhs(TcFunBind(_,_,mono_id)fun'infmatches)=do{(co_fn,matches')<-tcMatchesFun(idNamemono_id)infmatches(idTypemono_id);return(FunBind{fun_id=fun',fun_infix=inf,fun_matches=matches',bind_fvs=placeHolderNames,fun_co_fn=co_fn,fun_tick=Nothing})}tcRhs(TcPatBind_pat'grhsspat_ty)=do{grhss'<-addErrCtxt(patMonoBindsCtxtpat'grhss)$tcGRHSsPatgrhsspat_ty;return(PatBind{pat_lhs=pat',pat_rhs=grhss',pat_rhs_ty=pat_ty,bind_fvs=placeHolderNames})}---------------------getMonoBindInfo::[LocatedTcMonoBind]->[MonoBindInfo]getMonoBindInfotc_binds=foldr(get_info.unLoc)[]tc_bindswhereget_info(TcFunBindinfo___)rest=info:restget_info(TcPatBindinfos___)rest=infos++rest\end{code}%************************************************************************%**Generalisation%**%************************************************************************\begin{code}generalise::DynFlags->TopLevelFlag->[LHsBindName]->TcSigFun->[MonoBindInfo]->[Inst]->TcM([TyVar],[Inst],TcDictBinds)-- The returned [TyVar] are all ready to quantifygeneralisedflagstop_lvlbind_listsig_fnmono_infoslie_req|isMonoGroupdflagstop_lvlbind_listsigs=do{extendLIEslie_req;return([],[],emptyBag)}|isRestrictedGroupdflagsbind_listsig_fn-- RESTRICTED CASE=-- Check signature contexts are empty do{checkTc(allis_mono_sigsigs)(restrictedBindCtxtErrbndrs)-- Now simplify with exactly that set of tyvars-- We have to squash those Methods;(qtvs,binds)<-tcSimplifyRestricteddoctop_lvlbndrstau_tvslie_req-- Check that signature type variables are OK;final_qtvs<-checkSigsTyVarsqtvssigs;return(final_qtvs,[],binds)}|nullsigs-- UNRESTRICTED CASE, NO TYPE SIGS=tcSimplifyInferdoctau_tvslie_req|otherwise-- UNRESTRICTED CASE, WITH TYPE SIGS=do{sig_lie<-unifyCtxtssigs-- sigs is non-empty; sig_lie is zonked;let-- The "sig_avails" is the stuff available. We get that from-- the context of the type signature, BUT ALSO the lie_avail-- so that polymorphic recursion works right (see Note [Polymorphic recursion])local_meths=[mkMethInstsigmono_id|(_,Justsig,mono_id)<-mono_infos]sig_avails=sig_lie++local_methsloc=sig_loc(headsigs)-- Check that the needed dicts can be-- expressed in terms of the signature ones;(qtvs,binds)<-tcSimplifyInferCheckloctau_tvssig_availslie_req-- Check that signature type variables are OK;final_qtvs<-checkSigsTyVarsqtvssigs;return(final_qtvs,sig_lie,binds)}wherebndrs=bndrNamesmono_infossigs=[sig|(_,Justsig,_)<-mono_infos]get_tvs|isTopLeveltop_lvl=tyVarsOfType-- See Note [Silly type synonym] in TcType|otherwise=exactTyVarsOfTypetau_tvs=foldr(unionVarSet.get_tvs.getMonoType)emptyVarSetmono_infosis_mono_sigsig=null(sig_thetasig)doc=ptext(sLit"type signature(s) for")<+>pprBindersbndrsmkMethInst(TcSigInfo{sig_id=poly_id,sig_tvs=tvs,sig_theta=theta,sig_loc=loc})mono_id=Method{tci_id=mono_id,tci_oid=poly_id,tci_tys=mkTyVarTystvs,tci_theta=theta,tci_loc=loc}\end{code}unifyCtxtschecksthatallthesignaturecontextsarethesameThetypesignaturesonamutually-recursivegroupofdefinitionsmustallhavethesamecontext(ornone).Thetrickhereisthatallthesignaturesshouldhavethesamecontext,andwewanttosharetypevariablesforthatcontext,sothatalltherighthandsidesagreeacommonvocabularyfortheirtypeconstraintsWeunifythembecause,withpolymorphicrecursion,theirtypesmightnototherwiseberelated.Thisisarathersubtleissue.\begin{code}unifyCtxts::[TcSigInfo]->TcM[Inst]-- Post-condition: the returned Insts are full zonkedunifyCtxts[]=panic"unifyCtxts []"unifyCtxts(sig1:sigs)-- Argument is always non-empty=do{traceTc$text"unifyCtxts"<+>ppr(sig1:sigs);mapM_unify_ctxtsigs;theta<-zonkTcThetaType(sig_thetasig1);newDictBndrs(sig_locsig1)theta}wheretheta1=sig_thetasig1unify_ctxt::TcSigInfo->TcM()unify_ctxtsig@(TcSigInfo{sig_theta=theta})=setSrcSpan(instLocSpan(sig_locsig))$addErrCtxt(sigContextsCtxtsig1sig)$do{cois<-unifyThetatheta1theta;-- Check whether all coercions are identity coercions-- That can happen if we have, say-- f :: C [a] => ...-- g :: C (F a) => ...-- where F is a type function and (F a ~ [a])-- Then unification might succeed with a coercion. But it's much-- much simpler to require that such signatures have identical contextscheckTc(allisIdentityCoIcois)(ptext(sLit"Mutually dependent functions have syntactically distinct contexts"))}checkSigsTyVars::[TcTyVar]->[TcSigInfo]->TcM[TcTyVar]checkSigsTyVarsqtvssigs=do{gbl_tvs<-tcGetGlobalTyVars;sig_tvs_s<-mapM(check_siggbl_tvs)sigs;let-- Sigh. Make sure that all the tyvars in the type sigs-- appear in the returned ty var list, which is what we are-- going to generalise over. Reason: we occasionally get-- silly types like-- type T a = () -> ()-- f :: T a-- f () = ()-- Here, 'a' won't appear in qtvs, so we have to add itsig_tvs=foldlextendVarSetListemptyVarSetsig_tvs_sall_tvs=varSetElems(extendVarSetListsig_tvsqtvs);returnall_tvs}wherecheck_siggbl_tvs(TcSigInfo{sig_id=id,sig_tvs=tvs,sig_theta=theta,sig_tau=tau})=addErrCtxt(ptext(sLit"In the type signature for")<+>quotes(pprid))$addErrCtxtM(sigCtxtidtvsthetatau)$do{tvs'<-checkDistinctTyVarstvs;when(any(`elemVarSet`gbl_tvs)tvs')(bleatEscapedTvsgbl_tvstvstvs');returntvs'}checkDistinctTyVars::[TcTyVar]->TcM[TcTyVar]-- (checkDistinctTyVars tvs) checks that the tvs from one type signature-- are still all type variables, and all distinct from each other. -- It returns a zonked set of type variables.-- For example, if the type sig is-- f :: forall a b. a -> b -> b-- we want to check that 'a' and 'b' haven't -- (a) been unified with a non-tyvar type-- (b) been unified with each other (all distinct)checkDistinctTyVarssig_tvs=do{zonked_tvs<-mapMzonkSigTyVarsig_tvs;foldlM_check_dupemptyVarEnv(sig_tvs`zip`zonked_tvs);returnzonked_tvs}wherecheck_dup::TyVarEnvTcTyVar->(TcTyVar,TcTyVar)->TcM(TyVarEnvTcTyVar)-- The TyVarEnv maps each zonked type variable back to its-- corresponding user-written signature type variablecheck_dupacc(sig_tv,zonked_tv)=caselookupVarEnvacczonked_tvofJustsig_tv'->bomb_outsig_tvsig_tv'Nothing->return(extendVarEnvacczonked_tvsig_tv)bomb_outsig_tv1sig_tv2=do{env0<-tcInitTidyEnv;let(env1,tidy_tv1)=tidyOpenTyVarenv0sig_tv1(env2,tidy_tv2)=tidyOpenTyVarenv1sig_tv2msg=ptext(sLit"Quantified type variable")<+>quotes(pprtidy_tv1)<+>ptext(sLit"is unified with another quantified type variable")<+>quotes(pprtidy_tv2);failWithTcM(env2,msg)}\end{code}@getTyVarsToGen@decideswhattypevariablestogeneraliseover.Fora"restricted group"-- see the monomorphism restrictionforadefinition-- we bind no dictionaries, andremovefromtyvars_to_genanyconstrainedtypevariables*Don't*simplifydictsatthispoint,becausewearen'tgoingtogeneraliseoverthesedicts.Bythetimewedosimplifythemwemaywellknowmore.Forexample(thisactuallycameup)f::ArrayIntIntfx=array...xswherexs=[1,2,3,4,5]Wedon'twanttogeneratelotsof(fromIntInt1),(fromIntInt2)stuff.Ifwesimplifyonlyatthef-binding(notthexs-binding)we'llknowthattheliteralsareallInts,andwecanjustproduceIntliterals!Findallthetypevariablesinvolvedinoverloading,the"constrained_tyvars".Thesearetheoneswe*aren't*goingtogeneralise.Wemustbecarefulaboutdoingthis:(a)Ifwefailtogeneraliseatyvarwhichisnotactuallyconstrained,thenitwillnever,evergetbound,andlandsupprintedoutininterfacefiles!Notoriousexample:instanceEqa=>Eq(Fooab)where..Here,bisnotconstrained,eventhoughitlooksasifitis.Another,morecommon,exampleiswhenthere'saMethodinstintheLIE,whosetypemightverywellinvolvenon-overloadedtypevariables.[NOTE:Jan2001:Idon'tunderstandtheproblemheresoI'mdoingthesimplethinginstead](b)Ontheotherhand,wemustn'tgeneralisetyvarswhichareconstrained,becausewearegoingtopassonouttheunmodifiedLIE,withthosetyvarsinit.Theywon'tbeinscopeifwe'vegeneralisedthem.Sowearecareful,anddoacompletesimplificationjusttofindtheconstrainedtyvars.Wedon'tuseanyoftheresults,excepttofindwhichtyvarsareconstrained.Note[Polymorphicrecursion]~~~~~~~~~~~~~~~~~~~~~~~~~~~~Thegameplanforpolymorphicrecursioninthecodeaboveis*BindanyvariableforwhichwehaveatypesignaturetoanIdwithapolymorphictype.Thenwhentype-checkingtheRHSswe'llmakeafullpolymorphiccall.Thisfine,butifyouaren'tabitcarefulyouendupwithahorrendousamountofpartialapplicationand(worse)ahugespaceleak.Forexample:f::Eqa=>[a]->[a]fxs=...f...Ifwedon'ttakecare,aftertypecheckingwegetf=/\a->\d::Eqa->letf'=fadin\ys:[a]->...f'...Noticethethestupidconstructionof(fad),whichisofcourseidenticaltothefunctionwe'reexecuting.Inthiscase,thepolymorphicrecursionisn'tbeingused(butthat'saverycommoncase).Thiscanleadtoamassivespaceleak,fromthefollowingtop-leveldefn(post-typechecking)ff::[Int]->[Int]ff=fIntdEqIntNow(fdEqInt)evaluatestoalambdathathasf'asafreevariable;butf'isanotherthunkwhichevaluatestothesamething...andyouendupwithachainofidenticalvaluesallhungontobytheCAFff.ff=fIntdEqInt=letf'=fIntdEqIntin\ys....f'...=letf'=letf'=fIntdEqIntin\ys....f'...in\ys....f'...Etc.NOTE:abitofarityanaysiswouldpushthe(fad)insidethe(\ys...),whichwouldmakethespaceleakgoawayinthiscaseSolution:whentypecheckingtheRHSswealwayshaveinhandthe*monomorphic*Idsforeachbinding.Sowejustneedtomakesurethatif(Methodfad)showsupintheconstraintsemergingfrom(...f...)wejustusethemonomorphicId.WeachievethisbyaddingmonomorphicIdstothe"givens"whensimplifyingconstraints.That'swhatthe"lies_avail"isdoing.Thenwegetf=/\a->\d::Eqa->letrecfm=\ys:[a]->...fm...infm%************************************************************************%**Signatures%**%************************************************************************Typesignaturesaretricky.SeeNote[Signatureskolems]inTcType@tcSigs@checksthesignaturesforvalidity,andreturnsalistof{\emfreshly-instantiated}signatures.Thatis,thetypesarealreadysplitup,andhavefreshtypevariablesinstalled.Allnon-type-signature"RenamedSigs"areignored.The@TcSigInfo@contains@TcTypes@becausetheyareunifiedwiththevariable'stype,andafterthatcheckedtoseewhetherthey'vebeeninstantiated.Note[Scopedtyvars]~~~~~~~~~~~~~~~~~~~~The-XScopedTypeVariablesflagbringslexically-scopedtypevariablesintoscopeforanyexplicitlyforall-quantifiedtypevariables:f::foralla.a->afx=eThen'a'isinscopeinside'e'.However,wedo*not*supportthis-Forpatternbindingse.gf::foralla.a->a(f,g)=e-Formultiplefunctionbindings,unlessOpt_RelaxedPolyRecisonf::foralla.a->af=gg::forallb.b->bg=...f...Reason:weusemutablevariablesfor'a'and'b',sincetheymayunifytoeachother,andthatmeansthescopedtypevariablewouldnotstandforacompletelyrigidvariable.Currently,wesimplymakeOpt_ScopedTypeVariablesimplyOpt_RelaxedPolyRecNote[Moreinstantiatedthanscoped]~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Theremaybemoreinstantiatedtypevariablesthanlexically-scopedones.Forexample:typeTa=forallb.b->(a,b)f::forallc.TcHere,thesignatureforfwillhaveonescopedtypevariable,c,buttwoinstantiatedtypevariables,c'andb'.Weassumethatthescopedonesareatthe*front*ofsig_tvs,andrememberthenamesfromtheoriginalHsForAllTyintheTcSigFun.\begin{code}typeTcSigFun=Name->Maybe[Name]-- Maps a let-binder to the list of-- type variables brought into scope-- by its type signature.-- Nothing => no type signaturemkTcSigFun::[LSigName]->TcSigFun-- Search for a particular type signature-- Precondition: the sigs are all type sigs-- Precondition: no duplicatesmkTcSigFunsigs=lookupNameEnvenvwhereenv=mkNameEnv(mapCatMaybesmk_pairsigs)mk_pair(L_(TypeSig(L_name)lhs_ty))=Just(name,hsExplicitTvslhs_ty)mk_pair(L_(IdSigid))=Just(idNameid,[])mk_pair_=Nothing-- The scoped names are the ones explicitly mentioned-- in the HsForAll. (There may be more in sigma_ty, because-- of nested type synonyms. See Note [More instantiated than scoped].)-- See Note [Only scoped tyvars are in the TyVarEnv]---------------dataTcSigInfo=TcSigInfo{sig_id::TcId,-- *Polymorphic* binder for this value...sig_tvs::[TcTyVar],-- Instantiated type variables-- See Note [Instantiate sig]sig_theta::TcThetaType,-- Instantiated thetasig_tau::TcTauType,-- Instantiated tausig_loc::InstLoc-- The location of the signature}-- Note [Only scoped tyvars are in the TyVarEnv]-- We are careful to keep only the *lexically scoped* type variables in-- the type environment. Why? After all, the renamer has ensured-- that only legal occurrences occur, so we could put all type variables-- into the type env.---- But we want to check that two distinct lexically scoped type variables-- do not map to the same internal type variable. So we need to know which-- the lexically-scoped ones are... and at the moment we do that by putting-- only the lexically scoped ones into the environment.-- Note [Instantiate sig]-- It's vital to instantiate a type signature with fresh variables.-- For example:-- type S = forall a. a->a-- f,g :: S-- f = ...-- g = ...-- Here, we must use distinct type variables when checking f,g's right hand sides.-- (Instantiation is only necessary because of type synonyms. Otherwise,-- it's all cool; each signature has distinct type variables from the renamer.)instanceOutputableTcSigInfowhereppr(TcSigInfo{sig_id=id,sig_tvs=tyvars,sig_theta=theta,sig_tau=tau})=pprid<+>ptext(sLit"::")<+>pprtyvars<+>pprtheta<+>ptext(sLit"=>")<+>pprtau\end{code}\begin{code}tcTySig::LSigName->TcMTcIdtcTySig(Lspan(TypeSig(L_name)ty))=setSrcSpanspan$do{sigma_ty<-tcHsSigType(FunSigCtxtname)ty;return(mkLocalIdnamesigma_ty)}tcTySig(L_(IdSigid))=returnidtcTySigs=pprPanic"tcTySig"(pprs)-------------------tcInstSig_maybe::TcSigFun->Name->TcM(MaybeTcSigInfo)-- Instantiate with *meta* type variables; -- this signature is part of a multi-signature grouptcInstSig_maybesig_fnname=casesig_fnnameofNothing->returnNothingJust_scoped_tvs->do{tc_sig<-tcInstSigFalsename;return(Justtc_sig)}-- NB: the _scoped_tvs may be non-empty, but we can -- just ignore them. See Note [Scoped tyvars].tcInstSig::Bool->Name->TcMTcSigInfo-- Instantiate the signature, with either skolems or meta-type variables-- depending on the use_skols boolean. This variable is set True-- when we are typechecking a single function binding; and False for-- pattern bindings and a group of several function bindings.-- Reason: in the latter cases, the "skolems" can be unified together, -- so they aren't properly rigid in the type-refinement sense.-- NB: unless we are doing H98, each function with a sig will be done-- separately, even if it's mutually recursive, so use_skols will be True---- We always instantiate with fresh uniques,-- although we keep the same print-name-- -- type T = forall a. [a] -> [a]-- f :: T; -- f = g where { g :: T; g = <rhs> }---- We must not use the same 'a' from the defn of T at both places!!tcInstSiguse_skolsname=do{poly_id<-tcLookupIdname-- Cannot fail; the poly ids are put into -- scope when starting the binding group;letskol_info=SigSkol(FunSigCtxtname);(tvs,theta,tau)<-tcInstSigTypeuse_skolsskol_info(idTypepoly_id);loc<-getInstLoc(SigOriginskol_info);return(TcSigInfo{sig_id=poly_id,sig_tvs=tvs,sig_theta=theta,sig_tau=tau,sig_loc=loc})}-------------------isMonoGroup::DynFlags->TopLevelFlag->[LHsBindName]->[TcSigInfo]->Bool-- No generalisation at allisMonoGroupdflagstop_lvlbindssigs=(doptOpt_MonoPatBindsdflags&&anyis_pat_bindbinds)||(doptOpt_MonoLocalBindsdflags&&nullsigs&&not(isTopLeveltop_lvl))whereis_pat_bind(L_(PatBind{}))=Trueis_pat_bind_=False-------------------isRestrictedGroup::DynFlags->[LHsBindName]->TcSigFun->BoolisRestrictedGroupdflagsbindssig_fn=mono_restriction&&notall_unrestrictedwheremono_restriction=doptOpt_MonomorphismRestrictiondflagsall_unrestricted=all(unrestricted.unLoc)bindshas_sign=isJust(sig_fnn)unrestricted(PatBind{})=Falseunrestricted(VarBind{var_id=v})=has_sigvunrestricted(FunBind{fun_id=v,fun_matches=matches})=unrestricted_matchmatches||has_sig(unLocv)unrestricted(AbsBinds{})=panic"isRestrictedGroup/unrestricted AbsBinds"unrestricted_match(MatchGroup(L_(Match[]__):_)_)=False-- No args => like a pattern bindingunrestricted_match_=True-- Some args => a function binding\end{code}%************************************************************************%**\subsection[TcBinds-errors]{Errorcontextsandmessages}%**%************************************************************************\begin{code}-- This one is called on LHS, when pat and grhss are both Name -- and on RHS, when pat is TcId and grhss is still NamepatMonoBindsCtxt::OutputableBndrid=>LPatid->GRHSsName->SDocpatMonoBindsCtxtpatgrhss=hang(ptext(sLit"In a pattern binding:"))4(pprPatBindpatgrhss)-----------------------------------------------sigContextsCtxt::TcSigInfo->TcSigInfo->SDocsigContextsCtxtsig1sig2=vcat[ptext(sLit"When matching the contexts of the signatures for"),nest2(vcat[pprid1<+>dcolon<+>ppr(idTypeid1),pprid2<+>dcolon<+>ppr(idTypeid2)]),ptext(sLit"The signature contexts in a mutually recursive group should all be identical")]whereid1=sig_idsig1id2=sig_idsig2-----------------------------------------------unboxedTupleErr::Name->Type->SDocunboxedTupleErrnamety=hang(ptext(sLit"Illegal binding of unboxed tuple"))4(pprname<+>dcolon<+>pprty)-----------------------------------------------restrictedBindCtxtErr::[Name]->SDocrestrictedBindCtxtErrbinder_names=hang(ptext(sLit"Illegal overloaded type signature(s)"))4(vcat[ptext(sLit"in a binding group for")<+>pprBindersbinder_names,ptext(sLit"that falls under the monomorphism restriction")])genCtxt::[Name]->SDocgenCtxtbinder_names=ptext(sLit"When generalising the type(s) for")<+>pprBindersbinder_namesmissingSigWarn::Bool->Name->Type->TcM()missingSigWarnFalse__=return()missingSigWarnTruenamety=do{env0<-tcInitTidyEnv;let(env1,tidy_ty)=tidyOpenTypeenv0ty;addWarnTcM(env1,mk_msgtidy_ty)}wheremk_msgty=vcat[ptext(sLit"Definition but no type signature for")<+>quotes(pprname),sep[ptext(sLit"Inferred type:")<+>pprHsVarname<+>dcolon<+>pprty]]\end{code}