[project @ 1999-12-29 12:17:36 by simonpj]

Fix a renamer bug that rejected

	import M hiding( C )

where C is a constructor.

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 99cc716..0d1ffae 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -494,6 +494,7 @@ andRn    :: (a -> a -> a) -> RnM d a -> RnM d a -> RnM d a
 mapRn    :: (a -> RnM d b) -> [a] -> RnM d [b]
 mapRn_   :: (a -> RnM d b) -> [a] -> RnM d ()
 mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
+flatMapRn  :: (a -> RnM d [b])       -> [a] -> RnM d [b]
 sequenceRn :: [RnM d a] -> RnM d [a]
 foldlRn :: (b  -> a -> RnM d b) -> b -> [a] -> RnM d b
 mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
@@ -546,6 +547,11 @@ mapMaybeRn f (x:xs) = f x          `thenRn` \ maybe_r ->
                      case maybe_r of
                        Nothing -> returnRn rs
                        Just r  -> returnRn (r:rs)
+
+flatMapRn f []     = returnRn []
+flatMapRn f (x:xs) = f x               `thenRn` \ r ->
+                    flatMapRn f xs     `thenRn` \ rs ->
+                    returnRn (r ++ rs)
 \end{code}
 
 

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 176eca3..142b36c 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -34,14 +34,15 @@ import PrelMods
 import PrelInfo ( main_RDR )
 import UniqFM  ( lookupUFM )
 import Bag     ( bagToList )
-import Maybes  ( maybeToBool )
+import Maybes  ( maybeToBool, catMaybes )
 import Module  ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
 import NameSet
 import Name    ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
                  isLocallyDefined, setNameProvenance,
                  nameOccName, getSrcLoc, pprProvenance, getNameProvenance
                )
-import RdrName ( RdrName, rdrNameOcc, mkRdrQual, mkRdrUnqual, isQual )
+import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, isQual )
+import OccName ( setOccNameSpace, dataName )
 import SrcLoc  ( SrcLoc )
 import NameSet ( elemNameSet, emptyNameSet )
 import Outputable
@@ -374,6 +375,9 @@ filterImports :: ModuleName                 -- The module being imported
              -> RnMG ([AvailInfo],             -- What's actually imported
                       [AvailInfo],             -- What's to be hidden
                                                -- (the unqualified version, that is)
+                       -- (We need to return both the above sets, because
+                       --  the qualified version is never hidden; so we can't
+                       --  implement hiding by reducing what's imported.)
                       NameSet)                 -- What was imported explicitly
 
        -- Complains if import spec mentions things that the module doesn't export
@@ -382,7 +386,7 @@ filterImports mod Nothing imports
   = returnRn (imports, [], emptyNameSet)
 
 filterImports mod (Just (want_hiding, import_items)) avails
-  = mapMaybeRn check_item import_items         `thenRn` \ avails_w_explicits ->
+  = flatMapRn get_item import_items            `thenRn` \ avails_w_explicits ->
     let
        (item_avails, explicits_s) = unzip avails_w_explicits
        explicits                  = foldl addListToNameSet emptyNameSet explicits_s
@@ -403,19 +407,46 @@ filterImports mod (Just (want_hiding, import_items)) avails
        -- they won't make any difference because naked entities like T
        -- in an import list map to TcOccs, not VarOccs.
 
-    check_item item@(IEModuleContents _)
-      = addErrRn (badImportItemErr mod item)   `thenRn_`
-       returnRn Nothing
+    bale_out item = addErrRn (badImportItemErr mod item)       `thenRn_`
+                   returnRn []
+
+    get_item item@(IEModuleContents _) = bale_out item
+
+    get_item item@(IEThingAll _)
+      = case check_item item of
+         Nothing                    -> bale_out item
+         Just avail@(AvailTC _ [n]) ->         -- This occurs when you import T(..), but
+                                               -- only export T abstractly.  The single [n]
+                                               -- in the AvailTC is the type or class itself
+                                       addWarnRn (dodgyImportWarn mod item)    `thenRn_`
+                                       returnRn [(avail, [availName avail])]
+         Just avail                 -> returnRn [(avail, [availName avail])]
+
+    get_item item@(IEThingAbs n)
+      | want_hiding    -- hiding( C ) 
+                       -- Here the 'C' can be a data constructor *or* a type/class
+      = case catMaybes [check_item item, check_item (IEThingAbs data_n)] of
+               []     -> bale_out item
+               avails -> returnRn [(a, []) | a <- avails]
+                               -- The 'explicits' list is irrelevant when hiding
+      where
+       data_n = setRdrNameOcc n (setOccNameSpace (rdrNameOcc n) dataName)
+
+    get_item item
+      = case check_item item of
+         Nothing    -> bale_out item
+         Just avail -> returnRn [(avail, availNames avail)]
+
+    ok_dotdot_item (AvailTC _ [n]) = False
+    ok_dotdot_item other = True
 
     check_item item
       | not (maybeToBool maybe_in_import_avails) ||
        not (maybeToBool maybe_filtered_avail)
-      = addErrRn (badImportItemErr mod item)   `thenRn_`
-       returnRn Nothing
+      = Nothing
 
       | otherwise    
-      = warnCheckRn (okItem item avail) (dodgyImportWarn mod item)     `thenRn_`
-        returnRn (Just (filtered_avail, explicits))
+      = Just filtered_avail
                
       where
        wanted_occ             = rdrNameOcc (ieName item)
@@ -424,19 +455,6 @@ filterImports mod (Just (want_hiding, import_items)) avails
        Just avail             = maybe_in_import_avails
        maybe_filtered_avail   = filterAvail item avail
        Just filtered_avail    = maybe_filtered_avail
-       explicits              | dot_dot   = [availName filtered_avail]
-                              | otherwise = availNames filtered_avail
-
-       dot_dot = case item of 
-                   IEThingAll _    -> True
-                   other           -> False
-
-
-okItem (IEThingAll _) (AvailTC _ [n]) = False
-               -- This occurs when you import T(..), but
-               -- only export T abstractly.  The single [n]
-               -- in the AvailTC is the type or class itself
-okItem _ _ = True
 \end{code}
 
 
@@ -608,7 +626,7 @@ exportsFromAvail this_mod (Just export_items)
        | otherwise     -- Phew!  It's OK!  Now to check the occurrence stuff!
 
 
-       = warnCheckRn (okItem ie avail) (dodgyExportWarn ie)    `thenRn_`
+       = warnCheckRn (ok_item ie avail) (dodgyExportWarn ie)   `thenRn_`
           check_occs ie occs export_avail                      `thenRn` \ occs' ->
          returnRn (mods, occs', add_avail avails export_avail)
 
@@ -622,6 +640,12 @@ exportsFromAvail this_mod (Just export_items)
          enough_avail       = maybeToBool maybe_export_avail
          Just export_avail  = maybe_export_avail
 
+    ok_item (IEThingAll _) (AvailTC _ [n]) = False
+               -- This occurs when you import T(..), but
+               -- only export T abstractly.  The single [n]
+               -- in the AvailTC is the type or class itself
+    ok_item _ _ = True
+
 add_avail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
 
 check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap