X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=821a1cc086112319b5d0662bca8f9c6146d8e852;hb=f83010b119096699d1efef2f7bb45460719c48f9;hp=2b42d0b9e37e9251333880d4ba91599c046f3db6;hpb=f493bc7c7325a3809dda3637c12e5d9383ba8117;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 2b42d0b..821a1cc 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -1601,7 +1601,7 @@ ppr_ty :: TidyEnv -> TcType -> TcType -> TcM (TidyEnv, SDoc, SDoc) ppr_ty env ty other_ty = do { ty' <- zonkTcType ty ; let (env1, tidy_ty) = tidyOpenType env ty' - ; (env2, extra) <- ppr_extra env1 ty' other_ty + ; (env2, extra) <- ppr_extra env1 tidy_ty other_ty ; return (env2, quotes (ppr tidy_ty), extra) } -- (ppr_extra env ty other_ty) shows extra info about 'ty' @@ -1617,16 +1617,23 @@ ppr_extra env (TyConApp tc1 _) (TyConApp tc2 _) -- Could not match 'T' does not match 'M.T' -- which is not helpful do { this_mod <- getModule - ; return (env, quotes (ppr tc1) <+> ptext SLIT("is defined in") <+> mk_mod this_mod) } + ; return (env, quotes (ppr tc1) <+> ptext SLIT("is defined") <+> mk_mod this_mod) } where - tc_mod = nameModule (getName tc1) - tc_pkg = modulePackageId tc_mod + tc_mod = nameModule (getName tc1) + tc_pkg = modulePackageId tc_mod + tc2_pkg = modulePackageId (nameModule (getName tc2)) mk_mod this_mod - | tc_mod == this_mod = ptext SLIT("this module") - | otherwise = ptext SLIT("module") <+> quotes (ppr tc_mod) <+> mk_pkg this_mod - mk_pkg this_mod - | tc_pkg == modulePackageId this_mod = empty - | otherwise = ptext SLIT("from package") <+> quotes (ppr tc_pkg) + | tc_mod == this_mod = ptext SLIT("in this module") + + | not home_pkg && tc2_pkg /= tc_pkg = pp_pkg + -- Suppress the module name if (a) it's from another package + -- (b) other_ty isn't from that same package + + | otherwise = ptext SLIT("in module") <+> quotes (ppr tc_mod) <+> pp_pkg + where + home_pkg = tc_pkg == modulePackageId this_mod + pp_pkg | home_pkg = empty + | otherwise = ptext SLIT("in package") <+> quotes (ppr tc_pkg) ppr_extra env ty other_ty = return (env, empty) -- Normal case