Change the representation of export lists in .hi files
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 2 Aug 2011 09:43:57 +0000 (10:43 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 2 Aug 2011 09:43:57 +0000 (10:43 +0100)
Currently export list in .hi files are partitioned by module
  export M T(C1,C2)
         N f,g
In each list we only have OccNames, all assumed to come from
the parent module M or N resp.

This patch changes the representatation so that export lists
have full Names:
  export M.T(M.C1,M.C2), N.f, N.g

Numerous advatages
  * AvailInfo no longer needs to be parameterised; it always
    contains Names

  * Fixes Trac #5306.  This was the main provocation

  * Less to-and-fro conversion when reading interface files

It's all generally simpler.  Interface files should not get bigger,
becuase they have a nice compact representation for Names.

compiler/basicTypes/Name.lhs
compiler/iface/BinIface.hs
compiler/iface/IfaceEnv.lhs
compiler/iface/LoadIface.lhs
compiler/iface/MkIface.lhs
compiler/main/HscTypes.lhs
compiler/prelude/PrelInfo.lhs
compiler/rename/RnEnv.lhs
compiler/rename/RnNames.lhs
compiler/rename/RnSource.lhs

index e88e4a1..fbe86bd 100644 (file)
@@ -57,7 +57,7 @@ module Name (
        isValName, isVarName,
        isWiredInName, isBuiltInSyntax,
        wiredInNameTyThing_maybe, 
-       nameIsLocalOrFrom,
+       nameIsLocalOrFrom, stableNameCmp,
 
        -- * Class 'NamedThing' and overloaded friends
        NamedThing(..),
@@ -341,6 +341,26 @@ hashName name = getKey (nameUnique name) + 1
 
 cmpName :: Name -> Name -> Ordering
 cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
+
+stableNameCmp :: Name -> Name -> Ordering
+-- Compare lexicographically
+stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
+             (Name { n_sort = s2, n_occ = occ2 })
+  = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2)
+    -- The ordinary compare on OccNames is lexicogrpahic
+  where
+    -- Later constructors are bigger
+    sort_cmp (External m1) (External m2)       = m1 `stableModuleCmp` m2
+    sort_cmp (External {}) _                   = LT
+    sort_cmp (WiredIn {}) (External {})        = GT
+    sort_cmp (WiredIn m1 _ _) (WiredIn m2 _ _) = m1 `stableModuleCmp` m2
+    sort_cmp (WiredIn {})     _                = LT
+    sort_cmp Internal         (External {})    = GT
+    sort_cmp Internal         (WiredIn {})     = GT
+    sort_cmp Internal         Internal         = EQ
+    sort_cmp Internal         System           = LT
+    sort_cmp System           System           = EQ
+    sort_cmp System           _                = GT
 \end{code}
 
 %************************************************************************
index 336030c..94860f9 100644 (file)
@@ -496,7 +496,7 @@ instance Binary Dependencies where
                return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
                               dep_finsts = fis })
 
-instance (Binary name) => Binary (GenAvailInfo name) where
+instance Binary AvailInfo where
     put_ bh (Avail aa) = do
            putByte bh 0
            put_ bh aa
index 36024eb..95f7a74 100644 (file)
@@ -123,25 +123,7 @@ newImplicitBinder base_name mk_sys_occ
     loc = nameSrcSpan base_name
 
 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
