Fix parent position in RnNames.nubAvails

[ghc-hetmet.git] / compiler / rename / RnNames.lhs

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 4ee759a..90cf81f 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -43,7 +43,8 @@ import HscTypes               ( GenAvailInfo(..), AvailInfo, availNames, availName,
 import RdrName         ( RdrName, rdrNameOcc, setRdrNameSpace, Parent(..),
                          GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
                          emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
-                         extendGlobalRdrEnv, lookupGlobalRdrEnv, lookupGRE_Name,
+                         extendGlobalRdrEnv, lookupGlobalRdrEnv,
+                         lookupGRE_RdrName, lookupGRE_Name, 
                          Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
                          importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance,
                          unQualSpecOK, qualSpecOK )
@@ -57,7 +58,7 @@ import BasicTypes     ( DeprecTxt )
 import DriverPhases    ( isHsBoot )
 import Util
 import ListSetOps
-import Data.List        ( partition, concatMap, (\\) )
+import Data.List        ( partition, concatMap, (\\), delete )
 import IO              ( openFile, IOMode(..) )
 import Monad           ( when )
 \end{code}
@@ -408,11 +409,6 @@ 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
 
-        traceRn (ppr $ all_avails)
-        traceRn (ppr $ occ_env)
-        traceRn (ppr $ items2)
-        traceRn (ppr $ mkGlobalRdrEnv gres)
-
         return (Just (want_hiding, map fst items2), mkGlobalRdrEnv gres)
   where
        -- This environment is how we map names mentioned in the import
@@ -784,9 +780,18 @@ mkAvailEnv :: [AvailInfo] -> AvailEnv
        -- 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 = nameEnvElts (mkAvailEnv avails)
+nubAvails avails = map normaliseAvail . nameEnvElts . mkAvailEnv $ avails
 \end{code}
 
 
@@ -878,6 +883,7 @@ exports_from_avail Nothing rdr_env imports this_mod
 
 exports_from_avail (Just rdr_items) rdr_env imports this_mod
   = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
+
        return (Just ie_names, exports)
   where
     do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
@@ -935,7 +941,13 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
 
     lookup_ie (IEThingAbs rdr) 
         = do name <- lookupGlobalOccRn rdr
-             return (IEThingAbs name, AvailTC name [name])
+            case lookupGRE_RdrName rdr rdr_env of
+              []    -> panic "RnNames.lookup_ie"
+              elt:_ -> case gre_par elt of
+                         NoParent   -> return (IEThingAbs name, 
+                                               AvailTC name [name])
+                         ParentIs p -> return (IEThingAbs name, 
+                                               AvailTC p [name])
 
     lookup_ie ie@(IEThingAll rdr) 
         = do name <- lookupGlobalOccRn rdr