[project @ 2000-10-25 15:57:33 by simonpj]

writeIface stuff

5 files changed, 53 insertions, 32 deletions

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 0b7449a68d..eb18d9d9a1 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -27,7 +27,7 @@ import RnIfaces		( slurpImpDecls, mkImportInfo,
 			)
 import RnHiFiles	( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
 import RnEnv		( availName, availsToNameSet, 
-			  emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, sortAvails,
+			  emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
 			  warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
 			  lookupOrigNames, lookupGlobalRn, newGlobalName
 			)
@@ -168,7 +168,7 @@ rename this_module this_mod@(HsModule mod_name vers exports imports local_decls
 
 
 	-- Sort the exports to make them easier to compare for versions
-	my_exports = sortAvails export_avails
+	my_exports = groupAvails export_avails
 	
 	mod_iface = ModIface {	mi_module   = this_module,
 				mi_version  = initialVersionInfo,
@@ -664,13 +664,18 @@ printMinimalImports mod_name imps
     to_ie (Avail n)       = returnRn (IEVar n)
     to_ie (AvailTC n [m]) = ASSERT( n==m ) 
 			    returnRn (IEThingAbs n)
-    to_ie (AvailTC n ns)  = getInterfaceExports (moduleName (nameModule n)) 
-						ImportBySystem	 	`thenRn` \ (_, avails) ->
-			    case [ms | AvailTC m ms <- avails, m == n] of
-			      [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
-				   | otherwise	        -> returnRn (IEThingWith n (filter (/= n) ns))
-			      other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
-				       returnRn (IEVar n)
+    to_ie (AvailTC n ns)  
+	= getInterfaceExports n_mod ImportBySystem		`thenRn` \ (_, avails_by_module) ->
+	  case [xs | (m,as) <- avails_by_module,
+		     m == n_mod,
+		     AvailTC x xs <- as, 
+		     x == n] of
+	      [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
+		   | otherwise	        -> returnRn (IEThingWith n (filter (/= n) ns))
+	      other			-> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
+					   returnRn (IEVar n)
+	where
+	  n_mod = moduleName (nameModule n)
 
 rnDump  :: [RenamedHsDecl] 	-- Renamed imported decls
 	-> [RenamedHsDecl] 	-- Renamed local decls
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 3b33542f14..4fc2a3ab98 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -27,7 +27,7 @@ import Name		( Name, NamedThing(..),
 			)
 import NameSet
 import OccName		( OccName, occNameUserString, occNameFlavour )
-import Module		( ModuleName, moduleName, mkVanillaModule )
+import Module		( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS )
 import FiniteMap
 import Unique		( Unique )
 import UniqSupply
@@ -38,6 +38,7 @@ import Util		( sortLt )
 import List		( nub )
 import PrelNames	( mkUnboundName )
 import CmdLineOpts
+import FastString	( FastString )
 \end{code}
 
 %*********************************************************
@@ -638,18 +639,28 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
 filterAvail ie avail = Nothing
 
 -------------------------------------
-sortAvails :: Avails -> Avails
-sortAvails avails = sortLt lt avails
+groupAvails :: Avails -> [(ModuleName, Avails)]
+  -- Group by module and sort by occurrence
+  -- This keeps the list in canonical order
+groupAvails avails 
+  = [ (mkSysModuleNameFS fs, sortLt lt avails)
+    | (fs,avails) <- fmToList groupFM
+    ]
   where
-    a1 `lt` a2 = mod1 < mod2 ||
-	         (mod1 == mod2 && occ1 < occ2)
+    groupFM :: FiniteMap FastString Avails
+	-- Deliberatey use the FastString so we
+	-- get a canonical ordering
+    groupFM = foldl add emptyFM avails
+
+    add env avail = addToFM_C combine env mod_fs [avail]
+		  where
+		    mod_fs = moduleNameFS (moduleName (nameModule (availName avail)))
+		    combine old _ = avail:old
+
+    a1 `lt` a2 = occ1 < occ2
 	       where
-		 name1 = availName a1
-		 name2 = availName a2
-		 mod1  = nameModule name1
-		 mod2  = nameModule name2
-		 occ1  = nameOccName name1
-		 occ2  = nameOccName name2
+		 occ1  = nameOccName (availName a1)
+		 occ2  = nameOccName (availName a2)
 				
 -------------------------------------
 pprAvail :: AvailInfo -> SDoc
diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index 4e067b9de5..9b01c3e770 100644
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -240,16 +240,16 @@ addModDeps mod new_deps mod_deps
 --	Loading the export list
 -----------------------------------------------------
 
-loadExports :: (Version, [ExportItem]) -> RnM d (Version, Avails)
+loadExports :: (Version, [ExportItem]) -> RnM d (Version, [(ModuleName,Avails)])
 loadExports (vers, items)
   = getModuleRn 				`thenRn` \ this_mod ->
     mapRn (loadExport this_mod) items		`thenRn` \ avails_s ->
-    returnRn (vers, concat avails_s)
+    returnRn (vers, avails_s)
 
 
-loadExport :: Module -> ExportItem -> RnM d [AvailInfo]
+loadExport :: Module -> ExportItem -> RnM d (ModuleName, Avails)
 loadExport this_mod (mod, entities)
-  | mod == moduleName this_mod = returnRn []
+  | mod == moduleName this_mod = returnRn (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 reported.  Easiest thing is just to
@@ -267,7 +267,8 @@ loadExport this_mod (mod, entities)
 	-- but it's a bogus thing to do!
 
   | otherwise
-  = mapRn (load_entity mod) entities
+  = mapRn (load_entity mod) entities	`thenRn` \ avails ->
+    returnRn (mod, avails)
   where
     new_name mod occ = newGlobalName mod occ
 
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index b7af688af7..a56da3b240 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -67,7 +67,7 @@ import List		( nub )
 @getInterfaceExports@ is called only for directly-imported modules.
 
 \begin{code}
-getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
+getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, [(ModuleName,Avails)])
 getInterfaceExports mod_name from
   = getHomeIfaceTableRn 		`thenRn` \ hit ->
     case lookupModuleEnvByName hit mod_name of {
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index a33df882cb..e2094c8100 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -169,15 +169,19 @@ importsFromImportDecl :: (Name -> Bool)		-- OK to omit qualifier
 
 importsFromImportDecl is_unqual (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
   = pushSrcLocRn iloc $
-    getInterfaceExports imp_mod_name from	`thenRn` \ (imp_mod, avails) ->
+    getInterfaceExports imp_mod_name from	`thenRn` \ (imp_mod, avails_by_module) ->
 
-    if null avails then
+    if null avails_by_module then
 	-- If there's an error in getInterfaceExports, (e.g. interface
 	-- file not found) we get lots of spurious errors from 'filterImports'
 	returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name)
     else
 
-    filterImports imp_mod_name import_spec avails   `thenRn` \ (filtered_avails, hides, explicits) ->
+    let
+	avails :: Avails
+	avails = concat (map snd avails_by_module)
+    in
+    filterImports imp_mod_name import_spec avails	`thenRn` \ (filtered_avails, hides, explicits) ->
 
     let
 	mk_provenance name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits)) 
@@ -295,7 +299,7 @@ filterImports :: ModuleName			-- The module being imported
 filterImports mod Nothing imports
   = returnRn (imports, [], emptyNameSet)
 
-filterImports mod (Just (want_hiding, import_items)) avails
+filterImports mod (Just (want_hiding, import_items)) total_avails
   = flatMapRn get_item import_items		`thenRn` \ avails_w_explicits ->
     let
 	(item_avails, explicits_s) = unzip avails_w_explicits
@@ -304,14 +308,14 @@ filterImports mod (Just (want_hiding, import_items)) avails
     if want_hiding 
     then	
 	-- All imported; item_avails to be hidden
-	returnRn (avails, item_avails, emptyNameSet)
+	returnRn (total_avails, item_avails, emptyNameSet)
     else
 	-- Just item_avails imported; nothing to be hidden
 	returnRn (item_avails, [], explicits)
   where
     import_fm :: FiniteMap OccName AvailInfo
     import_fm = listToFM [ (nameOccName name, avail) 
-			 | avail <- avails,
+			 | avail <- total_avails,
 			   name  <- availNames avail]
 	-- Even though availNames returns data constructors too,
 	-- they won't make any difference because naked entities like T