-ifaceExportNames exports = do
-  mod_avails <- mapM (\(mod,avails) -> mapM (lookupAvail mod) avails) exports
-  return (concat mod_avails)
-
--- Convert OccNames in GenAvailInfo to Names.
-lookupAvail :: Module -> GenAvailInfo OccName -> TcRnIf a b AvailInfo
-lookupAvail mod (Avail n) = do 
-  n' <- lookupOrig mod n
-  return (Avail n')
-lookupAvail mod (AvailTC p_occ occs) = do
-  p_name <- lookupOrig mod p_occ
-  let lookup_sub occ | occ == p_occ = return p_name
-                     | otherwise    = lookupOrig mod occ
-  subs <- mapM lookup_sub occs
-  return (AvailTC p_name subs)
-       -- Remember that 'occs' is all the exported things, including
-       -- the parent.  It's possible to export just class ops without
-       -- the class, which shows up as C( op ) here. If the class was
-       -- exported too we'd have C( C, op )
+ifaceExportNames exports = return exports
 
 lookupOrig :: Module -> OccName ->  TcRnIf a b Name
 lookupOrig mod occ
index 9b7a40f..9d087c1 100644 (file)
@@ -590,7 +590,7 @@ initExternalPackageState
 ghcPrimIface :: ModIface
 ghcPrimIface
   = (emptyModIface gHC_PRIM) {
-       mi_exports  = [(gHC_PRIM, ghcPrimExports)],
+       mi_exports  = ghcPrimExports,
        mi_decls    = [],
        mi_fixities = fixities,
        mi_fix_fn  = mkIfaceFixCache fixities
@@ -657,7 +657,8 @@ pprModIface iface
         , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
         , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
         , nest 2 (ptext (sLit "where"))
-       , vcat (map pprExport (mi_exports iface))
+       , ptext (sLit "exports:")
+        , nest 2 (vcat (map pprExport (mi_exports iface)))
        , pprDeps (mi_deps iface)
        , vcat (map pprUsage (mi_usages iface))
        , vcat (map pprIfaceAnnotation (mi_anns iface))
@@ -684,16 +685,12 @@ When printing export lists, we print like this:
 
 \begin{code}
 pprExport :: IfaceExport -> SDoc
-pprExport (mod, items)
- = hsep [ ptext (sLit "export"), ppr mod, hsep (map pp_avail items) ]
-  where
-    pp_avail :: GenAvailInfo OccName -> SDoc
-    pp_avail (Avail occ)    = ppr occ
-    pp_avail (AvailTC _ []) = empty
-    pp_avail (AvailTC n (n':ns)) 
-       | n==n'     = ppr n <> pp_export ns
-       | otherwise = ppr n <> char '|' <> pp_export (n':ns)
-    
+pprExport (Avail n)      = ppr n
+pprExport (AvailTC _ []) = empty
+pprExport (AvailTC n (n':ns)) 
+  | n==n'     = ppr n <> pp_export ns
+  | otherwise = ppr n <> char '|' <> pp_export (n':ns)
+  where  
     pp_export []    = empty
     pp_export names = braces (hsep (map ppr names))
 
index 7e1a463..6681ca3 100644 (file)
@@ -959,54 +959,17 @@ mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) =
 \end{code}
 
 \begin{code}
-mkIfaceExports :: [AvailInfo]
-               -> [(Module, [GenAvailInfo OccName])]
-                  -- Group by module and sort by occurrence
+mkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical
 mkIfaceExports exports
-  = [ (mod, Map.elems avails)
-    | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
-                              (moduleEnvToList groupFM)
-                       -- NB. the Map.toList is in a random order,
-                       -- because Ord Module is not a predictable
-                       -- ordering.  Hence we perform a final sort
-                       -- using the stable Module ordering.
-    ]
+  = sortBy stableAvailCmp (map sort_subs exports)
   where
-       -- Group by the module where the exported entities are defined
-       -- (which may not be the same for all Names in an Avail)
-       -- Deliberately use Map rather than UniqFM so we
-       -- get a canonical ordering
-    groupFM :: ModuleEnv (Map FastString (GenAvailInfo OccName))
-    groupFM = foldl add emptyModuleEnv exports
-
-    add_one :: ModuleEnv (Map FastString (GenAvailInfo OccName))
-           -> Module -> GenAvailInfo OccName
-           -> ModuleEnv (Map FastString (GenAvailInfo OccName))
-    add_one env mod avail 
-      -- XXX Is there a need to flip Map.union here?
-      =  extendModuleEnvWith (flip Map.union) env mod 
-               (Map.singleton (occNameFS (availName avail)) avail)
-
-       -- NB: we should not get T(X) and T(Y) in the export list
-       --     else the Map.union will simply discard one!  They
-       --     should have been combined by now.
-    add env (Avail n)
-      = ASSERT( isExternalName n ) 
-        add_one env (nameModule n) (Avail (nameOccName n))
-
-    add env (AvailTC tc ns)
-      = ASSERT( all isExternalName ns ) 
-       foldl add_for_mod env mods
-      where
-       tc_occ = nameOccName tc
-       mods   = nub (map nameModule ns)
-               -- Usually just one, but see Note [Original module]
-
-       add_for_mod env mod
-           = add_one env mod (AvailTC tc_occ (sort names_from_mod))
-              -- NB. sort the children, we need a canonical order
-           where
-             names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
+    sort_subs :: AvailInfo -> AvailInfo
+    sort_subs (Avail n) = Avail n
+    sort_subs (AvailTC n []) = AvailTC n []
+    sort_subs (AvailTC n (m:ms)) 
+       | n==m      = AvailTC n (m:sortBy stableNameCmp ms)
+       | otherwise = AvailTC n (sortBy stableNameCmp (m:ms))
+       -- Maintain the AvailTC Invariant
 \end{code}
 
 Note [Orignal module]
index d43105b..59985df 100644 (file)
@@ -71,8 +71,8 @@ module HscTypes (
        Dependencies(..), noDependencies,
        NameCache(..), OrigNameCache, OrigIParamCache,
        Avails, availsToNameSet, availsToNameEnv, availName, availNames,
-       GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
-       IfaceExport,
+       AvailInfo(..),
+       IfaceExport, stableAvailCmp, 
 
        -- * Warnings
        Warnings(..), WarningTxt(..), plusWarns,
@@ -149,6 +149,7 @@ import Fingerprint
 import MonadUtils
 import Bag
 import ErrUtils
+import Util
 
 import System.FilePath
 import System.Time     ( ClockTime )
@@ -1327,27 +1328,24 @@ plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
 \begin{code}
 -- | A collection of 'AvailInfo' - several things that are \"available\"
 type Avails      = [AvailInfo]
--- | 'Name'd things that are available
-type AvailInfo    = GenAvailInfo Name
--- | 'RdrName'd things that are available
-type RdrAvailInfo = GenAvailInfo OccName
 
 -- | Records what things are "available", i.e. in scope
-data GenAvailInfo name = Avail name     -- ^ An ordinary identifier in scope
-                       | AvailTC name
-                                 [name] -- ^ A type or class in scope. Parameters:
-                                        --
-                                        --  1) The name of the type or class
-                                        --
-                                        --  2) The available pieces of type or class.
-                                        --     NB: If the type or class is itself
-                                        --     to be in scope, it must be in this list.
-                                        --     Thus, typically: @AvailTC Eq [Eq, ==, \/=]@
-                       deriving( Eq )
+data AvailInfo = Avail Name     -- ^ An ordinary identifier in scope
+              | AvailTC Name
+                        [Name]  -- ^ A type or class in scope. Parameters:
+                                --
+                                --  1) The name of the type or class
+                                --  2) The available pieces of type or class.
+                                -- 
+                                -- The AvailTC Invariant:
+                                --   * If the type or class is itself
+                                --     to be in scope, it must be *first* in this list.
+                                --     Thus, typically: @AvailTC Eq [Eq, ==, \/=]@
+               deriving( Eq )
                        -- Equality used when deciding if the interface has changed
 
 -- | The original names declared of a certain module that are exported
-type IfaceExport = (Module, [GenAvailInfo OccName])
+type IfaceExport = AvailInfo
 
 availsToNameSet :: [AvailInfo] -> NameSet
 availsToNameSet avails = foldr add emptyNameSet avails
@@ -1360,21 +1358,29 @@ availsToNameEnv avails = foldr add emptyNameEnv avails
 
 -- | Just the main name made available, i.e. not the available pieces
 -- of type or class brought into scope by the 'GenAvailInfo'
-availName :: GenAvailInfo name -> name
+availName :: AvailInfo -> Name
 availName (Avail n)     = n
 availName (AvailTC n _) = n
 
 -- | All names made available by the availability information
-availNames :: GenAvailInfo name -> [name]
+availNames :: AvailInfo -> [Name]
 availNames (Avail n)      = [n]
 availNames (AvailTC _ ns) = ns
 
-instance Outputable n => Outputable (GenAvailInfo n) where
+instance Outputable AvailInfo where
    ppr = pprAvail
 
-pprAvail :: Outputable n => GenAvailInfo n -> SDoc
+pprAvail :: AvailInfo -> SDoc
 pprAvail (Avail n)      = ppr n
 pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
+
+stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
+-- Compare lexicographically
+stableAvailCmp (Avail n1)     (Avail n2)     = n1 `stableNameCmp` n2
+stableAvailCmp (Avail {})     (AvailTC {})   = LT
+stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
+                                               (cmpList stableNameCmp ns ms)
+stableAvailCmp (AvailTC {})   (Avail {})     = GT
 \end{code}
 
 \begin{code}
index 867e79d..f99f9ca 100644 (file)
@@ -26,14 +26,13 @@ import PrelNames        ( basicKnownKeyNames,
                           hasKey, charDataConKey, intDataConKey,
                           numericClassKeys, standardClassKeys )
 import PrelRules
-import PrimOp          ( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag )
+import PrimOp          ( PrimOp, allThePrimOps, primOpTag, maxPrimOpTag )
 import DataCon         ( DataCon )
 import Id              ( Id, idName )
 import MkId            -- All of it, for re-export
-import Name            ( nameOccName )
 import TysPrim         ( primTyCons )
 import TysWiredIn      ( wiredInTyCons )
-import HscTypes        ( TyThing(..), implicitTyThings, GenAvailInfo(..), RdrAvailInfo )
+import HscTypes        ( TyThing(..), implicitTyThings, AvailInfo(..), IfaceExport )
 import Class           ( Class, classKey )
 import Type            ( funTyCon )
 import TyCon           ( tyConName )
@@ -82,7 +81,7 @@ wiredInThings
        , map AnId wiredInIds
 
                -- PrimOps
-       , map (AnId . mkPrimOpId) allThePrimOps
+       , map (AnId . primOpId) allThePrimOps
     ]
   where
     tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons)
@@ -99,9 +98,10 @@ sense of them in interface pragmas. It's cool, though they all have
 %************************************************************************
 
 \begin{code}
-primOpIds :: Array Int Id      -- Indexed by PrimOp tag
+primOpIds :: Array Int Id      
+-- A cache of the PrimOp Ids, indexed by PrimOp tag
 primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op) 
-                                  | op <- allThePrimOps]
+                                  | op <- allThePrimOps ]
 
 primOpId :: PrimOp -> Id
 primOpId op = primOpIds ! primOpTag op
