diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-06-03 11:43:53 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-06-03 11:46:17 +0100 |
commit | 7ea156ae3e1c66e59935f0eb877ea1a3f3bfd5b9 (patch) | |
tree | 9fe22f362259b215ab39b527c97558a143118131 /compiler | |
parent | 7b6800c5ab62cb10b3c1b7a85e40c77897cc366f (diff) | |
download | haskell-7ea156ae3e1c66e59935f0eb877ea1a3f3bfd5b9.tar.gz |
Refactor RdrName.Provenance, to fix #7672
Trac #7672 has a data type T in module A that is in scope
*both* locally-bound *and* imported (with a qualified) name.
The Provenance of a GlobalRdrElt simply couldn't express that
before. Now you can.
In doing so, I flattened out Provenance into GlobalRdrElt,
so quite a lot of modules are touched in a not-very-interesting
way.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/basicTypes/RdrName.hs | 283 | ||||
-rw-r--r-- | compiler/deSugar/DsMonad.hs | 2 | ||||
-rw-r--r-- | compiler/iface/IfaceEnv.hs | 8 | ||||
-rw-r--r-- | compiler/main/DynamicLoading.hs | 6 | ||||
-rw-r--r-- | compiler/main/HscTypes.hs | 5 | ||||
-rw-r--r-- | compiler/main/InteractiveEval.hs | 20 | ||||
-rw-r--r-- | compiler/rename/RnEnv.hs | 146 | ||||
-rw-r--r-- | compiler/rename/RnNames.hs | 43 | ||||
-rw-r--r-- | compiler/rename/RnPat.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcCanonical.hs | 10 | ||||
-rw-r--r-- | compiler/typecheck/TcDeriv.hs | 8 | ||||
-rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 11 |
12 files changed, 282 insertions, 262 deletions
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 7764303d2e..b4deeca782 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -51,10 +51,11 @@ module RdrName ( -- * GlobalRdrElts gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE, + greUsedRdrName, greRdrNames, greSrcSpan, greQualModName, -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK, - Provenance(..), pprNameProvenance, + pprNameProvenance, Parent(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), importSpecLoc, importSpecModule, isExplicitItem @@ -411,10 +412,12 @@ type GlobalRdrEnv = OccEnv [GlobalRdrElt] -- | An element of the 'GlobalRdrEnv' data GlobalRdrElt - = GRE { gre_name :: Name, - gre_par :: Parent, - gre_prov :: Provenance -- ^ Why it's in scope - } + = GRE { gre_name :: Name + , gre_par :: Parent + , gre_lcl :: Bool -- ^ True <=> the thing was defined locally + , gre_imp :: [ImportSpec] -- ^ In scope through these imports + } -- INVARIANT: either gre_lcl = True or gre_imp is non-empty + -- See Note [GlobalRdrElt provenance] -- | The children of a Name are the things that are abbreviated by the ".." -- notation in export lists. See Note [Parents] @@ -438,7 +441,32 @@ hasParent n (ParentIs n') #endif hasParent n _ = ParentIs n -{- +{- Note [GlobalRdrElt provenance] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance", +i.e. how the Name came to be in scope. It can be in scope two ways: + - gre_lcl = True: it is bound in this module + - gre_imp: a list of all the imports that brought it into scope + +It's an INVARIANT that you have one or the other; that is, either +gre_lcl is Ture, or gre_imp is non-empty. + +It is just possible to have *both* if there is a module loop: a Name +is defined locally in A, and also brought into scope by importing a +module that SOURCE-imported A. Exapmle (Trac #7672): + + A.hs-boot module A where + data T + + B.hs module B(Decl.T) where + import {-# SOURCE #-} qualified A as Decl + + A.hs module A where + import qualified B + data T = Z | S B.T + +In A.hs, 'T' is locally bound, *and* imported as B.T. + Note [Parents] ~~~~~~~~~~~~~~~~~ Parent Children @@ -481,22 +509,72 @@ That's why plusParent picks the "best" case. -} -- | make a 'GlobalRdrEnv' where all the elements point to the same --- Provenance (useful for "hiding" imports, or imports with --- no details). -gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt] +-- Provenance (useful for "hiding" imports, or imports with no details). +gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt] +-- prov = Nothing => locally bound +-- Just spec => imported as described by spec gresFromAvails prov avails = concatMap (gresFromAvail (const prov)) avails -gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt] -gresFromAvail prov_fn avail - = [ GRE {gre_name = n, - gre_par = mkParent n avail, - gre_prov = prov_fn n} - | n <- availNames avail ] - localGREsFromAvail :: AvailInfo -> [GlobalRdrElt] -- Turn an Avail into a list of LocalDef GlobalRdrElts -localGREsFromAvail = gresFromAvail (const LocalDef) +localGREsFromAvail = gresFromAvail (const Nothing) + +gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt] +gresFromAvail prov_fn avail + = map mk_gre (availNames avail) + where + mk_gre n + = case prov_fn n of -- Nothing => bound locally + -- Just is => imported from 'is' + Nothing -> GRE { gre_name = n, gre_par = mkParent n avail + , gre_lcl = True, gre_imp = [] } + Just is -> GRE { gre_name = n, gre_par = mkParent n avail + , gre_lcl = False, gre_imp = [is] } + +greQualModName :: GlobalRdrElt -> ModuleName +-- Get a suitable module qualifier for the GRE +-- (used in mkPrintUnqualified) +-- Prerecondition: the gre_name is always External +greQualModName gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss }) + | lcl, Just mod <- nameModule_maybe name = moduleName mod + | (is:_) <- iss = is_as (is_decl is) + | otherwise = pprPanic "greQualModName" (ppr gre) + +greUsedRdrName :: GlobalRdrElt -> RdrName +-- For imported things, return a RdrName to add to the +-- used-RdrName set, which is used to generate +-- unused-import-decl warnings +-- Return an Unqual if possible, otherwise any Qual +greUsedRdrName GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss } + | lcl = Unqual occ + | not (all (is_qual . is_decl) iss) = Unqual occ + | (is:_) <- iss = Qual (is_as (is_decl is)) occ + | otherwise = pprPanic "greRdrName" (ppr name) + where + occ = nameOccName name + +greRdrNames :: GlobalRdrElt -> [RdrName] +greRdrNames GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss } + = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss) + where + occ = nameOccName name + unqual = Unqual occ + do_spec decl_spec + | is_qual decl_spec = [qual] + | otherwise = [unqual,qual] + where qual = Qual (is_as decl_spec) occ + +-- the SrcSpan that pprNameProvenance prints out depends on whether +-- the Name is defined locally or not: for a local definition the +-- definition site is used, otherwise the location of the import +-- declaration. We want to sort the export locations in +-- exportClashErr by this SrcSpan, we need to extract it: +greSrcSpan :: GlobalRdrElt -> SrcSpan +greSrcSpan gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss } ) + | lcl = nameSrcSpan name + | (is:_) <- iss = is_dloc (is_decl is) + | otherwise = pprPanic "greSrcSpan" (ppr gre) mkParent :: Name -> AvailInfo -> Parent mkParent _ (Avail _) = NoParent @@ -543,7 +621,6 @@ lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt] lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of Nothing -> [] Just gres -> gres - lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt] lookupGRE_RdrName rdr_name env = case lookupOccEnv env (rdrNameOcc rdr_name) of @@ -560,19 +637,20 @@ getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]] -- Nothing means "the unqualified version is in scope" -- [] means the thing is not in scope at all getGRE_NameQualifier_maybes env - = map (qualifier_maybe . gre_prov) . lookupGRE_Name env + = map (qualifier_maybe) . lookupGRE_Name env where - qualifier_maybe LocalDef = Nothing - qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss + qualifier_maybe (GRE { gre_lcl = lcl, gre_imp = iss }) + | lcl = Nothing + | otherwise = Just $ map (is_as . is_decl) iss isLocalGRE :: GlobalRdrElt -> Bool -isLocalGRE (GRE {gre_prov = LocalDef}) = True -isLocalGRE _ = False +isLocalGRE (GRE {gre_lcl = lcl }) = lcl unQualOK :: GlobalRdrElt -> Bool -- ^ Test if an unqualifed version of this thing would be in scope -unQualOK (GRE {gre_prov = LocalDef}) = True -unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is +unQualOK (GRE {gre_lcl = lcl, gre_imp = iss }) + | lcl = True + | otherwise = any unQualSpecOK iss pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt] -- ^ Take a list of GREs which have the right OccName @@ -593,7 +671,8 @@ pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt] -- The export of @f@ is ambiguous because it's in scope from the local def -- and the import. The lookup of @Unqual f@ should return a GRE for -- the locally-defined @f@, and a GRE for the imported @f@, with a /single/ --- provenance, namely the one for @Baz(f)@. +-- provenance, namely the one for @Baz(f)@, so that the "ambiguous occurrence" +-- message mentions the correct candidates pickGREs rdr_name gres = ASSERT2( isSrcRdrName rdr_name, ppr rdr_name ) mapMaybe pick gres @@ -602,28 +681,28 @@ pickGREs rdr_name gres rdr_is_qual = isQual_maybe rdr_name pick :: GlobalRdrElt -> Maybe GlobalRdrElt - pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) -- Local def - | rdr_is_unqual = Just gre - | Just (mod,_) <- rdr_is_qual -- Qualified name - , Just n_mod <- nameModule_maybe n -- Binder is External - , mod == moduleName n_mod = Just gre - | otherwise = Nothing - pick gre@(GRE {gre_prov = Imported [is]}) -- Single import (efficiency) - | rdr_is_unqual, - not (is_qual (is_decl is)) = Just gre - | Just (mod,_) <- rdr_is_qual, - mod == is_as (is_decl is) = Just gre - | otherwise = Nothing - pick gre@(GRE {gre_prov = Imported is}) -- Multiple import - | null filtered_is = Nothing - | otherwise = Just (gre {gre_prov = Imported filtered_is}) + pick gre@(GRE { gre_name = n, gre_lcl = lcl, gre_imp = iss }) + | not lcl' && null iss' + = Nothing + + | otherwise + = Just (gre { gre_lcl = lcl', gre_imp = iss' }) + where - filtered_is | rdr_is_unqual - = filter (not . is_qual . is_decl) is - | Just (mod,_) <- rdr_is_qual - = filter ((== mod) . is_as . is_decl) is - | otherwise - = [] + lcl' | not lcl = False + | rdr_is_unqual = True + | Just (mod,_) <- rdr_is_qual -- Qualified name + , Just n_mod <- nameModule_maybe n -- Binder is External + = mod == moduleName n_mod + | otherwise + = False + + iss' | rdr_is_unqual + = filter (not . is_qual . is_decl) iss + | Just (mod,_) <- rdr_is_qual + = filter ((== mod) . is_as . is_decl) iss + | otherwise + = [] -- Building GlobalRdrEnvs @@ -649,9 +728,10 @@ insertGRE new_g (old_g : old_gs) plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt -- Used when the gre_name fields match plusGRE g1 g2 - = GRE { gre_name = gre_name g1, - gre_prov = gre_prov g1 `plusProv` gre_prov g2, - gre_par = gre_par g1 `plusParent` gre_par g2 } + = GRE { gre_name = gre_name g1 + , gre_lcl = gre_lcl g1 || gre_lcl g2 + , gre_imp = gre_imp g1 ++ gre_imp g2 + , gre_par = gre_par g1 `plusParent` gre_par g2 } transformGREs :: (GlobalRdrElt -> GlobalRdrElt) -> [OccName] @@ -718,7 +798,7 @@ There are two reasons for shadowing: -} shadowName :: GlobalRdrEnv -> Name -> GlobalRdrEnv --- Remove certain old LocalDef GREs that share the same OccName as this new Name. +-- Remove certain old GREs that share the same OccName as this new Name. -- See Note [GlobalRdrEnv shadowing] for details shadowName env name = alterOccEnv (fmap alter_fn) env (nameOccName name) @@ -727,21 +807,25 @@ shadowName env name alter_fn gres = mapMaybe (shadow_with name) gres shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt - shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef }) + shadow_with new_name + old_gre@(GRE { gre_name = old_name, gre_lcl = lcl, gre_imp = iss }) = case nameModule_maybe old_name of - Nothing -> Just old_gre + Nothing -> Just old_gre -- Old name is Internal; do not shadow Just old_mod | Just new_mod <- nameModule_maybe new_name - , new_mod == old_mod + , new_mod == old_mod -- Old name same as new name; shadow completely -> Nothing + + | null iss' -- Nothing remains + -> Nothing + | otherwise - -> Just (old_gre { gre_prov = Imported [mk_fake_imp_spec old_name old_mod] }) + -> Just (old_gre { gre_lcl = False, gre_imp = iss' }) - shadow_with new_name old_gre@(GRE { gre_prov = Imported imp_specs }) - | null imp_specs' = Nothing - | otherwise = Just (old_gre { gre_prov = Imported imp_specs' }) - where - imp_specs' = mapMaybe (shadow_is new_name) imp_specs + where + iss' = lcl_imp ++ mapMaybe (shadow_is new_name) iss + lcl_imp | lcl = [mk_fake_imp_spec old_name old_mod] + | otherwise = [] mk_fake_imp_spec old_name old_mod -- Urgh! = ImpSpec id_spec ImpAll @@ -769,15 +853,8 @@ shadowName env name ************************************************************************ -} --- | The 'Provenance' of something says how it came to be in scope. +-- | The 'ImportSpec' of something says how it came to be imported -- It's quite elaborate so that we can give accurate unused-name warnings. -data Provenance - = LocalDef -- ^ The thing was defined locally - | Imported - [ImportSpec] -- ^ The thing was imported. - -- - -- INVARIANT: the list of 'ImportSpec' is non-empty - data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec, is_item :: ImpItemSpec } deriving( Eq, Ord ) @@ -815,6 +892,19 @@ data ImpItemSpec -- Here the constructors of @T@ are not named explicitly; -- only @T@ is named explicitly. +instance Eq ImpDeclSpec where + p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False + +instance Ord ImpDeclSpec where + compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` + (is_dloc is1 `compare` is_dloc is2) + +instance Eq ImpItemSpec where + p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False + +instance Ord ImpItemSpec where + compare is1 is2 = is_iloc is1 `compare` is_iloc is2 + unQualSpecOK :: ImportSpec -> Bool -- ^ Is in scope unqualified? unQualSpecOK is = not (is_qual (is_decl is)) @@ -834,55 +924,34 @@ isExplicitItem :: ImpItemSpec -> Bool isExplicitItem ImpAll = False isExplicitItem (ImpSome {is_explicit = exp}) = exp +{- -- Note [Comparing provenance] -- Comparison of provenance is just used for grouping -- error messages (in RnEnv.warnUnusedBinds) instance Eq Provenance where p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False -instance Eq ImpDeclSpec where - p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False - -instance Eq ImpItemSpec where - p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False - instance Ord Provenance where - compare LocalDef LocalDef = EQ - compare LocalDef (Imported _) = LT - compare (Imported _ ) LocalDef = GT - compare (Imported is1) (Imported is2) = compare (head is1) - {- See Note [Comparing provenance] -} (head is2) - -instance Ord ImpDeclSpec where - compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` - (is_dloc is1 `compare` is_dloc is2) - -instance Ord ImpItemSpec where - compare is1 is2 = is_iloc is1 `compare` is_iloc is2 - -plusProv :: Provenance -> Provenance -> Provenance --- Choose LocalDef over Imported --- There is an obscure bug lurking here; in the presence --- of recursive modules, something can be imported *and* locally --- defined, and one might refer to it with a qualified name from --- the import -- but I'm going to ignore that because it makes --- the isLocalGRE predicate so much nicer this way -plusProv LocalDef LocalDef = panic "plusProv" -plusProv LocalDef _ = LocalDef -plusProv _ LocalDef = LocalDef -plusProv (Imported is1) (Imported is2) = Imported (is1++is2) + compare (Prov l1 i1) (Prov l2 i2) + = (l1 `compare` l2) `thenCmp` (i1 `cmp_is` i2) + where -- See Note [Comparing provenance] + [] `cmp_is` [] = EQ + [] `cmp_is` _ = LT + (_:_) `cmp_is` [] = GT + (i1:_) `cmp_is` (i2:_) = i1 `compare` i2 +-} pprNameProvenance :: GlobalRdrElt -> SDoc --- ^ Print out the place where the name was imported -pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef}) - = ptext (sLit "defined at") <+> ppr (nameSrcLoc name) -pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys}) - = case whys of - (why:_) | opt_PprStyle_Debug -> vcat (map pp_why whys) - | otherwise -> pp_why why - [] -> panic "pprNameProvenance" +-- ^ Print out one place where the name was define/imported +-- (With -dppr-debug, print them all) +pprNameProvenance (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss }) + | opt_PprStyle_Debug = vcat pp_provs + | otherwise = head pp_provs where - pp_why why = sep [ppr why, ppr_defn_site why name] + pp_provs = pp_lcl ++ map pp_is iss + pp_lcl = if lcl then [ptext (sLit "defined at") <+> ppr (nameSrcLoc name)] + else [] + pp_is is = sep [ppr is, ppr_defn_site is name] -- If we know the exact definition point (which we may do with GHCi) -- then show that too. But not if it's just "imported from X". diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index ee5c6e9569..ad6a6b1d7b 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -258,7 +258,7 @@ loadModule doc mod Succeeded iface -> return $ mkGlobalRdrEnv . gresFromAvails prov . mi_exports $ iface } } where - prov = Imported [ImpSpec { is_decl = imp_spec, is_item = ImpAll }] + prov = Just (ImpSpec { is_decl = imp_spec, is_item = ImpAll }) imp_spec = ImpDeclSpec { is_mod = name, is_qual = True, is_dloc = wiredInSrcSpan, is_as = name } name = moduleName mod diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs index 0a13fc468c..1bd931674f 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/iface/IfaceEnv.hs @@ -73,9 +73,11 @@ newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name newGlobalBinder mod occ loc = do { mod `seq` occ `seq` return () -- See notes with lookupOrig --- ; traceIf (text "newGlobalBinder" <+> ppr mod <+> ppr occ <+> ppr loc) - ; updNameCacheTcRn $ \name_cache -> - allocateGlobalBinder name_cache mod occ loc } + ; name <- updNameCacheTcRn $ \name_cache -> + allocateGlobalBinder name_cache mod occ loc + ; traceIf (text "newGlobalBinder" <+> + (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name])) + ; return name } newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name -- Works in the IO monad, and gets the Module diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index 546cc6879c..3b62717a9c 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -27,7 +27,7 @@ import SrcLoc ( noSrcSpan ) import Finder ( findImportedModule, cannotFindModule ) import TcRnMonad ( initTcInteractive, initIfaceTcRn ) import LoadIface ( loadPluginInterface ) -import RdrName ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(..) +import RdrName ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , gre_name, mkRdrQual ) import OccName ( mkVarOcc ) @@ -221,8 +221,8 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do -- Try and find the required name in the exports let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name , is_qual = False, is_dloc = noSrcSpan } - provenance = Imported [ImpSpec decl_spec ImpAll] - env = mkGlobalRdrEnv (gresFromAvails provenance (mi_exports iface)) + imp_spec = ImpSpec decl_spec ImpAll + env = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) (mi_exports iface)) case lookupGRE_RdrName rdr_name env of [gre] -> return (Just (gre_name gre)) [] -> return Nothing diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 1d33c4fb9c..f834e17e0c 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1575,7 +1575,7 @@ mkPrintUnqualified dflags env = QueryQualify qual_name -- the right one, then we can use the unqualified name | [gre] <- qual_gres - = NameQual (get_qual_mod (gre_prov gre)) + = NameQual (greQualModName gre) | null qual_gres = if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env) @@ -1591,9 +1591,6 @@ mkPrintUnqualified dflags env = QueryQualify qual_name unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env qual_gres = filter right_name (lookupGlobalRdrEnv env occ) - get_qual_mod LocalDef = moduleName mod - get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is)) - -- we can mention a module P:M without the P: qualifier iff -- "import M" would resolve unambiguously to P:M. (if P is the -- current package we can just assume it is unqualified). diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index f96f4b9af1..122d565289 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -895,11 +895,11 @@ findGlobalRdrEnv hsc_env imports availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv availsToGlobalRdrEnv mod_name avails - = mkGlobalRdrEnv (gresFromAvails imp_prov avails) + = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails) where -- We're building a GlobalRdrEnv as if the user imported -- all the specified modules into the global interactive module - imp_prov = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}] + imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, is_qual = False, is_dloc = srcLocSpan interactiveSrcLoc } @@ -972,24 +972,10 @@ getRdrNamesInScope = withSession $ \hsc_env -> do let ic = hsc_IC hsc_env gbl_rdrenv = ic_rn_gbl_env ic - gbl_names = concatMap greToRdrNames $ globalRdrEnvElts gbl_rdrenv + gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv return gbl_names --- ToDo: move to RdrName -greToRdrNames :: GlobalRdrElt -> [RdrName] -greToRdrNames GRE{ gre_name = name, gre_prov = prov } - = case prov of - LocalDef -> [unqual] - Imported specs -> concat (map do_spec (map is_decl specs)) - where - occ = nameOccName name - unqual = Unqual occ - do_spec decl_spec - | is_qual decl_spec = [qual] - | otherwise = [unqual,qual] - where qual = Qual (is_as decl_spec) occ - -- | Parses a string as an identifier, and returns the list of 'Name's that -- the identifier can refer to in the current interactive context. parseName :: GhcMonad m => String -> m [Name] diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index d80e970f94..2d6cadf99e 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -21,7 +21,6 @@ module RnEnv ( lookupFixityRn, lookupTyFixityRn, lookupInstDeclBndr, lookupSubBndrOcc, lookupFamInstName, - greRdrName, lookupSubBndrGREs, lookupConstructorFields, lookupSyntaxName, lookupSyntaxNames, lookupIfThenElse, lookupGreAvailRn, @@ -228,6 +227,7 @@ newTopSrcBinder (L loc rdr_name) Nothing -> -- Normal case do { this_mod <- getModule + ; traceRn (text "newTopSrcBinder" <+> (ppr this_mod $$ ppr rdr_name $$ ppr loc)) ; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } } {- @@ -490,26 +490,7 @@ lookupSubBndrOcc warnIfDeprec parent doc rdr_name -- Note [Usage for sub-bndrs] used_rdr_name gre | isQual rdr_name = rdr_name - | otherwise = greRdrName gre - -greRdrName :: GlobalRdrElt -> RdrName -greRdrName gre - = case gre_prov gre of - LocalDef -> unqual_rdr - Imported is -> used_rdr_name_from_is is - - where - occ = nameOccName (gre_name gre) - unqual_rdr = mkRdrUnqual occ - - used_rdr_name_from_is imp_specs -- rdr_name is unqualified - | not (all (is_qual . is_decl) imp_specs) - = unqual_rdr -- An unqualified import is available - | otherwise - = -- Only qualified imports available, so make up - -- a suitable qualifed name from the first imp_spec - ASSERT( not (null imp_specs) ) - mkRdrQual (is_as (is_decl (head imp_specs))) occ + | otherwise = greUsedRdrName gre lookupSubBndrGREs :: GlobalRdrEnv -> Parent -> RdrName -> [GlobalRdrElt] -- If Parent = NoParent, just do a normal lookup @@ -912,13 +893,14 @@ Note [Handling of deprecations] addUsedRdrName :: Bool -> GlobalRdrElt -> RdrName -> RnM () -- Record usage of imported RdrNames -addUsedRdrName warnIfDeprec gre rdr - | isLocalGRE gre = return () -- No call to warnIfDeprecated - -- See Note [Handling of deprecations] - | otherwise = do { env <- getGblEnv - ; when warnIfDeprec $ warnIfDeprecated gre - ; updMutVar (tcg_used_rdrnames env) - (\s -> Set.insert rdr s) } +addUsedRdrName warn_if_deprec gre rdr + = do { unless (isLocalGRE gre) $ + do { env <- getGblEnv + ; updMutVar (tcg_used_rdrnames env) + (\s -> Set.insert rdr s) } + + ; when warn_if_deprec $ + warnIfDeprecated gre } addUsedRdrNames :: [RdrName] -> RnM () -- Record used sub-binders @@ -931,29 +913,34 @@ addUsedRdrNames rdrs (\s -> foldr Set.insert s rdrs) } warnIfDeprecated :: GlobalRdrElt -> RnM () -warnIfDeprecated gre@(GRE { gre_name = name, gre_prov = Imported (imp_spec : _) }) +warnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss }) + | (imp_spec : _) <- iss = do { dflags <- getDynFlags - ; when (wopt Opt_WarnWarningsDeprecations dflags) $ + ; this_mod <- getModule + ; when (wopt Opt_WarnWarningsDeprecations dflags && + not (nameIsLocalOrFrom this_mod name)) $ + -- See Note [Handling of deprecations] do { iface <- loadInterfaceForName doc name ; case lookupImpDeprec iface gre of - Just txt -> addWarn (mk_msg txt) + Just txt -> addWarn (mk_msg imp_spec txt) Nothing -> return () } } + | otherwise + = return () where - mk_msg txt = sep [ sep [ ptext (sLit "In the use of") - <+> pprNonVarNameSpace (occNameSpace (nameOccName name)) - <+> quotes (ppr name) - , parens imp_msg <> colon ] - , ppr txt ] - name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name - imp_mod = importSpecModule imp_spec - imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra - extra | imp_mod == moduleName name_mod = Outputable.empty - | otherwise = ptext (sLit ", but defined in") <+> ppr name_mod - doc = ptext (sLit "The name") <+> quotes (ppr name) <+> ptext (sLit "is mentioned explicitly") -warnIfDeprecated _ = return () -- No deprecations for things defined locally + mk_msg imp_spec txt + = sep [ sep [ ptext (sLit "In the use of") + <+> pprNonVarNameSpace (occNameSpace (nameOccName name)) + <+> quotes (ppr name) + , parens imp_msg <> colon ] + , ppr txt ] + where + imp_mod = importSpecModule imp_spec + imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra + extra | imp_mod == moduleName name_mod = Outputable.empty + | otherwise = ptext (sLit ", but defined in") <+> ppr name_mod lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt lookupImpDeprec iface gre @@ -1670,18 +1657,17 @@ unknownNameSuggestErr where_look tried_rdr_name , let name = gre_name gre occ = nameOccName name , correct_name_space occ - , (mod, how) <- quals_in_scope name (gre_prov gre) + , (mod, how) <- quals_in_scope 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 + , pair <- case (unquals_in_scope gre, quals_only gre) of (how:_, _) -> [ (rdr_unqual, how) ] ([], pr:_) -> [ pr ] -- See Note [Only-quals] ([], []) -> [] ] @@ -1697,27 +1683,29 @@ unknownNameSuggestErr where_look tried_rdr_name -- 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) ] + unquals_in_scope :: GlobalRdrElt -> [HowInScope] + unquals_in_scope (GRE { gre_name = n, gre_lcl = lcl, gre_imp = is }) + | lcl = [ Left (nameSrcSpan n) ] + | otherwise = [ Right ispec + | i <- is, let ispec = is_decl i + , not (is_qual ispec) ] -------------------- - quals_in_scope :: Name -> Provenance -> [(ModuleName, HowInScope)] + quals_in_scope :: GlobalRdrElt -> [(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_in_scope (GRE { gre_name = n, gre_lcl = lcl, gre_imp = is }) + | lcl = case nameModule_maybe n of + Nothing -> [] + Just m -> [(moduleName m, Left (nameSrcSpan n))] + | otherwise = [ (is_as ispec, Right ispec) + | i <- is, let ispec = is_decl i ] -------------------- - quals_only :: OccName -> Provenance -> [(RdrName, HowInScope)] + quals_only :: GlobalRdrElt -> [(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 ] + quals_only (GRE { gre_name = n, gre_imp = is }) + = [ (mkRdrQual (is_as ispec) (nameOccName n), Right ispec) + | i <- is, let ispec = is_decl i, is_qual ispec ] {- ************************************************************************ @@ -1789,30 +1777,21 @@ check_unused flag bound_names used_names ------------------------- -- Helpers warnUnusedGREs :: [GlobalRdrElt] -> RnM () -warnUnusedGREs gres - = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres] +warnUnusedGREs gres = mapM_ warnUnusedGRE gres warnUnusedLocals :: [Name] -> RnM () -warnUnusedLocals names - = warnUnusedBinds [(n,LocalDef) | n<-names] - -warnUnusedBinds :: [(Name,Provenance)] -> RnM () -warnUnusedBinds names = mapM_ warnUnusedName (filter reportable names) - where reportable (name,_) - | isWiredInName name = False -- Don't report unused wired-in names - -- Otherwise we get a zillion warnings - -- from Data.Tuple - | otherwise = not (startsWithUnderscore (nameOccName name)) +warnUnusedLocals names = mapM_ warnUnusedLocal names -------------------------- - -warnUnusedName :: (Name, Provenance) -> RnM () -warnUnusedName (name, LocalDef) - = addUnusedWarning name (nameSrcSpan name) +warnUnusedLocal :: Name -> RnM () +warnUnusedLocal name + = when (reportable name) $ + addUnusedWarning name (nameSrcSpan name) (ptext (sLit "Defined but not used")) -warnUnusedName (name, Imported is) - = mapM_ warn is +warnUnusedGRE :: GlobalRdrElt -> RnM () +warnUnusedGRE (GRE { gre_name = name, gre_lcl = lcl, gre_imp = is }) + | lcl = warnUnusedLocal name + | otherwise = when (reportable name) (mapM_ warn is) where warn spec = addUnusedWarning name span msg where @@ -1820,6 +1799,13 @@ warnUnusedName (name, Imported is) pp_mod = quotes (ppr (importSpecModule spec)) msg = ptext (sLit "Imported from") <+> pp_mod <+> ptext (sLit "but not used") +reportable :: Name -> Bool +reportable name + | isWiredInName name = False -- Don't report unused wired-in names + -- Otherwise we get a zillion warnings + -- from Data.Tuple + | otherwise = not (startsWithUnderscore (nameOccName name)) + addUnusedWarning :: Name -> SrcSpan -> SDoc -> RnM () addUnusedWarning name span msg = addWarnAt span $ diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 11f8e61063..872f4ffa7c 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -668,9 +668,9 @@ filterImports -> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names [GlobalRdrElt]) -- Same again, but in GRE form filterImports iface decl_spec Nothing - = return (Nothing, gresFromAvails prov (concatMap mi_exports iface)) + = return (Nothing, gresFromAvails (Just imp_spec) (concatMap mi_exports iface)) where - prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }] + imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } filterImports ifaces decl_spec (Just (want_hiding, L l import_items)) @@ -685,9 +685,9 @@ filterImports ifaces decl_spec (Just (want_hiding, L l import_items)) names = availsToNameSet (map snd items2) keep n = not (n `elemNameSet` names) pruned_avails = filterAvails keep all_avails - hiding_prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }] + hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } - gres | want_hiding = gresFromAvails hiding_prov pruned_avails + gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails | otherwise = concatMap (gresFromIE decl_spec) items2 return (Just (want_hiding, L l (map fst items2)), gres) @@ -917,10 +917,10 @@ gresFromIE decl_spec (L loc ie, avail) is_explicit = case ie of IEThingAll (L _ name) -> \n -> n == name _ -> \_ -> True - prov_fn name = Imported [imp_spec] - where - imp_spec = ImpSpec { is_decl = decl_spec, is_item = item_spec } - item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc } + prov_fn name + = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec }) + where + item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc } mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name] mkChildEnv gres = foldr add emptyNameEnv gres @@ -1221,7 +1221,8 @@ isDoc _ = False ------------------------------- isModuleExported :: Bool -> ModuleName -> GlobalRdrElt -> Bool -- True if the thing is in scope *both* unqualified, *and* with qualifier M -isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov }) +isModuleExported implicit_prelude mod + (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss }) | implicit_prelude && isBuiltInSyntax name = False -- Optimisation: filter out names for built-in syntax -- They just clutter up the environment (esp tuples), and the parser @@ -1233,11 +1234,10 @@ isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov }) -- It's worth doing because it makes the environment smaller for -- every module that imports the Prelude | otherwise - = case prov of - LocalDef | Just name_mod <- nameModule_maybe name - -> moduleName name_mod == mod - | otherwise -> False - Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is + = (lcl && (case nameModule_maybe name of + Just name_mod -> moduleName name_mod == mod + Nothing -> False)) + || (any unQualSpecOK iss && any (qualSpecOK mod) iss) ------------------------------- check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap @@ -1471,7 +1471,8 @@ extendImportMap :: GlobalRdrEnv -> RdrName -> ImportMap -> ImportMap -- the RdrName in that import decl's entry in the ImportMap extendImportMap rdr_env rdr imp_map | [gre] <- lookupGRE_RdrName rdr rdr_env - , Imported imps <- gre_prov gre + , GRE { gre_lcl = lcl, gre_imp = imps } <- gre + , not lcl = add_imp gre (bestImport imps) imp_map | otherwise = imp_map @@ -1738,18 +1739,6 @@ exportClashErr global_env name1 name2 ie1 ie2 then (name1, ie1, name2, ie2) else (name2, ie2, name1, ie1) --- the SrcSpan that pprNameProvenance prints out depends on whether --- the Name is defined locally or not: for a local definition the --- definition site is used, otherwise the location of the import --- declaration. We want to sort the export locations in --- exportClashErr by this SrcSpan, we need to extract it: -greSrcSpan :: GlobalRdrElt -> SrcSpan -greSrcSpan gre - | Imported (is:_) <- gre_prov gre = is_dloc (is_decl is) - | otherwise = name_span - where - name_span = nameSrcSpan (gre_name gre) - addDupDeclErr :: [GlobalRdrElt] -> TcRn () addDupDeclErr [] = panic "addDupDeclErr: empty list" addDupDeclErr gres@(gre : _) diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index c742262f5f..48c4f1dfc7 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -617,7 +617,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) HsRecFieldCon {} -> arg_in_scope fld _other -> True ] - ; addUsedRdrNames (map greRdrName dot_dot_gres) + ; addUsedRdrNames (map greUsedRdrName dot_dot_gres) ; return [ L loc (HsRecField { hsRecFieldId = L loc fld , hsRecFieldArg = L loc (mk_arg arg_rdr) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index e5a7587113..122319420f 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -23,7 +23,7 @@ import Coercion import FamInstEnv ( FamInstEnvs ) import FamInst ( tcTopNormaliseNewTypeTF_maybe ) import Var -import Name( isSystemName, nameOccName ) +import Name( isSystemName ) import OccName( OccName ) import Outputable import DynFlags( DynFlags ) @@ -615,12 +615,10 @@ can_eq_newtype_nc rdr_env ev swapped co ty1 ty1' ty2 ps_ty2 -- avoiding "redundant import" warnings. markDataConsAsUsed :: GlobalRdrEnv -> TyCon -> TcS () markDataConsAsUsed rdr_env tc = addUsedRdrNamesTcS - [ mkRdrQual (is_as (is_decl imp_spec)) occ + [ greUsedRdrName gre | dc <- tyConDataCons tc - , let dc_name = dataConName dc - occ = nameOccName dc_name - , gre : _ <- return $ lookupGRE_Name rdr_env dc_name - , Imported (imp_spec:_) <- return $ gre_prov gre ] + , gre : _ <- return $ lookupGRE_Name rdr_env (dataConName dc) + , not (isLocalGRE gre) ] --------- -- ^ Decompose a type application. Nominal equality only! diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 96a4a33fb0..f99f78b6ef 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -874,12 +874,10 @@ mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args mtheta -- Make a Qual RdrName that will do for each DataCon -- so we can report it as used (Trac #7969) - data_con_rdrs = [ mkRdrQual (is_as (is_decl imp_spec)) occ + data_con_rdrs = [ greUsedRdrName gre | dc_name <- data_con_names - , let occ = nameOccName dc_name - gres = lookupGRE_Name rdr_env dc_name - , not (null gres) - , Imported (imp_spec:_) <- [gre_prov (head gres)] ] + , gre : _ <- [lookupGRE_Name rdr_env dc_name] + , not (isLocalGRE gre) ] ; addUsedRdrNames data_con_rdrs ; unless (isNothing mtheta || not hidden_data_cons) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 99309b0f70..de318169c3 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -168,7 +168,7 @@ tcRnSignature dflags hsc_src | otherwise -> do { sig_iface <- initIfaceTcRn $ loadSysInterface (text "sig-of") sof ; let { gr = mkGlobalRdrEnv - (gresFromAvails LocalDef (mi_exports sig_iface)) + (gresFromAvails Nothing (mi_exports sig_iface)) ; avails = calculateAvails dflags sig_iface False{- safe -} False{- boot -} } ; return (tcg_env @@ -1212,13 +1212,8 @@ tcTopSrcDecls boot_details -- make sure that at least one of the imports for them is used -- See Note [Newtype constructor usage in foreign declarations] gre_to_rdr_name gre rdrs - = case gre_prov gre of - LocalDef -> rdrs - Imported [] -> panic "gre_to_rdr_name: Imported []" - Imported (is : _) -> mkRdrQual modName occName : rdrs - where - modName = is_as (is_decl is) - occName = nameOccName (gre_name gre) + | isLocalGRE gre = rdrs + | otherwise = greUsedRdrName gre : rdrs --------------------------- tcTyClsInstDecls :: ModDetails |