Commit ae41a50f authored by Joachim Breitner's avatar Joachim Breitner

Report all possible results from related name spaces

instead of just one matching directly. This is an alternative way to fix
ticket #9177.
parent 009e86f5
......@@ -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, i.e. variables <-> data construtors and type variables <-> type constructors
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
......
......@@ -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)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment