+ What to do when a lookup fails
+%* *
+%************************************************************************
+
+\begin{code}
+data WhereLooking = WL_Any -- Any binding
+ | WL_Global -- Any top-level binding (local or imported)
+ | WL_LocalTop -- Any top-level binding in this module
+
+unboundName :: WhereLooking -> RdrName -> RnM Name
+unboundName where_look rdr_name
+ = do { show_helpful_errors <- doptM Opt_HelpfulErrors
+ ; let err = unknownNameErr rdr_name
+ ; if not show_helpful_errors
+ then addErr err
+ else do { extra_err <- unknownNameSuggestErr where_look rdr_name
+ ; addErr (err $$ extra_err) }
+
+ ; env <- getGlobalRdrEnv;
+ ; traceRn (vcat [unknownNameErr rdr_name,
+ ptext (sLit "Global envt is:"),
+ nest 3 (pprGlobalRdrEnv env)])
+
+ ; return (mkUnboundName rdr_name) }
+
+unknownNameErr :: RdrName -> SDoc
+unknownNameErr rdr_name
+ = vcat [ hang (ptext (sLit "Not in scope:"))
+ 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
+ <+> quotes (ppr rdr_name))
+ , extra ]
+ where
+ extra | rdr_name == forall_tv_RDR = perhapsForallMsg
+ | otherwise = empty
+
+type HowInScope = Either SrcSpan ImpDeclSpec
+ -- Left loc => locally bound at loc
+ -- Right ispec => imported as specified by ispec
+
+unknownNameSuggestErr :: WhereLooking -> RdrName -> RnM SDoc
+unknownNameSuggestErr where_look tried_rdr_name
+ = do { local_env <- getLocalRdrEnv
+ ; global_env <- getGlobalRdrEnv
+
+ ; let all_possibilities :: [(String, (RdrName, HowInScope))]
+ all_possibilities
+ = [ (showSDoc (ppr r), (r, Left loc))
+ | (r,loc) <- local_possibilities local_env ]
+ ++ [ (showSDoc (ppr r), rp) | (r,rp) <- global_possibilities global_env ]
+
+ suggest = fuzzyLookup (showSDoc (ppr tried_rdr_name)) all_possibilities
+ perhaps = ptext (sLit "Perhaps you meant")
+ extra_err = case suggest of
+ [] -> empty
+ [p] -> perhaps <+> pp_item p
+ ps -> sep [ perhaps <+> ptext (sLit "one of these:")
+ , nest 2 (pprWithCommas pp_item ps) ]
+ ; return extra_err }
+ where
+ pp_item :: (RdrName, HowInScope) -> SDoc
+ pp_item (rdr, Left loc) = quotes (ppr rdr) <+> -- Locally defined
+ parens (ptext (sLit "line") <+> int (srcSpanStartLine loc'))
+ where loc' = case loc of
+ UnhelpfulSpan _ ->
+ panic "unknownNameSuggestErr UnhelpfulSpan"
+ RealSrcSpan l -> l
+ pp_item (rdr, Right is) = quotes (ppr rdr) <+> -- Imported
+ parens (ptext (sLit "imported from") <+> ppr (is_mod is))
+
+ 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
+ && isSymOcc occ == tried_is_sym
+ -- Treat operator and non-operators as non-matching
+ -- This heuristic avoids things like
+ -- Not in scope 'f'; perhaps you meant '+' (from Prelude)
+
+ local_ok = case where_look of { WL_Any -> True; _ -> False }
+ local_possibilities :: LocalRdrEnv -> [(RdrName, SrcSpan)]
+ local_possibilities env
+ | tried_is_qual = []
+ | not local_ok = []
+ | otherwise = [ (mkRdrUnqual occ, nameSrcSpan name)
+ | name <- occEnvElts env
+ , let occ = nameOccName name
+ , correct_name_space occ]
+
+ gre_ok :: GlobalRdrElt -> Bool
+ gre_ok = case where_look of
+ WL_LocalTop -> isLocalGRE
+ _ -> \_ -> True
+
+ global_possibilities :: GlobalRdrEnv -> [(RdrName, (RdrName, HowInScope))]
+ global_possibilities global_env
+ | tried_is_qual = [ (rdr_qual, (rdr_qual, how))
+ | gre <- globalRdrEnvElts global_env
+ , gre_ok gre
+ , let name = gre_name gre
+ occ = nameOccName name
+ , correct_name_space occ
+ , (mod, how) <- quals_in_scope name (gre_prov gre)
+ , let rdr_qual = mkRdrQual mod occ ]
+
+ | otherwise = [ (rdr_unqual, pair)
+ | gre <- globalRdrEnvElts global_env
+ , gre_ok gre
+ , let name = gre_name gre
+ prov = gre_prov gre
+ occ = nameOccName name
+ rdr_unqual = mkRdrUnqual occ
+ , correct_name_space occ
+ , pair <- case (unquals_in_scope name prov, quals_only occ prov) of
+ (how:_, _) -> [ (rdr_unqual, how) ]
+ ([], pr:_) -> [ pr ] -- See Note [Only-quals]
+ ([], []) -> [] ]
+
+ -- Note [Only-quals]
+ -- The second alternative returns those names with the same
+ -- OccName as the one we tried, but live in *qualified* imports
+ -- e.g. if you have:
+ --
+ -- > import qualified Data.Map as Map
+ -- > foo :: Map
+ --
+ -- then we suggest @Map.Map@.
+
+ --------------------
+ unquals_in_scope :: Name -> Provenance -> [HowInScope]
+ unquals_in_scope n LocalDef = [ Left (nameSrcSpan n) ]
+ unquals_in_scope _ (Imported is) = [ Right ispec
+ | i <- is, let ispec = is_decl i
+ , not (is_qual ispec) ]
+
+ --------------------
+ quals_in_scope :: Name -> Provenance -> [(ModuleName, HowInScope)]
+ -- Ones for which the qualified version is in scope
+ quals_in_scope n LocalDef = case nameModule_maybe n of
+ Nothing -> []
+ Just m -> [(moduleName m, Left (nameSrcSpan n))]
+ quals_in_scope _ (Imported is) = [ (is_as ispec, Right ispec)
+ | i <- is, let ispec = is_decl i ]
+
+ --------------------
+ quals_only :: OccName -> Provenance -> [(RdrName, HowInScope)]
+ -- Ones for which *only* the qualified version is in scope
+ quals_only _ LocalDef = []
+ quals_only occ (Imported is) = [ (mkRdrQual (is_as ispec) occ, Right ispec)
+ | i <- is, let ispec = is_decl i, is_qual ispec ]
+\end{code}
+
+%************************************************************************
+%* *
projects / ghc-hetmet.git / blobdiff