{-
(c) The University of Glasgow 2006
(c) The AQUA Project, Glasgow University, 1993-1998
\section[TcDefaults]{Typechecking \tr{default} declarations}
-}{-# LANGUAGE TypeFamilies #-}moduleTcDefaults(tcDefaults )whereimportGhcPreludeimportHsSynimportClassimportTcRnMonad importTcEnv importTcHsType importTcHsSyn importTcSimplify importTcValidity importTcTypeimportPrelNamesimportSrcLocimportOutputableimportFastStringimportqualifiedGHC.LanguageExtensionsasLangExttcDefaults::[LDefaultDeclGhcRn]->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 current 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 (DefaultDecl_mono_tys )]=setSrcSpan locn $addErrCtxt defaultDeclCtxt $do{ovl_str <-xoptM LangExt.OverloadedStrings;ext_deflt <-xoptM LangExt.ExtendedDefaultRules;num_class <-tcLookupClass numClassName;deflt_str <-ifovl_str thenmapMtcLookupClass [isStringClassName]elsereturn[];deflt_interactive <-ifext_deflt thenmapMtcLookupClass interactiveClassNameselsereturn[];letdeflt_clss =num_class :deflt_str ++deflt_interactive ;tau_tys <-mapAndReportM (tc_default_ty deflt_clss )mono_tys ;return(Justtau_tys )}tcDefaultsdecls @(Llocn (DefaultDecl__):_)=setSrcSpan locn $failWithTc (dupDefaultDeclErr decls )tcDefaults(L_(XDefaultDecl_):_)=panic"tcDefaults"tc_default_ty::[Class]->LHsTypeGhcRn->TcMTypetc_default_ty deflt_clss hs_ty =do{(ty ,_kind )<-solveEqualities $tcLHsType hs_ty ;ty <-zonkTcTypeToType ty -- establish Type invariants;checkValidType DefaultDeclCtxtty -- Check that the type is an instance of at least one of the deflt_clss;oks <-mapM(check_instance ty )deflt_clss ;checkTc (oroks )(badDefaultTy ty deflt_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_instance ty cls =do{(_,success )<-discardErrs $askNoErrs $simplifyDefault [mkClassPredcls [ty ]];returnsuccess }defaultDeclCtxt::SDocdefaultDeclCtxt =text"When checking the types in a default declaration"dupDefaultDeclErr::[Located(DefaultDeclGhcRn)]->SDocdupDefaultDeclErr (L_(DefaultDecl__):dup_things )=hang(text"Multiple default declarations")2(vcat(mappp dup_things ))wherepp (Llocn (DefaultDecl__))=text"here was another default declaration"<+>pprlocn pp(L_(XDefaultDecl_))=panic"dupDefaultDeclErr"dupDefaultDeclErr(L_(XDefaultDecl_):_)=panic"dupDefaultDeclErr"dupDefaultDeclErr[]=panic"dupDefaultDeclErr []"badDefaultTy::Type->[Class]->SDocbadDefaultTy ty deflt_clss =hang(text"The default type"<+>quotes(pprty )<+>ptext(sLit"is not an instance of"))2(foldr1(\a b ->a <+>text"or"<+>b )(map(quotes.ppr)deflt_clss ))