From: simonpj <unknown>
Date: Mon, 3 Nov 2003 15:27:09 +0000 (+0000)
Subject: [project @ 2003-11-03 15:27:08 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~285
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=a195d525eb3ad5fd60a8797191c31907e6d9bfb0

[project @ 2003-11-03 15:27:08 by simonpj]
Wibble to subordinate names
---

diff --git a/ghc/compiler/iface/IfaceEnv.lhs b/ghc/compiler/iface/IfaceEnv.lhs
index 60c2ecb..d0c5d8f 100644
--- a/ghc/compiler/iface/IfaceEnv.lhs
+++ b/ghc/compiler/iface/IfaceEnv.lhs
@@ -4,7 +4,7 @@
 module IfaceEnv (
 	newGlobalBinder, newIPName, newImplicitBinder, 
 	lookupIfaceTop, lookupIfaceExt,
-	lookupOrig, lookupImplicitOrig, lookupIfaceTc,
+	lookupOrig, lookupIfaceTc,
 	newIfaceName, newIfaceNames,
 	extendIfaceIdEnv, extendIfaceTyVarEnv,
 	tcIfaceGlobal, tcIfaceTyCon, tcIfaceClass, tcIfaceExtId,
@@ -145,24 +145,10 @@ lookupOrig :: ModuleName -> OccName -> TcRnIf a b Name
 -- We fake up 
 --	Module to AnotherPackage
 -- 	SrcLoc to noSrcLoc
+--	Parent no Nothing
 -- They'll be overwritten, in due course, by LoadIface.loadDecl.
-lookupOrig mod_name occ = lookupOrig_help mod_name occ Nothing
-
-lookupImplicitOrig :: Name -> OccName -> TcRnIf m n Name
--- Same as lookupOrig, but install (Just parent) as the 
--- parent Name.   This is used when looking at the exports 
--- of an interface:
---   Suppose module M exports type A.T, and constructor A.MkT
---   Then, we know that A.MkT is an implicit name of A.T,
---   even though we aren't at the binding site of A.T
---   And it's important, because we may simply re-export A.T
---   without ever sucking in the declaration itself.
-lookupImplicitOrig name occ
-  = lookupOrig_help (nameModuleName name) occ (Just name)
-
-lookupOrig_help :: ModuleName -> OccName -> Maybe Name -> TcRnIf a b Name
--- Local helper, not exported
-lookupOrig_help mod_name occ mb_parent
+
+lookupOrig mod_name occ 
   = do 	{ 	-- First ensure that mod_name and occ are evaluated
 		-- If not, chaos can ensue:
 		-- 	we read the name-cache
@@ -178,7 +164,7 @@ lookupOrig_help mod_name occ mb_parent
 
 	{ let { (us', us1)      = splitUniqSupply (nsUniqs name_supply)
 	      ;	uniq   	  	= uniqFromSupply us1
-	      ;	name            = mkExternalName uniq tmp_mod occ mb_parent noSrcLoc
+	      ;	name            = mkExternalName uniq tmp_mod occ Nothing noSrcLoc
 	      ;	new_cache       = extend_name_cache (nsNames name_supply) tmp_mod occ name
 	      ;	new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
 	      ;	tmp_mod    	= mkPackageModule mod_name 
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index f394f43..eb87208 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -18,13 +18,13 @@ import HsSyn		( IE(..), ieName, ImportDecl(..),
 			)
 import RdrHsSyn		( RdrNameIE, RdrNameImportDecl, main_RDR_Unqual )
 import RnEnv
-import IfaceEnv		( lookupOrig, lookupImplicitOrig )
+import IfaceEnv		( lookupOrig, newGlobalBinder )
 import LoadIface	( loadSrcInterface )
 import TcRnMonad
 
 import FiniteMap
 import PrelNames	( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName )
-import Module		( Module, ModuleName, moduleName, 
+import Module		( Module, ModuleName, moduleName, mkPackageModule,
 			  moduleNameUserString, isHomeModule,
 			  unitModuleEnvByName, unitModuleEnv, 
 			  lookupModuleEnvByName, moduleEnvElts )
@@ -46,6 +46,7 @@ import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace,
 			  isLocalGRE, pprNameProvenance )
 import Outputable
 import Maybes		( isJust, isNothing, catMaybes, mapCatMaybes )
+import SrcLoc		( noSrcLoc )
 import ListSetOps	( removeDups )
 import Util		( sortLt, notNull )
 import List		( partition, insert )
@@ -245,15 +246,24 @@ exportsToAvails exports
 	; return (concat avails_by_module) }
   where
     do_one (mod_name, exports) = mapM (do_avail mod_name) exports
-    do_avail mod (Avail n)      = do { n' <- lookupOrig mod n; 
-			 	     ; return (Avail n') }
-    do_avail mod (AvailTC n ns) = do { n' <- lookupOrig mod n
-				     ; ns' <- mappM (lookupImplicitOrig n') ns
-				     ; return (AvailTC n' ns') }
-	-- Note the lookupImplicitOrig.  It ensures that the subordinate names
-	-- record their parent; and that in turn ensures that the GlobalRdrEnv
-	-- has the correct parent for all the names in its range.
-	-- For imported things, we only suck in the binding site later, if ever.
+    do_avail mod_nm (Avail n)      = do { n' <- lookupOrig mod_nm n; 
+					; return (Avail n') }
+    do_avail mod_nm (AvailTC n ns) = do { n' <- lookupOrig mod_nm n
+					; ns' <- mappM (lookup_sub n') ns
+					; return (AvailTC n' ns') }
+	where
+	  mod = mkPackageModule mod_nm	-- Not necessarily right yet
+	  lookup_sub parent occ = newGlobalBinder mod occ (Just parent) noSrcLoc
+		-- Hack alert! Notice the newGlobalBinder.  It ensures that the subordinate 
+		-- names record their parent; and that in turn ensures that the GlobalRdrEnv
+		-- has the correct parent for all the names in its range.
+		-- For imported things, we only suck in the binding site later, if ever.
+	-- Reason for all this:
+	--   Suppose module M exports type A.T, and constructor A.MkT
+	--   Then, we know that A.MkT is a subordinate name of A.T,
+	--   even though we aren't at the binding site of A.T
+	--   And it's important, because we may simply re-export A.T
+	--   without ever sucking in the declaration itself.
 
 warnRedundantSourceImport mod_name
   = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")