@@ -118,13 +118,12 @@ GHC.Prim "exports" all the primops and primitive types, some
 wired-in Ids.
 
 \begin{code}
-ghcPrimExports :: [RdrAvailInfo]
+ghcPrimExports :: [IfaceExport]
 ghcPrimExports
- = map (Avail . nameOccName . idName) ghcPrimIds ++
-   map (Avail . primOpOcc) allThePrimOps ++
-   [ AvailTC occ [occ] |
-     n <- funTyCon : primTyCons, let occ = nameOccName (tyConName n) 
-   ]
+ = map (Avail . idName) ghcPrimIds ++
+   map (Avail . idName . primOpId) allThePrimOps ++
+   [ AvailTC n [n] 
+   | tc <- funTyCon : primTyCons, let n = tyConName tc  ]
 \end{code}
 
 
index 9374b5c..e2f9805 100644 (file)
@@ -509,13 +509,11 @@ lookupQualifiedName rdr_name
    -- and respect hiddenness of modules/packages, hence loadSrcInterface.
    = loadSrcInterface doc mod False Nothing    `thenM` \ iface ->
 
-   case  [ (mod,occ) | 
-          (mod,avails) <- mi_exports iface,
-          avail        <- avails,
-          name         <- availNames avail,
-          name == occ ] of
-      ((mod,occ):ns) -> ASSERT (null ns) 
-                       lookupOrig mod occ
+   case  [ name
+        | avail <- mi_exports iface,
+          name  <- availNames avail,
+          nameOccName name == occ ] of
+      (n:ns) -> ASSERT (null ns) return n
       _ -> unboundName WL_Any rdr_name
 
   | otherwise
