import Parser
import Lex ( PState(..), ParseResult(..) )
import SrcLoc ( mkSrcLoc )
-import Rename
+import Rename ( checkOldIface, renameModule, renameExpr, closeIfaceDecls )
import Rules ( emptyRuleBase )
import PrelInfo ( wiredInThingEnv, wiredInThings )
import PrelNames ( knownKeyNames )
initPersistentRenamerState :: IO PersistentRenamerState
= do ns <- mkSplitUniqSupply 'r'
return (
- PRS { prsOrig = Orig { origNames = initOrigNames,
+ PRS { prsOrig = Orig { origNS = ns,
+ origNames = initOrigNames,
origIParam = emptyFM },
prsDecls = (emptyNameEnv, 0),
prsInsts = (emptyBag, 0),
- prsRules = (emptyBag, 0),
- prsNS = ns
+ prsRules = (emptyBag, 0)
}
)
= PRS { prsOrig :: OrigNameEnv,
prsDecls :: DeclsMap,
prsInsts :: IfaceInsts,
- prsRules :: IfaceRules,
- prsNS :: UniqSupply
+ prsRules :: IfaceRules
}
\end{code}
\begin{code}
data OrigNameEnv
- = Orig { origNames :: OrigNameNameEnv,
+ = Orig { origNS :: UniqSupply,
+ -- Supply of uniques
+ origNames :: OrigNameNameEnv,
-- Ensures that one original name gets one unique
origIParam :: OrigNameIParamEnv
-- Ensures that one implicit parameter name gets one unique
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,
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
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
-- 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
-- (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
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
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
import RdrHsSyn
import RnHsSyn ( RenamedFixitySig )
import HscTypes ( AvailEnv, lookupType,
- OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
+ OrigNameEnv(..),
WhetherHasOrphans, ImportVersion,
PersistentRenamerState(..), IsBootInterface, Avails,
DeclsMap, IfaceInsts, IfaceRules,
-- so it has a Module, so it can be looked up
rn_errs :: IORef Messages,
-
- -- The second and third components are a flattened-out OrigNameEnv
- rn_ns :: IORef (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv),
+ rn_ns :: IORef OrigNameEnv,
rn_ifaces :: IORef Ifaces
}
-- and we don't want thereby to try to suck it in!
iVSlurp = (emptyModuleSet, emptyNameSet)
}
- let uniqs = prsNS prs
-
- names_var <- newIORef (uniqs, origNames (prsOrig prs),
- origIParam (prsOrig prs))
+ names_var <- newIORef (prsOrig prs)
errs_var <- newIORef (emptyBag,emptyBag)
iface_var <- newIORef ifaces
let rn_down = RnDown { rn_mod = mod,
res <- do_rn rn_down ()
-- Grab state and record it
- (warns, errs) <- readIORef errs_var
- new_ifaces <- readIORef iface_var
- (new_NS, new_origN, new_origIP) <- readIORef names_var
- let new_orig = Orig { origNames = new_origN, origIParam = new_origIP }
+ (warns, errs) <- readIORef errs_var
+ new_ifaces <- readIORef iface_var
+ new_orig <- readIORef names_var
let new_prs = prs { prsOrig = new_orig,
prsDecls = iDecls new_ifaces,
prsInsts = iInsts new_ifaces,
- prsRules = iRules new_ifaces,
- prsNS = new_NS }
+ prsRules = iRules new_ifaces }
let new_pcs = pcs { pcs_PIT = iPIT new_ifaces,
pcs_PRS = new_prs }
-- and that doesn't happen in pragmas etc
do { us <- mkSplitUniqSupply 'r'
- ; names_var <- newIORef (us, origNames (prsOrig prs),
- origIParam (prsOrig prs))
+ ; names_var <- newIORef ((prsOrig prs) { origNS = us })
; errs_var <- newIORef (emptyBag,emptyBag)
; let rn_down = RnDown { rn_dflags = dflags,
%=====================
\begin{code}
-getNameSupplyRn :: RnM d (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv)
+getNameSupplyRn :: RnM d OrigNameEnv
getNameSupplyRn rn_down l_down
= readIORef (rn_ns rn_down)
-setNameSupplyRn :: (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv) -> RnM d ()
+setNameSupplyRn :: OrigNameEnv -> RnM d ()
setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
= writeIORef names_var names'
getUniqRn :: RnM d Unique
getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, cache, ipcache) ->
+ = readIORef names_var >>= \ ns ->
let
- (us1,us') = splitUniqSupply us
+ (us1,us') = splitUniqSupply (origNS ns)
in
- writeIORef names_var (us', cache, ipcache) >>
+ writeIORef names_var (ns {origNS = us'}) >>
return (uniqFromSupply us1)
\end{code}
projects / ghc-hetmet.git / commitdiff