diff options
| author | simonpj@microsoft.com <unknown> | 2007-06-29 16:13:37 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2007-06-29 16:13:37 +0000 |
| commit | 283705dacaf9012f7bd189e5b03b79c21a36ee5f (patch) | |
| tree | 84380d7ad8ce329cb60f8861480fa46a68ff0dd5 | |
| parent | f493bc7c7325a3809dda3637c12e5d9383ba8117 (diff) | |
| download | haskell-283705dacaf9012f7bd189e5b03b79c21a36ee5f.tar.gz | |
Refine printing of names in unification mis-match
| -rw-r--r-- | compiler/typecheck/TcUnify.lhs | 23 |
1 files changed, 15 insertions, 8 deletions
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 2b42d0b9e3..c7082cd757 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -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 |