diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2014-06-06 12:11:48 +0200 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-06-06 12:11:48 +0200 |
commit | 03e03cebead92e7211697a2abde43fd7d8b03b78 (patch) | |
tree | 143b11585742b703a14dce14118da84995b7227d | |
parent | a6735a0dc016cca5de0afb2460f23ae972dfd9b8 (diff) | |
download | haskell-03e03cebead92e7211697a2abde43fd7d8b03b78.tar.gz |
Report all possible results from related name spaces
instead of just one matching directly. This is an alternative way to fix
ticket #9177.
-rw-r--r-- | compiler/basicTypes/OccName.lhs | 24 | ||||
-rw-r--r-- | 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 b1fd831082..3d14daa4ee 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -32,6 +32,8 @@ module OccName ( -- * The 'NameSpace' type NameSpace, -- Abstract + + nameSpacesRelated, -- ** Construction -- $real_vs_source_data_constructors @@ -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 d0c51d3fa5..f333a239a1 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) |