index c6c941c..ab4c1d0 100644 (file)
@@ -18,7 +18,6 @@ import HsSyn
 import TcEnv            ( isBrackStage )
 import RnEnv
 import RnHsDoc          ( rnHsDoc )
-import IfaceEnv         ( ifaceExportNames )
 import LoadIface        ( loadSrcInterface )
 import TcRnMonad
 
@@ -37,7 +36,7 @@ import ErrUtils
 import Util
 import FastString
 import ListSetOps
-import Data.List        ( partition, (\\), delete, find )
+import Data.List        ( partition, (\\), find )
 import qualified Data.Set as Set
 import System.IO
 import Control.Monad
@@ -227,8 +226,17 @@ rnImportDecl this_mod implicit_prelude
         trust      = getSafeMode $ mi_trust iface
         trust_pkg  = mi_trust_pkg iface
 
-        filtered_exports = filter not_this_mod (mi_exports iface)
-        not_this_mod (mod,_) = mod /= this_mod
+        qual_mod_name = case as_mod of
+                          Nothing           -> imp_mod_name
+                          Just another_name -> another_name
+        imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
+                                  is_dloc = loc, is_as = qual_mod_name }
+
+    -- filter the imports according to the import declaration
+    (new_imp_details, gres) <- filterImports iface imp_spec imp_details
+
+    let gbl_env = mkGlobalRdrEnv (filterOut from_this_mod gres)
+        from_this_mod gre = nameModule (gre_name gre) == this_mod
         -- If the module exports anything defined in this module, just
         -- ignore it.  Reason: otherwise it looks as if there are two
         -- local definition sites for the thing, and an error gets
