Commit 14a496fd authored by Ian Lynagh's avatar Ian Lynagh

Switch more uniqFromSupply+splitUniqSupply's to takeUniqFromSupply

parent 00a05a5c
......@@ -478,11 +478,11 @@ mkTupleCase uniqs vars body scrut_var scrut
in mk_tuple_case us' (chunkify vars') body'
one_tuple_case chunk_vars (us, vs, body)
= let (us1, us2) = splitUniqSupply us
scrut_var = mkSysLocal (fsLit "ds") (uniqFromSupply us1)
= let (uniq, us') = takeUniqFromSupply us
scrut_var = mkSysLocal (fsLit "ds") uniq
(mkBoxedTupleTy (map idType chunk_vars))
body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)
in (us2, scrut_var:vs, body')
in (us', scrut_var:vs, body')
\end{code}
\begin{code}
......
......@@ -263,15 +263,13 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
case lookupOrigNameCache cache mod occ of
Just name -> (nc, name)
Nothing ->
let
us = nsUniqs nc
uniq = uniqFromSupply us
case takeUniqFromSupply (nsUniqs nc) of
(uniq, us) ->
let
name = mkExternalName uniq mod occ noSrcSpan
new_cache = extendNameCache cache mod occ name
in
case splitUniqSupply us of { (us',_) ->
( nc{ nsUniqs = us', nsNames = new_cache }, name )
}
in
( nc{ nsUniqs = us, nsNames = new_cache }, name )
serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName bh name _ = do
......
......@@ -854,10 +854,9 @@ tidyTopName mod nc_var maybe_ref occ_env id
(occ_env', occ') = tidyOccName occ_env new_occ
mk_new_local nc = (nc { nsUniqs = us2 }, mkInternalName uniq occ' loc)
mk_new_local nc = (nc { nsUniqs = us }, mkInternalName uniq occ' loc)
where
(us1, us2) = splitUniqSupply (nsUniqs nc)
uniq = uniqFromSupply us1
(uniq, us) = takeUniqFromSupply (nsUniqs nc)
mk_new_external nc = allocateGlobalBinder nc mod occ' loc
-- If we want to externalise a currently-local name, check
......
......@@ -90,8 +90,8 @@ mapAccumLNat f b (x:xs)
getUniqueNat :: NatM Unique
getUniqueNat = NatM $ \ (NatM_State us delta imports pic dflags) ->
case splitUniqSupply us of
(us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports pic dflags))
case takeUniqFromSupply us of
(uniq, us') -> (uniq, (NatM_State us' delta imports pic dflags))
getDynFlagsNat :: NatM DynFlags
......
......@@ -293,10 +293,9 @@ type SpillM a = State SpillS a
newUnique :: SpillM Unique
newUnique
= do us <- gets stateUS
case splitUniqSupply us of
(us1, us2)
-> do let uniq = uniqFromSupply us1
modify $ \s -> s { stateUS = us2 }
case takeUniqFromSupply us of
(uniq, us')
-> do modify $ \s -> s { stateUS = us' }
return uniq
accSpillSL (r1, s1, l1) (_, s2, l2)
......
......@@ -131,8 +131,8 @@ getDeltaR = RegM $ \s -> (# s, ra_delta s #)
getUniqueR :: RegM Unique
getUniqueR = RegM $ \s ->
case splitUniqSupply (ra_us s) of
(us1, us2) -> (# s{ra_us = us2}, uniqFromSupply us1 #)
case takeUniqFromSupply (ra_us s) of
(uniq, us) -> (# s{ra_us = us}, uniq #)
-- | Record that a spill instruction was inserted, for profiling.
......
......@@ -332,9 +332,9 @@ newUnique
= do { env <- getEnv ;
let { u_var = env_us env } ;
us <- readMutVar u_var ;
case splitUniqSupply us of { (us1,_) -> do {
writeMutVar u_var us1 ;
return $! uniqFromSupply us }}}
case takeUniqFromSupply us of { (uniq, us') -> do {
writeMutVar u_var us' ;
return $! uniq }}}
-- NOTE 1: we strictly split the supply, to avoid the possibility of leaving
-- a chain of unevaluated supplies behind.
-- NOTE 2: we use the uniq in the supply from the MutVar directly, and
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment