Refactor RdrName.Provenance, to fix #7672
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Jun 2015 10:43:53 +0000 (11:43 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Jun 2015 10:46:17 +0000 (11:46 +0100)
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.

14 files changed:
compiler/basicTypes/RdrName.hs
compiler/deSugar/DsMonad.hs
compiler/iface/IfaceEnv.hs
compiler/main/DynamicLoading.hs
compiler/main/HscTypes.hs
compiler/main/InteractiveEval.hs
compiler/rename/RnEnv.hs
compiler/rename/RnNames.hs
compiler/rename/RnPat.hs
compiler/typecheck/TcCanonical.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcRnDriver.hs
testsuite/tests/rename/should_compile/T7672.hs
testsuite/tests/rename/should_compile/all.T

index 7764303..b4deeca 100644 (file)
@@ -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".
index ee5c6e9..ad6a6b1 100644 (file)
@@ -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
index 0a13fc4..1bd9316 100644 (file)
@@ -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
index 546cc68..3b62717 100644 (file)
@@ -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
index 1d33c4f..f834e17 100644 (file)
@@ -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).
index f96f4b9..122d565 100644 (file)
@@ -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]
index d80e970..2d6cadf 100644 (file)
@@ -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 $
index 11f8e61..872f4ff 100644 (file)
@@ -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 : _)
index c742262..48c4f1d 100644 (file)
@@ -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)
index e5a7587..1223194 100644 (file)
@@ -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!
index 96a4a33..f99f78b 100644 (file)
@@ -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)
index 99309b0..de31816 100644 (file)
@@ -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
index 405c853..95b2b45 100644 (file)
@@ -1,3 +1,3 @@
 module T7672 where
-import qualified T7672a
-data T = S B.T
+import qualified T7672a as XX
+data T = S XX.T
index fc5d125..aa29c43 100644 (file)
@@ -212,7 +212,7 @@ test('T7167', normal, compile, [''])
 test('T7336', expect_broken(7336), compile, ['-Wall'])
 
 test('T2435', normal, multimod_compile, ['T2435','-v0'])
-test('T7672', expect_broken(7672), multimod_compile, ['T7672',''])
+test('T7672', normal, multimod_compile, ['T7672','-v0'])
 test('T7963',
      [extra_clean(['T7963a.hi', 'T7963a.o',
                    'T7963.imports'])],