@@ -237,7 +245,7 @@ rnImportDecl this_mod implicit_prelude
         -- itself, or another module that imported it.  (Necessarily,
         -- this invoves a loop.)
         --
-        -- Tiresome consequence: if you say
+        -- We do this *after* filterImports, so that if you say
         --      module A where
         --         import B( AType )
         --         type AType = ...
@@ -245,24 +253,9 @@ rnImportDecl this_mod implicit_prelude
         --      module B( AType ) where
         --         import {-# SOURCE #-} A( AType )
         --
-        -- then you'll get a 'B does not export AType' message.  Oh well.
+        -- then you won't get a 'B does not export AType' message.
 
-        qual_mod_name = case as_mod of
-                          Nothing           -> imp_mod_name
-                          Just another_name -> another_name
-        imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
-                                  is_dloc = loc, is_as = qual_mod_name }
 
-    -- Get the total exports from this module
-    total_avails <- ifaceExportNames filtered_exports
-
-    -- filter the imports according to the import declaration
-    (new_imp_details, gbl_env) <-
-        filterImports iface imp_spec imp_details total_avails
-
-    dflags <- getDOpts
-
-    let
         -- Compute new transitive dependencies
 
         orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
@@ -546,7 +539,7 @@ getLocalNonValBinders group
   = do { gbl_env <- getGblEnv
        ; get_local_binders gbl_env group }
 
-get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [GenAvailInfo Name]
+get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [AvailInfo]
 get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
                                     hs_tyclds = tycl_decls,
                                     hs_instds = inst_decls,
@@ -581,7 +574,7 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
     val_bndrs | is_hs_boot = [n | L _ (TypeSig ns _) <- val_sigs, n <- ns]
               | otherwise  = for_hs_bndrs
 
-    new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
+    new_simple :: Located RdrName -> RnM AvailInfo
     new_simple rdr_name = do
         nm <- newTopSrcBinder rdr_name
         return (Avail nm)
@@ -618,16 +611,15 @@ available, and filters it through the import spec (if any).
 filterImports :: ModIface
               -> ImpDeclSpec                    -- The span for the entire import decl
               -> Maybe (Bool, [LIE RdrName])    -- Import spec; True => hiding
-              -> [AvailInfo]                    -- What's available
               -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names
-                      GlobalRdrEnv)             -- Same again, but in GRE form
-filterImports _ decl_spec Nothing all_avails
-  = return (Nothing, mkGlobalRdrEnv (gresFromAvails prov all_avails))
+                      [GlobalRdrElt])           -- Same again, but in GRE form
+filterImports iface decl_spec Nothing
+  = return (Nothing, gresFromAvails prov (mi_exports iface))
   where
     prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
 
 
-filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
+filterImports iface decl_spec (Just (want_hiding, import_items))
   = do  -- check for errors, convert RdrNames to Names
         opt_typeFamilies <- xoptM Opt_TypeFamilies
         items1 <- mapM (lookup_lie opt_typeFamilies) import_items
@@ -645,8 +637,10 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
             gres | want_hiding = gresFromAvails hiding_prov pruned_avails
                  | otherwise   = concatMap (gresFromIE decl_spec) items2
 
-        return (Just (want_hiding, map fst items2), mkGlobalRdrEnv gres)
+        return (Just (want_hiding, map fst items2), gres)
   where
