[project @ 2000-12-07 08:22:53 by simonpj]

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

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 40dc61a..0dc76fe 100644 (file)
--- 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