X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Ftypecheck%2FTcBinds.lhs;h=4f81c0dc7ad0472a9147bea6db3ff9979989f826;hb=efa881239effd5ea4cb403c2c03ebb09fbdfd363;hp=6a64ece447fa00b38753e2bceab41ac424273dde;hpb=e1e1d0204ff754def1b3675f539372fd4691d78d;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs index 6a64ece..4f81c0d 100644 --- a/ghc/compiler/typecheck/TcBinds.lhs +++ b/ghc/compiler/typecheck/TcBinds.lhs @@ -4,7 +4,7 @@ \section[TcBinds]{TcBinds} \begin{code} -module TcBinds ( tcBindsAndThen, tcTopBindsAndThen, +module TcBinds ( tcBindsAndThen, tcTopBinds, tcSpecSigs, tcBindWithSigs ) where #include "HsVersions.h" @@ -12,15 +12,17 @@ module TcBinds ( tcBindsAndThen, tcTopBindsAndThen, import {-# SOURCE #-} TcMatches ( tcGRHSs, tcMatchesFun ) import {-# SOURCE #-} TcExpr ( tcExpr ) -import HsSyn ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), InPat(..), StmtCtxt(..), - collectMonoBinders, andMonoBindList, andMonoBinds +import CmdLineOpts ( opt_NoMonomorphismRestriction ) +import HsSyn ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), StmtCtxt(..), + Match(..), collectMonoBinders, andMonoBinds ) import RnHsSyn ( RenamedHsBinds, RenamedSig, RenamedMonoBinds ) -import TcHsSyn ( TcHsBinds, TcMonoBinds, TcId, zonkId, mkHsLet ) +import TcHsSyn ( TcMonoBinds, TcId, zonkId, mkHsLet ) import TcMonad -import Inst ( Inst, LIE, emptyLIE, mkLIE, plusLIE, plusLIEs, InstOrigin(..), +import Inst ( LIE, emptyLIE, mkLIE, plusLIE, InstOrigin(..), newDicts, tyVarsOfInst, instToId, + getAllFunDepsOfLIE, getIPsOfLIE, zonkFunDeps ) import TcEnv ( tcExtendLocalValEnv, newSpecPragmaId, newLocalId, @@ -28,38 +30,37 @@ import TcEnv ( tcExtendLocalValEnv, tcGetGlobalTyVars, tcExtendGlobalTyVars ) import TcSimplify ( tcSimplify, tcSimplifyAndCheck, tcSimplifyToDicts ) -import TcMonoType ( tcHsType, checkSigTyVars, +import TcImprove ( tcImprove ) +import TcMonoType ( tcHsSigType, checkSigTyVars, TcSigInfo(..), tcTySig, maybeSig, sigCtxt ) import TcPat ( tcPat ) import TcSimplify ( bindInstsOfLocalFuns ) -import TcType ( TcType, TcThetaType, - TcTyVar, - newTyVarTy, newTyVar, newTyVarTy_OpenKind, tcInstTcType, - zonkTcType, zonkTcTypes, zonkTcThetaType, zonkTcTyVarToTyVar +import TcType ( TcThetaType, newTyVarTy, newTyVar, + zonkTcTypes, zonkTcThetaType, zonkTcTyVarToTyVar ) import TcUnify ( unifyTauTy, unifyTauTyLists ) -import PrelInfo ( main_NAME, ioTyCon_NAME ) - -import Id ( Id, mkVanillaId, setInlinePragma ) +import CoreFVs ( idFreeTyVars ) +import Id ( mkVanillaId, setInlinePragma ) import Var ( idType, idName ) -import IdInfo ( IdInfo, vanillaIdInfo, setInlinePragInfo, InlinePragInfo(..) ) -import Name ( Name, getName, getOccName, getSrcLoc ) +import IdInfo ( InlinePragInfo(..) ) +import Name ( Name, getOccName, getSrcLoc ) import NameSet import Type ( mkTyVarTy, tyVarsOfTypes, mkTyConApp, - splitSigmaTy, mkForAllTys, mkFunTys, getTyVar, - mkDictTy, splitRhoTy, mkForAllTy, isUnLiftedType, - isUnboxedType, unboxedTypeKind, boxedTypeKind + mkForAllTys, mkFunTys, + mkPredTy, mkForAllTy, isUnLiftedType, + unliftedTypeKind, liftedTypeKind, openTypeKind ) -import Var ( TyVar, tyVarKind ) +import FunDeps ( oclose ) +import Var ( tyVarKind ) import VarSet import Bag import Util ( isIn ) import Maybes ( maybeToBool ) import BasicTypes ( TopLevelFlag(..), RecFlag(..), isNotTopLevel ) import FiniteMap ( listToFM, lookupFM ) -import SrcLoc ( SrcLoc ) +import PrelNames ( ioTyConName, mainKey, hasKey ) import Outputable \end{code} @@ -96,14 +97,22 @@ At the top-level the LIE is sure to contain nothing but constant dictionaries, which we resolve at the module level. \begin{code} -tcTopBindsAndThen, tcBindsAndThen +tcTopBinds :: RenamedHsBinds -> TcM ((TcMonoBinds, TcEnv), LIE) +tcTopBinds binds + = tc_binds_and_then TopLevel glue binds $ + tcGetEnv `thenNF_Tc` \ env -> + returnTc ((EmptyMonoBinds, env), emptyLIE) + where + glue is_rec binds1 (binds2, thing) = (binds1 `AndMonoBinds` binds2, thing) + + +tcBindsAndThen :: (RecFlag -> TcMonoBinds -> thing -> thing) -- Combinator -> RenamedHsBinds - -> TcM s (thing, LIE) - -> TcM s (thing, LIE) + -> TcM (thing, LIE) + -> TcM (thing, LIE) -tcTopBindsAndThen = tc_binds_and_then TopLevel -tcBindsAndThen = tc_binds_and_then NotTopLevel +tcBindsAndThen = tc_binds_and_then NotTopLevel tc_binds_and_then top_lvl combiner EmptyBinds do_next = do_next @@ -133,7 +142,7 @@ tc_binds_and_then top_lvl combiner (MonoBind bind sigs is_rec) do_next -- Create specialisations of functions bound here -- We want to keep non-recursive things non-recursive - -- so that we desugar unboxed bindings correctly + -- so that we desugar unlifted bindings correctly case (top_lvl, is_rec) of -- For the top level don't bother will all this bindInstsOfLocalFuns stuff @@ -183,8 +192,8 @@ examples of this, which is why I thought it worth preserving! [SLPJ] \begin{pseudocode} % tcBindsAndThen % :: RenamedHsBinds -% -> TcM s (thing, LIE, thing_ty)) -% -> TcM s ((TcHsBinds, thing), LIE, thing_ty) +% -> TcM (thing, LIE, thing_ty)) +% -> TcM ((TcHsBinds, thing), LIE, thing_ty) % % tcBindsAndThen EmptyBinds do_next % = do_next `thenTc` \ (thing, lie, thing_ty) -> @@ -224,17 +233,17 @@ tcBindWithSigs -> [TcSigInfo] -> [RenamedSig] -- Used solely to get INLINE, NOINLINE sigs -> RecFlag - -> TcM s (TcMonoBinds, LIE, [TcId]) + -> TcM (TcMonoBinds, LIE, [TcId]) tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec = recoverTc ( -- If typechecking the binds fails, then return with each -- signature-less binder given type (forall a.a), to minimise subsequent -- error messages - newTyVar boxedTypeKind `thenNF_Tc` \ alpha_tv -> + newTyVar liftedTypeKind `thenNF_Tc` \ alpha_tv -> let forall_a_a = mkForAllTy alpha_tv (mkTyVarTy alpha_tv) - binder_names = map fst (bagToList (collectMonoBinders mbind)) + binder_names = collectMonoBinders mbind poly_ids = map mk_dummy binder_names mk_dummy name = case maybeSig tc_ty_sigs name of Just (TySigInfo _ poly_id _ _ _ _ _ _) -> poly_id -- Signature @@ -250,6 +259,18 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec -- (must do this before getTyVarsToGen) checkSigMatch top_lvl binder_names mono_ids tc_ty_sigs `thenTc` \ maybe_sig_theta -> + -- IMPROVE the LIE + -- Force any unifications dictated by functional dependencies. + -- Because unification may happen, it's important that this step + -- come before: + -- - computing vars over which to quantify + -- - zonking the generalized type vars + let lie_avail = case maybe_sig_theta of + Nothing -> emptyLIE + Just (_, la) -> la + lie_avail_req = lie_avail `plusLIE` lie_req in + tcImprove lie_avail_req `thenTc_` + -- COMPUTE VARIABLES OVER WHICH TO QUANTIFY, namely tyvars_to_gen -- The tyvars_not_to_gen are free in the environment, and hence -- candidates for generalisation, but sometimes the monomorphism @@ -260,7 +281,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec getTyVarsToGen is_unrestricted mono_id_tys lie_req `thenNF_Tc` \ (tyvars_not_to_gen, tyvars_to_gen) -> -- Finally, zonk the generalised type variables to real TyVars - -- This commits any unbound kind variables to boxed kind + -- This commits any unbound kind variables to lifted kind -- I'm a little worried that such a kind variable might be -- free in the environment, but I don't think it's possible for -- this to happen when the type variable is not free in the envt @@ -279,8 +300,9 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec -- SIMPLIFY THE LIE tcExtendGlobalTyVars tyvars_not_to_gen ( - if null real_tyvars_to_gen_list then - -- No polymorphism, so no need to simplify context + let ips = getIPsOfLIE lie_avail_req in + if null real_tyvars_to_gen_list && (null ips || not is_unrestricted) then + -- No polymorphism, and no IPs, so no need to simplify context returnTc (lie_req, EmptyMonoBinds, []) else case maybe_sig_theta of @@ -289,7 +311,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec -- NB: no signatures => no polymorphic recursion, so no -- need to use lie_avail (which will be empty anyway) tcSimplify (text "tcBinds1" <+> ppr binder_names) - top_lvl real_tyvars_to_gen lie_req `thenTc` \ (lie_free, dict_binds, lie_bound) -> + real_tyvars_to_gen lie_req `thenTc` \ (lie_free, dict_binds, lie_bound) -> returnTc (lie_free, dict_binds, map instToId (bagToList lie_bound)) Just (sig_theta, lie_avail) -> @@ -340,10 +362,10 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec returnTc () ) `thenTc_` - ASSERT( not (any ((== unboxedTypeKind) . tyVarKind) real_tyvars_to_gen_list) ) + ASSERT( not (any ((== unliftedTypeKind) . tyVarKind) real_tyvars_to_gen_list) ) -- The instCantBeGeneralised stuff in tcSimplify should have -- already raised an error if we're trying to generalise an - -- unboxed tyvar (NB: unboxed tyvars are always introduced + -- unlifted tyvar (NB: unlifted tyvars are always introduced -- along with a class constraint) and it's better done there -- because we have more precise origin information. -- That's why we just use an ASSERT here. @@ -386,17 +408,17 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec -- at all. pat_binders :: [Name] - pat_binders = map fst $ bagToList $ collectMonoBinders $ - (justPatBindings mbind EmptyMonoBinds) + pat_binders = collectMonoBinders (justPatBindings mbind EmptyMonoBinds) in - -- CHECK FOR UNBOXED BINDERS IN PATTERN BINDINGS + -- CHECK FOR UNLIFTED BINDERS IN PATTERN BINDINGS mapTc (\id -> checkTc (not (idName id `elem` pat_binders - && isUnboxedType (idType id))) - (unboxedPatBindErr id)) zonked_mono_ids + && isUnLiftedType (idType id))) + (unliftedPatBindErr id)) zonked_mono_ids `thenTc_` -- BUILD RESULTS returnTc ( + -- pprTrace "binding.." (ppr ((dicts_bound, dict_binds), exports, [idType poly_id | (_, poly_id, _) <- exports])) $ AbsBinds real_tyvars_to_gen_list dicts_bound exports @@ -407,7 +429,8 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec ) where tysig_names = [name | (TySigInfo name _ _ _ _ _ _ _) <- tc_ty_sigs] - is_unrestricted = isUnRestrictedGroup tysig_names mbind + is_unrestricted | opt_NoMonomorphismRestriction = True + | otherwise = isUnRestrictedGroup tysig_names mbind justPatBindings bind@(PatMonoBind _ _ _) binds = bind `andMonoBinds` binds justPatBindings (AndMonoBinds b1 b2) binds = @@ -524,22 +547,33 @@ getTyVarsToGen is_unrestricted mono_id_tys lie = tcGetGlobalTyVars `thenNF_Tc` \ free_tyvars -> zonkTcTypes mono_id_tys `thenNF_Tc` \ zonked_mono_id_tys -> let - tyvars_to_gen = tyVarsOfTypes zonked_mono_id_tys `minusVarSet` free_tyvars + body_tyvars = tyVarsOfTypes zonked_mono_id_tys `minusVarSet` free_tyvars + fds = getAllFunDepsOfLIE lie in if is_unrestricted then - returnNF_Tc (emptyVarSet, tyvars_to_gen) + -- We need to augment the type variables that appear explicitly in + -- the type by those that are determined by the functional dependencies. + -- e.g. suppose our type is C a b => a -> a + -- with the fun-dep a->b + -- Then we should generalise over b too; otherwise it will be + -- reported as ambiguous. + zonkFunDeps fds `thenNF_Tc` \ fds' -> + let + extended_tyvars = oclose fds' body_tyvars + in + returnNF_Tc (emptyVarSet, extended_tyvars) else -- This recover and discard-errs is to avoid duplicate error -- messages; this, after all, is an "extra" call to tcSimplify - recoverNF_Tc (returnNF_Tc (emptyVarSet, tyvars_to_gen)) $ + recoverNF_Tc (returnNF_Tc (emptyVarSet, body_tyvars)) $ discardErrsTc $ - tcSimplify (text "getTVG") NotTopLevel tyvars_to_gen lie `thenTc` \ (_, _, constrained_dicts) -> + tcSimplify (text "getTVG") body_tyvars lie `thenTc` \ (_, _, constrained_dicts) -> let -- ASSERT: dicts_sig is already zonked! constrained_tyvars = foldrBag (unionVarSet . tyVarsOfInst) emptyVarSet constrained_dicts - reduced_tyvars_to_gen = tyvars_to_gen `minusVarSet` constrained_tyvars + reduced_tyvars_to_gen = body_tyvars `minusVarSet` constrained_tyvars in returnTc (constrained_tyvars, reduced_tyvars_to_gen) \end{code} @@ -552,13 +586,16 @@ isUnRestrictedGroup :: [Name] -- Signatures given for these is_elem v vs = isIn "isUnResMono" v vs -isUnRestrictedGroup sigs (PatMonoBind (VarPatIn v) _ _) = v `is_elem` sigs isUnRestrictedGroup sigs (PatMonoBind other _ _) = False isUnRestrictedGroup sigs (VarMonoBind v _) = v `is_elem` sigs -isUnRestrictedGroup sigs (FunMonoBind _ _ _ _) = True +isUnRestrictedGroup sigs (FunMonoBind v _ matches _) = any isUnRestrictedMatch matches || + v `is_elem` sigs isUnRestrictedGroup sigs (AndMonoBinds mb1 mb2) = isUnRestrictedGroup sigs mb1 && isUnRestrictedGroup sigs mb2 isUnRestrictedGroup sigs EmptyMonoBinds = True + +isUnRestrictedMatch (Match _ [] Nothing _) = False -- No args, no signature +isUnRestrictedMatch other = True -- Some args or a signature \end{code} @@ -575,7 +612,7 @@ The signatures have been dealt with already. tcMonoBinds :: RenamedMonoBinds -> [TcSigInfo] -> RecFlag - -> TcM s (TcMonoBinds, + -> TcM (TcMonoBinds, LIE, -- LIE required [Name], -- Bound names [TcId]) -- Corresponding monomorphic bound things @@ -583,7 +620,6 @@ tcMonoBinds :: RenamedMonoBinds tcMonoBinds mbinds tc_ty_sigs is_rec = tc_mb_pats mbinds `thenTc` \ (complete_it, lie_req_pat, tvs, ids, lie_avail) -> let - tv_list = bagToList tvs id_list = bagToList ids (names, mono_ids) = unzip id_list @@ -651,7 +687,7 @@ tcMonoBinds mbinds tc_ty_sigs is_rec lie_avail1 `plusLIE` lie_avail2) tc_mb_pats (FunMonoBind name inf matches locn) - = newTyVarTy boxedTypeKind `thenNF_Tc` \ bndr_ty -> + = newTyVarTy kind `thenNF_Tc` \ bndr_ty -> tc_pat_bndr name bndr_ty `thenTc` \ bndr_id -> let complete_it xve = tcAddSrcLoc locn $ @@ -662,13 +698,7 @@ tcMonoBinds mbinds tc_ty_sigs is_rec tc_mb_pats bind@(PatMonoBind pat grhss locn) = tcAddSrcLoc locn $ - - -- Figure out the appropriate kind for the pattern, - -- and generate a suitable type variable - (case is_rec of - Recursive -> newTyVarTy boxedTypeKind -- Recursive, so no unboxed types - NonRecursive -> newTyVarTy_OpenKind -- Non-recursive, so we permit unboxed types - ) `thenNF_Tc` \ pat_ty -> + newTyVarTy kind `thenNF_Tc` \ pat_ty -> -- Now typecheck the pattern -- We don't support binding fresh type variables in the @@ -689,6 +719,12 @@ tcMonoBinds mbinds tc_ty_sigs is_rec returnTc (PatMonoBind pat' grhss' locn, lie) in returnTc (complete_it, lie_req, tvs, ids, lie_avail) + + -- Figure out the appropriate kind for the pattern, + -- and generate a suitable type variable + kind = case is_rec of + Recursive -> liftedTypeKind -- Recursive, so no unlifted types + NonRecursive -> openTypeKind -- Non-recursive, so we permit unlifted types \end{code} %************************************************************************ @@ -706,12 +742,13 @@ The error message here is somewhat unsatisfactory, but it'll do for now (ToDo). \begin{code} +checkSigMatch :: TopLevelFlag -> [Name] -> [TcId] -> [TcSigInfo] -> TcM (Maybe (TcThetaType, LIE)) checkSigMatch top_lvl binder_names mono_ids sigs | main_bound_here = -- First unify the main_id with IO t, for any old t tcSetErrCtxt mainTyCheckCtxt ( - tcLookupTyCon ioTyCon_NAME `thenTc` \ ioTyCon -> - newTyVarTy boxedTypeKind `thenNF_Tc` \ t_tv -> + tcLookupTyCon ioTyConName `thenTc` \ ioTyCon -> + newTyVarTy liftedTypeKind `thenNF_Tc` \ t_tv -> unifyTauTy ((mkTyConApp ioTyCon [t_tv])) (idType main_mono_id) ) `thenTc_` @@ -724,8 +761,7 @@ checkSigMatch top_lvl binder_names mono_ids sigs -- which is just waht check_one_sig looks for mapTc check_one_sig sigs `thenTc_` mapTc check_main_ctxt sigs `thenTc_` - - returnTc (Just ([], emptyLIE)) + returnTc (Just ([], emptyLIE)) | not (null sigs) = mapTc check_one_sig sigs `thenTc_` @@ -740,7 +776,7 @@ checkSigMatch top_lvl binder_names mono_ids sigs sig1_dict_tys = mk_dict_tys theta1 n_sig1_dict_tys = length sig1_dict_tys - sig_lie = mkLIE [inst | TySigInfo _ _ _ _ _ _ inst _ <- sigs] + sig_lie = mkLIE (concat [insts | TySigInfo _ _ _ _ _ _ insts _ <- sigs]) maybe_main = find_main top_lvl binder_names mono_ids main_bound_here = maybeToBool maybe_main @@ -748,10 +784,10 @@ checkSigMatch top_lvl binder_names mono_ids sigs -- CHECK THAT THE SIGNATURE TYVARS AND TAU_TYPES ARE OK -- Doesn't affect substitution - check_one_sig (TySigInfo _ id sig_tyvars _ sig_tau _ _ src_loc) + check_one_sig (TySigInfo _ id sig_tyvars sig_theta sig_tau _ _ src_loc) = tcAddSrcLoc src_loc $ - tcAddErrCtxtM (sigCtxt (sig_msg id) (idType id)) $ - checkSigTyVars sig_tyvars + tcAddErrCtxtM (sigCtxt (sig_msg id) sig_tyvars sig_theta sig_tau) $ + checkSigTyVars sig_tyvars (idFreeTyVars id) -- CHECK THAT ALL THE SIGNATURE CONTEXTS ARE UNIFIABLE @@ -776,17 +812,16 @@ checkSigMatch top_lvl binder_names mono_ids sigs = tcAddSrcLoc src_loc $ checkTc (null theta) (mainContextsErr id) - mk_dict_tys theta = [mkDictTy c ts | (c,ts) <- theta] + mk_dict_tys theta = map mkPredTy theta - sig_msg id tidy_ty = sep [ptext SLIT("When checking the type signature"), - nest 4 (ppr id <+> dcolon <+> ppr tidy_ty)] + sig_msg id = ptext SLIT("When checking the type signature for") <+> quotes (ppr id) -- Search for Main.main in the binder_names, return corresponding mono_id find_main NotTopLevel binder_names mono_ids = Nothing find_main TopLevel binder_names mono_ids = go binder_names mono_ids go [] [] = Nothing - go (n:ns) (m:ms) | n == main_NAME = Just m - | otherwise = go ns ms + go (n:ns) (m:ms) | n `hasKey` mainKey = Just m + | otherwise = go ns ms \end{code} @@ -832,14 +867,14 @@ a RULE now: {-# SPECIALISE (f:: TcM s (TcMonoBinds, LIE) +tcSpecSigs :: [RenamedSig] -> TcM (TcMonoBinds, LIE) tcSpecSigs (SpecSig name poly_ty src_loc : sigs) = -- SPECIALISE f :: forall b. theta => tau = g tcAddSrcLoc src_loc $ tcAddErrCtxt (valSpecSigCtxt name poly_ty) $ -- Get and instantiate its alleged specialised type - tcHsType poly_ty `thenTc` \ sig_ty -> + tcHsSigType poly_ty `thenTc` \ sig_ty -> -- Check that f has a more general type, and build a RHS for -- the spec-pragma-id at the same time @@ -880,23 +915,8 @@ valSpecSigCtxt v ty nest 4 (ppr v <+> dcolon <+> ppr ty)] ----------------------------------------------- -notAsPolyAsSigErr sig_tau mono_tyvars - = hang (ptext SLIT("A type signature is more polymorphic than the inferred type")) - 4 (vcat [text "Can't for-all the type variable(s)" <+> - pprQuotedList mono_tyvars, - text "in the type" <+> quotes (ppr sig_tau) - ]) - ------------------------------------------------ -badMatchErr sig_ty inferred_ty - = hang (ptext SLIT("Type signature doesn't match inferred type")) - 4 (vcat [hang (ptext SLIT("Signature:")) 4 (ppr sig_ty), - hang (ptext SLIT("Inferred :")) 4 (ppr inferred_ty) - ]) - ------------------------------------------------ -unboxedPatBindErr id - = ptext SLIT("variable in a lazy pattern binding has unboxed type: ") +unliftedPatBindErr id + = ptext SLIT("variable in a lazy pattern binding has unlifted type: ") <+> quotes (ppr id) ----------------------------------------------- @@ -913,18 +933,18 @@ sigContextsCtxt s1 s2 4 (ptext SLIT("(the signature contexts in a mutually recursive group should all be identical)")) mainContextsErr id - | getName id == main_NAME = ptext SLIT("Main.main cannot be overloaded") + | id `hasKey` mainKey = ptext SLIT("Main.main cannot be overloaded") | otherwise = quotes (ppr id) <+> ptext SLIT("cannot be overloaded") <> char ',' <> -- sigh; workaround for cpp's inability to deal ptext SLIT("because it is mutually recursive with Main.main") -- with commas inside SLIT strings. mainTyCheckCtxt - = hsep [ptext SLIT("When checking that"), quotes (ppr main_NAME), + = hsep [ptext SLIT("When checking that"), quotes (ptext SLIT("main")), ptext SLIT("has the required type")] ----------------------------------------------- unliftedBindErr flavour mbind - = hang (text flavour <+> ptext SLIT("bindings for unlifted types aren't allowed")) + = hang (text flavour <+> ptext SLIT("bindings for unlifted types aren't allowed:")) 4 (ppr mbind) existentialExplode mbinds