+    all_avails = mi_exports iface
+
         -- This environment is how we map names mentioned in the import
         -- list to the actual Name they correspond to, and the name family
         -- that the Name belongs to (the AvailInfo).  The situation is
@@ -789,6 +783,27 @@ catMaybeErr ms =  [ a | Succeeded a <- ms ]
 %*                                                                      *
 %************************************************************************
 
+Note [Exports of data families]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose you see (Trac #5306)
+       module M where
+          import X( F )
+          data instance F Int = FInt
+What does M export?  AvailTC F [FInt] 
+                  or AvailTC F [F,FInt]?
+The former is strictly right because F isn't defined in this module.
+But then you can never do an explicit import of M, thus
+    import M( F( FInt ) )
+becuase F isn't exported by M.  Nor can you import FInt alone from here
+    import M( FInt )
+because we don't have syntax to support that.  (It looks like an import of 
+the type FInt.)  
+
+So we compromise.  When constructing exports with no export list, or
+with module M( module M ), we add the parent to the exports as well.
+But not when you see module M( f ), even if f is a class method with
+a parent.  Hence the include_parent flag to greExportAvail.
+
 \begin{code}
 -- | make a 'GlobalRdrEnv' where all the elements point to the same
 -- import declaration (useful for "hiding" imports, or imports with
@@ -804,17 +819,30 @@ gresFromAvail prov_fn avail
            gre_prov = prov_fn n}
     | n <- availNames avail ]
 
-greAvail :: GlobalRdrElt -> AvailInfo
-greAvail gre = mkUnitAvail (gre_name gre) (gre_par gre)
-
-mkUnitAvail :: Name -> Parent -> AvailInfo
-mkUnitAvail me (ParentIs p)              = AvailTC p  [me]
-mkUnitAvail me NoParent | isTyConName me = AvailTC me [me]
-                        | otherwise      = Avail me
-
-plusAvail :: GenAvailInfo Name -> GenAvailInfo Name -> GenAvailInfo Name
-plusAvail (Avail n1)      (Avail _)        = Avail n1
-plusAvail (AvailTC _ ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
+greExportAvail :: Bool -> GlobalRdrElt -> AvailInfo
+-- For 'include_parent' see Note [Exports of data families]
+greExportAvail include_parent gre 
+  = case gre_par gre of
+      ParentIs p | include_parent -> AvailTC p  [p,me]
+                 | otherwise      -> AvailTC p  [me]
+      NoParent   | isTyConName me -> AvailTC me [me]
+                 | otherwise      -> Avail   me
+  where
+    me = gre_name gre
+
+plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
+plusAvail a1 a2
+  | debugIsOn && availName a1 /= availName a2 
+  = pprPanic "RnEnv.plusAvail names differ" (hsep [ppr a1,ppr a2])
+plusAvail a1@(Avail {})         (Avail {})      = a1
+plusAvail (AvailTC _ [])        a2@(AvailTC {}) = a2
+plusAvail a1@(AvailTC {})       (AvailTC _ [])  = a1
+plusAvail (AvailTC n1 (s1:ss1)) (AvailTC n2 (s2:ss2))
+  = case (n1==s1, n2==s2) of  -- Maintain invariant the parent is first
+       (True,True)   -> AvailTC n1 (s1 : (ss1 `unionLists` ss2))
+       (True,False)  -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))
+       (False,True)  -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))
+       (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))
 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
 
 availParent :: Name -> AvailInfo -> Parent
@@ -861,54 +889,16 @@ mkChildEnv gres = foldr add emptyNameEnv gres
 
 findChildren :: NameEnv [Name] -> Name -> [Name]
 findChildren env n = lookupNameEnv env n `orElse` []
-\end{code}
-
----------------------------------------
-        AvailEnv and friends
-
-All this AvailEnv stuff is hardly used; only in a very small
-part of RnNames.  Todo: remove?
----------------------------------------
-
-\begin{code}
-type AvailEnv = NameEnv AvailInfo       -- Maps a Name to the AvailInfo that contains it
-
-emptyAvailEnv :: AvailEnv
-emptyAvailEnv = emptyNameEnv
-
-{- Dead code
-unitAvailEnv :: AvailInfo -> AvailEnv
-unitAvailEnv a = unitNameEnv (availName a) a
-
-plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
-plusAvailEnv = plusNameEnv_C plusAvail
-
-availEnvElts :: AvailEnv -> [AvailInfo]
-availEnvElts = nameEnvElts
--}
 
