X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnSource.lhs;h=51f9ea37c8b53e20976788ff370567e9203d9af7;hb=d133b73a4d4717892ced072d05e039a54ede0ceb;hp=34966a75e7bc8a5ba76278e4ef20a0f23dc0aa71;hpb=3160f854580e6d8df412c8cd34d93bae27175d67;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index 34966a7..51f9ea3 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/ghc/compiler/rename/RnSource.lhs @@ -13,30 +13,33 @@ import HsSyn import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) ) import HsPragmas import HsTypes ( getTyVarName, pprClassAssertion, cmpHsTypes ) -import RdrHsSyn +import RdrName ( RdrName, isRdrDataCon, rdrNameOcc ) +import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl, + extractHsTyVars + ) import RnHsSyn import HsCore -import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs ) +import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, unknownSigErr ) import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, addImplicitOccRn, bindLocalsRn, - bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvRn, + bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn, checkDupOrQualNames, checkDupNames, newLocallyDefinedGlobalName, newImportedGlobalName, newImportedGlobalFromRdrName, - ifaceFlavour, newDFunName, + newDFunName, FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV ) import RnMonad import Name ( Name, OccName, ExportFlag(..), Provenance(..), - nameOccName, NamedThing(..), isConOcc, + nameOccName, NamedThing(..), mkDefaultMethodOcc, mkDFunOcc ) import NameSet -import BasicTypes ( TopLevelFlag(..), IfaceFlavour(..) ) +import BasicTypes ( TopLevelFlag(..) ) import TysWiredIn ( tupleTyCon, unboxedTupleTyCon, listTyCon ) import Type ( funTyCon ) import FiniteMap ( elemFM ) @@ -45,10 +48,12 @@ import PrelInfo ( derivingOccurrences, numClass_RDR, bindIO_NAME ) import Bag ( bagToList ) +import List ( partition ) import Outputable import SrcLoc ( SrcLoc ) +import CmdLineOpts ( opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars import UniqFM ( lookupUFM ) -import Maybes ( maybeToBool ) +import Maybes ( maybeToBool, catMaybes ) import Util \end{code} @@ -82,8 +87,8 @@ rnSourceDecls decls -- Fixity decls have been dealt with already; ignore them go fvs ds' [] = returnRn (ds', fvs) go fvs ds' (FixD _:ds) = go fvs ds' ds - go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs) -> - go (fvs `plusFV` fvs) (d':ds') ds + go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') -> + go (fvs `plusFV` fvs') (d':ds') ds rnIfaceDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl rnIfaceDecl d @@ -153,7 +158,7 @@ rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragma returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc), cxt_fvs `plusFV` plusFVs con_fvs_s `plusFV` deriv_fvs) where - data_doc = text "the data type declaration for" <+> ppr tycon + data_doc = text "the data type declaration for" <+> quotes (ppr tycon) con_names = map conDeclName condecls rnDecl (TyClD (TySynonym name tyvars ty src_loc)) @@ -188,12 +193,17 @@ rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname sr -- Check the signatures let - -- Filter out fixity signatures; - -- they are done at top level - nofix_sigs = nonFixitySigs sigs + -- First process the class op sigs, then the fixity sigs. + (op_sigs, non_op_sigs) = partition isClassOpSig sigs + (fix_sigs, non_sigs) = partition isFixitySig non_op_sigs + in + checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_` + mapAndUnzipRn (rn_op cname' clas_tyvar_names) op_sigs `thenRn` \ (sigs', sig_fvs_s) -> + mapRn_ (unknownSigErr) non_sigs `thenRn_` + let + binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ] in - checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_` - mapAndUnzipRn (rn_op cname' clas_tyvar_names) nofix_sigs `thenRn` \ (sigs', sig_fvs_s) -> + renameSigs False binders lookupOccRn fix_sigs `thenRn` \ (fixs', fix_fvs) -> -- Check the methods checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_` @@ -205,8 +215,12 @@ rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname sr -- for instance decls. ASSERT(isNoClassPragmas pragmas) - returnRn (TyClD (ClassDecl context' cname' tyvars' sigs' mbinds' NoClassPragmas tname' dname' src_loc), - plusFVs sig_fvs_s `plusFV` cxt_fvs `plusFV` meth_fvs) + returnRn (TyClD (ClassDecl context' cname' tyvars' (fixs' ++ sigs') mbinds' NoClassPragmas tname' dname' src_loc), + plusFVs sig_fvs_s `plusFV` + fix_fvs `plusFV` + cxt_fvs `plusFV` + meth_fvs + ) ) where cls_doc = text "the declaration for class" <+> ppr cname @@ -227,7 +241,7 @@ rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname sr check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs) (classTyVarNotInOpTyErr clas_tyvar sig) in - mapRn check_in_op_ty clas_tyvars `thenRn_` + mapRn_ check_in_op_ty clas_tyvars `thenRn_` -- Make the default-method name let @@ -244,8 +258,8 @@ rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname sr (InterfaceMode _, Just _) -> -- Imported class that has a default method decl - newImportedGlobalName mod_name dm_occ (ifaceFlavour clas) `thenRn` \ dm_name -> - addOccurrenceName dm_name `thenRn_` + newImportedGlobalName mod_name dm_occ `thenRn` \ dm_name -> + addOccurrenceName dm_name `thenRn_` returnRn (Just dm_name) other -> returnRn Nothing @@ -268,12 +282,12 @@ rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc)) rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) -> let inst_tyvars = case inst_ty' of - HsForAllTy inst_tyvars _ _ -> inst_tyvars - other -> [] + HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars + other -> [] -- (Slightly strangely) the forall-d tyvars scope over -- the method bindings too in - extendTyVarEnvRn inst_tyvars $ + extendTyVarEnvFVRn inst_tyvars $ -- Rename the bindings -- NB meth_names can be qualified! @@ -281,16 +295,32 @@ rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc)) rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) -> let binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds'))) + + -- Delete sigs (&report) sigs that aren't allowed inside an + -- instance decl: + -- + -- + type signatures + -- + fixity decls + -- + (ok_sigs, not_ok_idecl_sigs) = partition okInInstDecl uprags + + okInInstDecl (FixSig _) = False + okInInstDecl (Sig _ _ _) = False + okInInstDecl _ = True + in - renameSigs NotTopLevel True binders uprags `thenRn` \ new_uprags -> - mkDFunName inst_ty' maybe_dfun src_loc `thenRn` \ dfun_name -> - addOccurrenceName dfun_name `thenRn_` + -- You can't have fixity decls & type signatures + -- within an instance declaration. + mapRn_ unknownSigErr not_ok_idecl_sigs `thenRn_` + renameSigs False binders lookupOccRn ok_sigs `thenRn` \ (new_uprags, prag_fvs) -> + mkDFunName inst_ty' maybe_dfun src_loc `thenRn` \ dfun_name -> + addOccurrenceName dfun_name `thenRn_` -- The dfun is not optional, because we use its version number -- to identify the version of the instance declaration -- The typechecker checks that all the bindings are for the right class. returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc), - inst_fvs `plusFV` meth_fvs) + inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs) where meth_doc = text "the bindings in an instance declaration" meth_names = bagToList (collectMonoBinders mbinds) @@ -330,8 +360,8 @@ rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc)) addImplicitOccRn deRefStablePtr_NAME `thenRn_` addImplicitOccRn bindIO_NAME `thenRn_` returnRn name' - _ -> returnRn name') `thenRn_` - rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs) -> + _ -> returnRn name') `thenRn_` + rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs) -> returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), fvs) where fo_decl_msg = ptext SLIT("a foreign declaration") @@ -353,7 +383,7 @@ rnDerivs Nothing -- derivs not specified rnDerivs (Just ds) = mapRn rn_deriv ds `thenRn` \ derivs -> - returnRn (Just derivs, mkNameSet derivs) + returnRn (Just derivs, foldl addOneFV emptyFVs derivs) where rn_deriv clas = lookupOccRn clas `thenRn` \ clas_name -> @@ -365,7 +395,7 @@ rnDerivs (Just ds) Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_` returnRn clas_name - Just occs -> mapRn lookupImplicitOccRn occs `thenRn_` + Just occs -> mapRn_ lookupImplicitOccRn occs `thenRn_` returnRn clas_name \end{code} @@ -423,9 +453,13 @@ rnBangTy doc (Banged ty) returnRn (Banged new_ty, fvs) rnBangTy doc (Unbanged ty) - = rnHsType doc ty `thenRn` \ (new_ty, fvs) -> + = rnHsType doc ty `thenRn` \ (new_ty, fvs) -> returnRn (Unbanged new_ty, fvs) +rnBangTy doc (Unpacked ty) + = rnHsType doc ty `thenRn` \ (new_ty, fvs) -> + returnRn (Unpacked new_ty, fvs) + -- This data decl will parse OK -- data T = a Int -- treating "a" as the constructor. @@ -437,7 +471,7 @@ rnBangTy doc (Unbanged ty) -- from interface files, which always print in prefix form checkConName name - = checkRn (isConOcc (rdrNameOcc name)) + = checkRn (isRdrDataCon name) (badDataCon name) \end{code} @@ -492,59 +526,66 @@ rnIfaceType doc ty = rnHsType doc ty `thenRn` \ (ty,_) -> returnRn ty + +rnForAll doc forall_tyvars ctxt ty + = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars -> + rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) -> + rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) -> + returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty, + cxt_fvs `plusFV` ty_fvs) + +-- Check that each constraint mentions at least one of the forall'd type variables +-- Since the forall'd type variables are a subset of the free tyvars +-- of the tau-type part, this guarantees that every constraint mentions +-- at least one of the free tyvars in ty +checkConstraints explicit_forall doc forall_tyvars ctxt ty + = mapRn check ctxt `thenRn` \ maybe_ctxt' -> + returnRn (catMaybes maybe_ctxt') + -- Remove problem ones, to avoid duplicate error message. + where + check ct@(_,tys) + | forall_mentioned = returnRn (Just ct) + | otherwise = addErrRn (ctxtErr explicit_forall doc forall_tyvars ct ty) `thenRn_` + returnRn Nothing + where + forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyVars) + False + tys + + rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars) -rnHsType doc (HsForAllTy [] ctxt ty) +rnHsType doc (HsForAllTy Nothing ctxt ty) -- From source code (no kinds on tyvars) - -- Given the signature C => T we universally quantify -- over FV(T) \ {in-scope-tyvars} - -- - -- We insist that the universally quantified type vars is a superset of FV(C) - -- It follows that FV(T) is a superset of FV(C), so that the context constrains - -- no type variables that don't appear free in the tau-type part. - = getLocalNameEnv `thenRn` \ name_env -> let mentioned_tyvars = extractHsTyVars ty forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_tyvars - - ctxt_w_ftvs :: [((RdrName,[RdrNameHsType]), [RdrName])] - ctxt_w_ftvs = [ (constraint, foldr ((++) . extractHsTyVars) [] tys) - | constraint@(_,tys) <- ctxt] - - -- A 'non-poly constraint' is one that does not mention *any* - -- of the forall'd type variables - non_poly_constraints = filter non_poly ctxt_w_ftvs - non_poly (c,ftvs) = not (any (`elem` forall_tyvars) ftvs) - - -- A 'non-mentioned' constraint is one that mentions a - -- type variable that does not appear in 'ty' - non_mentioned_constraints = filter non_mentioned ctxt_w_ftvs - non_mentioned (c,ftvs) = any (not . (`elem` mentioned_tyvars)) ftvs - - -- Zap the context if there's a problem, to avoid duplicate error message. - ctxt' | null non_poly_constraints && null non_mentioned_constraints = ctxt - | otherwise = [] in - mapRn (ctxtErr1 doc forall_tyvars ty) non_poly_constraints `thenRn_` - mapRn (ctxtErr2 doc ty) non_mentioned_constraints `thenRn_` - - (bindTyVarsFVRn doc (map UserTyVar forall_tyvars) $ \ new_tyvars -> - rnContext doc ctxt' `thenRn` \ (new_ctxt, cxt_fvs) -> - rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) -> - returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty, - cxt_fvs `plusFV` ty_fvs) - ) - -rnHsType doc (HsForAllTy tvs ctxt ty) - -- tvs are non-empty, hence must be from an interface file - -- (tyvars may be kinded) - = bindTyVarsFVRn doc tvs $ \ new_tyvars -> - rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) -> - rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) -> - returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty, - cxt_fvs `plusFV` ty_fvs) + checkConstraints False doc forall_tyvars ctxt ty `thenRn` \ ctxt' -> + rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty + +rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt ty) + -- Explicit quantification. + -- Check that the forall'd tyvars are a subset of the + -- free tyvars in the tau-type part + -- That's only a warning... unless the tyvar is constrained by a + -- context in which case it's an error + = let + mentioned_tyvars = extractHsTyVars ty + constrained_tyvars = [tv | (_,tys) <- ctxt, + ty <- tys, + tv <- extractHsTyVars ty] + dubious_guys = filter (`notElem` mentioned_tyvars) forall_tyvar_names + (bad_guys, warn_guys) = partition (`elem` constrained_tyvars) dubious_guys + forall_tyvar_names = map getTyVarName forall_tyvars + in + mapRn_ (forAllErr doc ty) bad_guys `thenRn_` + mapRn_ (forAllWarn doc ty) warn_guys `thenRn_` + checkConstraints True doc forall_tyvar_names ctxt ty `thenRn` \ ctxt' -> + rnForAll doc forall_tyvars ctxt' ty rnHsType doc (MonoTyVar tyvar) = lookupOccRn tyvar `thenRn` \ tyvar' -> @@ -577,6 +618,10 @@ rnHsType doc (MonoDictTy clas tys) rnHsTypes doc tys `thenRn` \ (tys', fvs) -> returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas') +rnHsType doc (MonoUsgTy usg ty) + = rnHsType doc ty `thenRn` \ (ty', fvs) -> + returnRn (MonoUsgTy usg ty', fvs) + rnHsTypes doc tys = mapAndUnzipRn (rnHsType doc) tys `thenRn` \ (tys, fvs_s) -> returnRn (tys, plusFVs fvs_s) @@ -593,7 +638,7 @@ rnContext doc ctxt in -- Check for duplicate assertions -- If this isn't an error, then it ought to be: - mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_` + mapRn_ (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_` returnRn (theta, plusFVs fvs_s) where @@ -614,9 +659,16 @@ rnContext doc ctxt %********************************************************* \begin{code} -rnIdInfo (HsStrictness strict) - = rnStrict strict `thenRn` \ strict' -> - returnRn (HsStrictness strict') +rnIdInfo (HsStrictness str) = returnRn (HsStrictness str) + +rnIdInfo (HsWorker worker cons) + -- The sole purpose of the "cons" field is so that we can mark the + -- constructors needed to build the wrapper as "needed", so that their + -- data type decl will be slurped in. After that their usefulness is + -- o'er, so we just put in the empty list. + = lookupOccRn worker `thenRn` \ worker' -> + mapRn lookupOccRn cons `thenRn_` + returnRn (HsWorker worker' []) rnIdInfo (HsUnfold inline (Just expr)) = rnCoreExpr expr `thenRn` \ expr' -> returnRn (HsUnfold inline (Just expr')) @@ -624,6 +676,7 @@ rnIdInfo (HsUnfold inline Nothing) = returnRn (HsUnfold inline Nothing) rnIdInfo (HsArity arity) = returnRn (HsArity arity) rnIdInfo (HsUpdate update) = returnRn (HsUpdate update) rnIdInfo (HsNoCafRefs) = returnRn (HsNoCafRefs) +rnIdInfo (HsCprInfo cpr_info) = returnRn (HsCprInfo cpr_info) rnIdInfo (HsSpecialise tyvars tys expr) = bindTyVarsRn doc tyvars $ \ tyvars' -> rnCoreExpr expr `thenRn` \ expr' -> @@ -631,19 +684,6 @@ rnIdInfo (HsSpecialise tyvars tys expr) returnRn (HsSpecialise tyvars' tys' expr') where doc = text "Specialise in interface pragma" - - -rnStrict (HsStrictnessInfo demands (Just (worker,cons))) - -- The sole purpose of the "cons" field is so that we can mark the constructors - -- needed to build the wrapper as "needed", so that their data type decl will be - -- slurped in. After that their usefulness is o'er, so we just put in the empty list. - = lookupOccRn worker `thenRn` \ worker' -> - mapRn lookupOccRn cons `thenRn_` - returnRn (HsStrictnessInfo demands (Just (worker',[]))) - --- Boring, but necessary for the type checker. -rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing) -rnStrict HsBottom = returnRn HsBottom \end{code} UfCore expressions. @@ -674,7 +714,7 @@ rnCoreExpr (UfApp fun arg) rnCoreExpr (UfCase scrut bndr alts) = rnCoreExpr scrut `thenRn` \ scrut' -> - bindLocalsRn "UfCase" [bndr] $ \ [bndr'] -> + bindLocalsRn "a UfCase" [bndr] $ \ [bndr'] -> mapRn rnCoreAlt alts `thenRn` \ alts' -> returnRn (UfCase scrut' bndr' alts') @@ -712,7 +752,7 @@ rnCoreBndr (UfValBinder name ty) thing_inside str = "unfolding id" rnCoreBndr (UfTyBinder name kind) thing_inside - = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] -> + = bindLocalsRn "an unfolding tyvar" [name] $ \ [name'] -> thing_inside (UfTyBinder name' kind) rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders @@ -727,9 +767,9 @@ rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders \begin{code} rnCoreAlt (con, bndrs, rhs) - = rnUfCon con `thenRn` \ con' -> - bindLocalsRn "unfolding alt" bndrs $ \ bndrs' -> - rnCoreExpr rhs `thenRn` \ rhs' -> + = rnUfCon con `thenRn` \ con' -> + bindLocalsRn "an unfolding alt" bndrs $ \ bndrs' -> + rnCoreExpr rhs `thenRn` \ rhs' -> returnRn (con', bndrs', rhs') @@ -759,8 +799,8 @@ rnUfCon (UfPrimOp op) = lookupOccRn op `thenRn` \ op' -> returnRn (UfPrimOp op') -rnUfCon (UfCCallOp str casm gc) - = returnRn (UfCCallOp str casm gc) +rnUfCon (UfCCallOp str is_dyn casm gc) + = returnRn (UfCCallOp str is_dyn casm gc) \end{code} %********************************************************* @@ -783,28 +823,35 @@ dupClassAssertWarn ctxt (assertion : dups) = sep [hsep [ptext SLIT("Duplicate class assertion"), quotes (pprClassAssertion assertion), ptext SLIT("in the context:")], - nest 4 (pprContext ctxt)] + nest 4 (pprContext ctxt <+> ptext SLIT("..."))] badDataCon name = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)] -ctxtErr1 doc tyvars ty (constraint, _) - = addErrRn ( - sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint) <+> - ptext SLIT("does not mention any of"), - nest 4 (ptext SLIT("the universally quantified type variables") <+> braces (interpp'SP tyvars)), - nest 4 (ptext SLIT("of the type") <+> quotes (ppr ty)) - ] +forAllWarn doc ty tyvar + | not opt_WarnUnusedMatches = returnRn () + | otherwise + = addWarnRn ( + sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar), + nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))] $$ - (ptext SLIT("In") <+> doc) - ) + (ptext SLIT("In") <+> doc)) -ctxtErr2 doc ty (constraint,_) +forAllErr doc ty tyvar = addErrRn ( - sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint), - nest 4 (ptext SLIT("mentions type variables that do not appear in the type")), - nest 4 (quotes (ppr ty))] - $$ - (ptext SLIT("In") <+> doc) - ) + sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar), + nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))] + $$ + (ptext SLIT("In") <+> doc)) + +ctxtErr explicit_forall doc tyvars constraint ty + = sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint) <+> + ptext SLIT("does not mention any of"), + if explicit_forall then + nest 4 (ptext SLIT("the universally quantified type variables") <+> braces (interpp'SP tyvars)) + else + nest 4 (ptext SLIT("the type variables in the type") <+> quotes (ppr ty)) + ] + $$ + (ptext SLIT("In") <+> doc) \end{code}