X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=0dc76fe3da19e68fddaa5c2e27b642c3f26360ab;hb=9fc29e6eedbb0cee53960a0664d99c0b2c33f3d7;hp=40dc61ac6ad81a7199952f2bcdddbebf60479202;hpb=275085675cabfdf5d3298d436aa1cf3aaf3291ca;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 40dc61a..0dc76fe 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -16,7 +16,7 @@ import RdrName		( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
 import HsTypes		( hsTyVarName, replaceTyVarName )
 import HscTypes		( Provenance(..), pprNameProvenance, hasBetterProv,
 			  ImportReason(..), GlobalRdrEnv, AvailEnv,
-			  AvailInfo, Avails, GenAvailInfo(..) )
+			  AvailInfo, Avails, GenAvailInfo(..), OrigNameEnv(..) )
 import RnMonad
 import Name		( Name, NamedThing(..),
 			  getSrcLoc, 
@@ -67,10 +67,11 @@ newTopBinder mod rdr_name loc
 	returnRn ()
     )				`thenRn_`
 
-    getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+    getNameSupplyRn		`thenRn` \ name_supply -> 
     let 
 	occ = rdrNameOcc rdr_name
 	key = (moduleName mod, occ)
+	cache = origNames name_supply
     in
     case lookupFM cache key of
 
@@ -85,7 +86,7 @@ newTopBinder mod rdr_name loc
 			new_name  = setNameModuleAndLoc name mod loc
 			new_cache = addToFM cache key new_name
 		     in
-		     setNameSupplyRn (us, new_cache, ipcache)	`thenRn_`
+		     setNameSupplyRn (name_supply {origNames = new_cache})	`thenRn_`
 		     traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
 		     returnRn new_name
 		     
@@ -94,12 +95,12 @@ newTopBinder mod rdr_name loc
 	-- Even for locally-defined names we use implicitImportProvenance; 
 	-- updateProvenances will set it to rights
 	Nothing -> let
-			(us', us1) = splitUniqSupply us
+			(us', us1) = splitUniqSupply (origNS name_supply)
 			uniq   	   = uniqFromSupply us1
 			new_name   = mkGlobalName uniq mod occ loc
 			new_cache  = addToFM cache key new_name
 		   in
-		   setNameSupplyRn (us', new_cache, ipcache)	`thenRn_`
+		   setNameSupplyRn (name_supply {origNS = us', origNames = new_cache})	`thenRn_`
 		   traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
 		   returnRn new_name
 
@@ -123,32 +124,36 @@ newGlobalName :: ModuleName -> OccName -> RnM d Name
   -- (but since it affects DLL-ery it does matter that we get it right
   --  in the end).
 newGlobalName mod_name occ
-  = getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+  = getNameSupplyRn		`thenRn` \ name_supply ->
     let
 	key = (mod_name, occ)
+	cache = origNames name_supply
     in
     case lookupFM cache key of
 	Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
 		     returnRn name
 
-	Nothing   -> setNameSupplyRn (us', new_cache, ipcache)			`thenRn_`
-		     -- traceRn (text "newGlobalName: new" <+> ppr name)	`thenRn_`
+	Nothing   -> setNameSupplyRn (name_supply {origNS = us', origNames = new_cache})  `thenRn_`
+		     -- traceRn (text "newGlobalName: new" <+> ppr name)		  `thenRn_`
 		     returnRn name
 		  where
-		     (us', us1) = splitUniqSupply us
+		     (us', us1) = splitUniqSupply (origNS name_supply)
 		     uniq   	= uniqFromSupply us1
 		     mod        = mkVanillaModule mod_name
 		     name       = mkGlobalName uniq mod occ noSrcLoc
 		     new_cache  = addToFM cache key name
 
 newIPName rdr_name
-  = getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+  = getNameSupplyRn		`thenRn` \ name_supply ->
+    let
+	ipcache = origIParam name_supply
+    in
     case lookupFM ipcache key of
 	Just name -> returnRn name
-	Nothing   -> setNameSupplyRn (us', cache, new_ipcache)	`thenRn_`
+	Nothing   -> setNameSupplyRn (name_supply {origNS = us', origIParam = new_ipcache})	`thenRn_`
 		     returnRn name
 		  where
-		     (us', us1)  = splitUniqSupply us
+		     (us', us1)  = splitUniqSupply (origNS name_supply)
 		     uniq   	 = uniqFromSupply us1
 		     name        = mkIPName uniq key
 		     new_ipcache = addToFM ipcache key name
@@ -298,16 +303,16 @@ lookupSysBinder rdr_name
 newLocalsRn :: [(RdrName,SrcLoc)]
 	    -> RnMS [Name]
 newLocalsRn rdr_names_w_loc
- =  getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+ =  getNameSupplyRn		`thenRn` \ name_supply ->
     let
 	n	   = length rdr_names_w_loc
-	(us', us1) = splitUniqSupply us
+	(us', us1) = splitUniqSupply (origNS name_supply)
 	uniqs	   = uniqsFromSupply n us1
 	names	   = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
 		     | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
 		     ]
     in
-    setNameSupplyRn (us', cache, ipcache)	`thenRn_`
+    setNameSupplyRn (name_supply {origNS = us'})	`thenRn_`
     returnRn names
 
 
@@ -353,13 +358,13 @@ bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
 bindCoreLocalRn rdr_name enclosed_scope
   = getSrcLocRn 		`thenRn` \ loc ->
     getLocalNameEnv		`thenRn` \ name_env ->
-    getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+    getNameSupplyRn		`thenRn` \ name_supply ->
     let
-	(us', us1) = splitUniqSupply us
+	(us', us1) = splitUniqSupply (origNS name_supply)
 	uniq	   = uniqFromSupply us1
 	name	   = mkLocalName uniq (rdrNameOcc rdr_name) loc
     in
-    setNameSupplyRn (us', cache, ipcache)	`thenRn_`
+    setNameSupplyRn (name_supply {origNS = us'})	`thenRn_`
     let
 	new_name_env = extendRdrEnv name_env rdr_name name
     in