-addAvail :: AvailEnv -> AvailInfo -> AvailEnv
-addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
-
-mkAvailEnv :: [AvailInfo] -> AvailEnv
+-- | Combines 'AvailInfo's from the same family
 -- 'avails' may have several items with the same availName
 -- E.g  import Ix( Ix(..), index )
 -- will give Ix(Ix,index,range) and Ix(index)
 -- We want to combine these; addAvail does that
-mkAvailEnv avails = foldl addAvail emptyAvailEnv avails
-
--- After combining the avails, we need to ensure that the parent name is the
--- first entry in the list of subnames, if it is included at all.  (Subsequent
--- functions rely on that.)
-normaliseAvail :: AvailInfo -> AvailInfo
-normaliseAvail avail@(Avail _)     = avail
-normaliseAvail (AvailTC name subs) = AvailTC name subs'
-  where
-    subs' = if name `elem` subs then name : (delete name subs) else subs
-
--- | combines 'AvailInfo's from the same family
 nubAvails :: [AvailInfo] -> [AvailInfo]
-nubAvails avails = map normaliseAvail . nameEnvElts . mkAvailEnv $ avails
+nubAvails avails = nameEnvElts (foldl add emptyNameEnv avails)
+  where
+    add env avail = extendNameEnv_C plusAvail env (availName avail) avail
 \end{code}
 
 
@@ -996,8 +986,9 @@ exports_from_avail Nothing rdr_env _imports _this_mod
  = -- The same as (module M) where M is the current module name,
    -- so that's how we handle it.
    let
-       avails = [ greAvail gre | gre <- globalRdrEnvElts rdr_env,
-                                 isLocalGRE gre ]
+       avails = [ greExportAvail True gre 
+                | gre <- globalRdrEnvElts rdr_env
+                , isLocalGRE gre ]
    in
    return (Nothing, avails)
 
@@ -1051,7 +1042,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
                       -- several members of mod_avails with the same
                       -- OccName.
              ; return (L loc (IEModuleContents mod) : ie_names,
-                       occs', map greAvail gres ++ exports) }
+                       occs', map (greExportAvail True) gres ++ exports) }
 
     exports_from_item acc@(lie_names, occs, exports) (L loc ie)
         | isDoc ie
@@ -1072,7 +1063,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
     lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
     lookup_ie (IEVar rdr)
         = do gre <- lookupGreRn rdr
-             return (IEVar (gre_name gre), greAvail gre)
+             return (IEVar (gre_name gre), greExportAvail False gre)
 
     lookup_ie (IEThingAbs rdr)
         = do gre <- lookupGreRn rdr
@@ -1560,18 +1551,15 @@ printMinimalImports imports_w_usage
     to_ie _ (AvailTC n [m])
        | n==m = [IEThingAbs n]
     to_ie iface (AvailTC n ns)
-      = case [xs | (m,as) <- mi_exports iface
-                 , m == n_mod
-                 , AvailTC x xs <- as
-                 , x == nameOccName n
+      = case [xs | AvailTC x xs <- mi_exports iface
+                 , x == n
                  , x `elem` xs    -- Note [Partial export]
                  ] of
            [xs] | all_used xs -> [IEThingAll n]
                 | otherwise   -> [IEThingWith n (filter (/= n) ns)]
-           _other             -> (map IEVar ns)
+           _other             -> map IEVar ns
         where
-          all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
-          n_mod = ASSERT( isExternalName n ) nameModule n
+          all_used avail_occs = all (`elem` ns) avail_occs
 \end{code}
 
 Note [Partial export]
index 0ddfa0a..8cd5d9d 100644 (file)
@@ -30,7 +30,7 @@ import RnEnv          ( lookupLocalDataTcNames, lookupLocatedOccRn,
                          bindLocalNames, checkDupRdrNames, mapFvRn
                        )
 import RnNames         ( getLocalNonValBinders, extendGlobalRdrEnvRn )
-import HscTypes        ( GenAvailInfo(..), availsToNameSet )
+import HscTypes        ( AvailInfo(..), availsToNameSet )
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcRnMonad