[commit: ghc] wip/T9177: Report all possible results from related name spaces (03e03ce)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T9177
Link       : http://ghc.haskell.org/trac/ghc/changeset/03e03cebead92e7211697a2abde43fd7d8b03b78/ghc

>---------------------------------------------------------------

commit 03e03cebead92e7211697a2abde43fd7d8b03b78
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Jun 6 12:11:48 2014 +0200

    Report all possible results from related name spaces
    
    instead of just one matching directly. This is an alternative way to fix
    ticket #9177.


>---------------------------------------------------------------

03e03cebead92e7211697a2abde43fd7d8b03b78
 compiler/basicTypes/OccName.lhs | 24 +++++++-----------------
 compiler/rename/RnEnv.lhs       | 14 +++++++++-----
 2 files changed, 16 insertions(+), 22 deletions(-)

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index b1fd831..3d14daa 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -33,6 +33,8 @@ module OccName (
 	-- * The 'NameSpace' type
 	NameSpace, -- Abstract
 
+        nameSpacesRelated,
+	
 	-- ** Construction
 	-- $real_vs_source_data_constructors
 	tcName, clsName, tcClsName, dataName, varName, 
@@ -83,8 +85,6 @@ module OccName (
 	
 	isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
 
-        toRelatedNameSpace,
-
 	-- * The 'OccEnv' type
 	OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
 	lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
@@ -372,21 +372,10 @@ demoteOccName (OccName space name) = do
   space' <- demoteNameSpace space
   return $ OccName space' name
 
--- What would this name be if used in the related name space
--- (variables <-> data construtors, type variables <-> type constructors)
-toRelatedNameSpace :: OccName -> Maybe OccName
-toRelatedNameSpace (OccName space name) = OccName (otherNameSpace space) `fmap` name'
-  where
-    name' | name == fsLit "[]"  = Nothing -- Some special cases first
-          | name == fsLit "->"  = Nothing
-          | hd == '('           = Nothing
-          | hd == ':'           = Just tl
-          | startsVarSym hd     = Just (':' `consFS` name)
-          | isUpper hd          = Just (toLower hd `consFS` tl)
-          | isLower hd          = Just (toUpper hd `consFS` tl)
-          | otherwise           = pprTrace "toRelatedNameSpace" (ppr name)
-                                  Nothing
-    (hd,tl) = (headFS name, tailFS name)
+-- Name spaces are related if there is a chance to mean the one when one writes
+-- the other
+nameSpacesRelated :: NameSpace -> NameSpace -> Bool
+nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2
 
 otherNameSpace :: NameSpace -> NameSpace
 otherNameSpace VarName = DataName
@@ -395,6 +384,7 @@ otherNameSpace TvName = TcClsName
 otherNameSpace TcClsName = TvName
 
 
+
 {- | Other names in the compiler add aditional information to an OccName.
 This class provides a consistent way to access the underlying OccName. -}
 class HasOccName name where
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index d0c51d3..f333a23 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -1452,7 +1452,7 @@ unknownNameSuggestErr where_look tried_rdr_name
              all_possibilities
                 =  [ (showPpr dflags r, (r, Left loc))
                    | (r,loc) <- local_possibilities local_env ]
-                ++ [ (showPpr dflags r, rp) | (r,rp) <- global_possibilities global_env ]
+                ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
 
              suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
              perhaps = ptext (sLit "Perhaps you meant")
@@ -1464,21 +1464,25 @@ unknownNameSuggestErr where_look tried_rdr_name
        ; return extra_err }
   where
     pp_item :: (RdrName, HowInScope) -> SDoc
-    pp_item (rdr, Left loc) = quotes (ppr rdr) <+> loc' -- Locally defined
+    pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined
         where loc' = case loc of
                      UnhelpfulSpan l -> parens (ppr l)
                      RealSrcSpan l -> parens (ptext (sLit "line") <+> int (srcSpanStartLine l))
-    pp_item (rdr, Right is) = quotes (ppr rdr) <+>   -- Imported
+    pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+>   -- Imported
                               parens (ptext (sLit "imported from") <+> ppr (is_mod is))
 
+    pp_ns :: RdrName -> SDoc
+    pp_ns rdr | ns /= tried_ns = pprNameSpace ns
+              | otherwise      = empty
+      where ns = rdrNameSpace rdr
+
     tried_occ     = rdrNameOcc tried_rdr_name
     tried_is_sym  = isSymOcc tried_occ
     tried_ns      = occNameSpace tried_occ
     tried_is_qual = isQual tried_rdr_name
 
-    correct_name_space occ =  occNameSpace occ == tried_ns
+    correct_name_space occ =  nameSpacesRelated (occNameSpace occ) tried_ns
                            && isSymOcc occ == tried_is_sym
-                           || toRelatedNameSpace occ == Just tried_occ
         -- Treat operator and non-operators as non-matching
         -- This heuristic avoids things like
         --      Not in scope 'f'; perhaps you meant '+' (from Prelude)