%%(c)TheUniversityofGlasgow2006%(c)TheAQUAProject,GlasgowUniversity,1993-1998%\section[TcDefaults]{Typechecking\tr{default}declarations}\begin{code}moduleTcDefaults(tcDefaults)whereimportHsSynimportNameimportClassimportTcRnMonadimportTcEnvimportTcHsTypeimportTcSimplifyimportTcTypeimportPrelNamesimportDynFlagsimportSrcLocimportData.MaybeimportOutputableimportFastString\end{code}\begin{code}tcDefaults::[LDefaultDeclName]->TcM(Maybe[Type])-- Defaulting types to heave-- into Tc monad for later use-- in Disambig.tcDefaults[]=getDeclaredDefaultTys-- No default declaration, so get the-- default types from the envt; -- i.e. use the curent ones-- (the caller will put them back there)-- It's important not to return defaultDefaultTys here (which-- we used to do) because in a TH program, tcDefaults [] is called-- repeatedly, once for each group of declarations between top-level-- splices. We don't want to carefully set the default types in-- one group, only for the next group to ignore them and install-- defaultDefaultTystcDefaults[L_(DefaultDecl[])]=return(Just[])-- Default declaration specifying no typestcDefaults[Llocn(DefaultDeclmono_tys)]=setSrcSpanlocn$addErrCtxtdefaultDeclCtxt$do{ovl_str<-doptMOpt_OverloadedStrings;num_class<-tcLookupClassnumClassName;is_str_class<-tcLookupClassisStringClassName;letdeflt_clss|ovl_str=[num_class,is_str_class]|otherwise=[num_class];tau_tys<-mapM(tc_default_tydeflt_clss)mono_tys;return(Justtau_tys)}tcDefaultsdecls@(Llocn(DefaultDecl_):_)=setSrcSpanlocn$failWithTc(dupDefaultDeclErrdecls)tc_default_ty::[Class]->LHsTypeName->TcMTypetc_default_tydeflt_clsshs_ty=do{ty<-tcHsSigTypeDefaultDeclCtxths_ty;checkTc(isTauTyty)(polyDefErrhs_ty)-- Check that the type is an instance of at least one of the deflt_clss;oks<-mapM(check_instancety)deflt_clss;checkTc(oroks)(badDefaultTytydeflt_clss);returnty}check_instance::Type->Class->TcMBool-- Check that ty is an instance of cls-- We only care about whether it worked or not; return a booleancheck_instancetycls=do{(_,mb_res)<-tryTc(tcSimplifyDefault[mkClassPredcls[ty]]);return(isJustmb_res)}defaultDeclCtxt::SDocdefaultDeclCtxt=ptext(sLit"When checking the types in a default declaration")dupDefaultDeclErr::[Located(DefaultDeclName)]->SDocdupDefaultDeclErr(L_(DefaultDecl_):dup_things)=hang(ptext(sLit"Multiple default declarations"))4(vcat(mapppdup_things))wherepp(Llocn(DefaultDecl_))=ptext(sLit"here was another default declaration")<+>pprlocndupDefaultDeclErr[]=panic"dupDefaultDeclErr []"polyDefErr::LHsTypeName->SDocpolyDefErrty=hang(ptext(sLit"Illegal polymorphic type in default declaration")<>colon)4(pprty)badDefaultTy::Type->[Class]->SDocbadDefaultTytydeflt_clss=hang(ptext(sLit"The default type")<+>quotes(pprty)<+>ptext(sLit"is not an instance of"))2(foldr1(\ab->a<+>ptext(sLit"or")<+>b)(map(quotes.ppr)deflt_clss))\end{code}