Switch more uniqFromSupply+splitUniqSupply's to takeUniqFromSupply

diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index a497747..f345b89 100644 (file)
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -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)
             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)
               (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}
 \end{code}
 
 \begin{code}

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 211e8a7..f7a9aa2 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -263,15 +263,13 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
   case lookupOrigNameCache cache  mod occ of
      Just name -> (nc, name)
      Nothing   ->
   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
                 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
 
 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
 serialiseName bh name _ = do

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index a030983..8025f20 100644 (file)
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -854,10 +854,9 @@ tidyTopName mod nc_var maybe_ref occ_env id
 
     (occ_env', occ') = tidyOccName occ_env new_occ
 
 
     (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
                    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
 
     mk_new_external nc = allocateGlobalBinder nc mod occ' loc
        -- If we want to externalise a currently-local name, check

diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 409d0c4..8b9629b 100644 (file)
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -90,8 +90,8 @@ mapAccumLNat f b (x:xs)
 
 getUniqueNat :: NatM Unique
 getUniqueNat = NatM $ \ (NatM_State us delta imports pic dflags) ->
 
 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
 
 
 getDynFlagsNat :: NatM DynFlags

diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 2ce028f..7e744e6 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -293,10 +293,9 @@ type SpillM a      = State SpillS a
 newUnique :: SpillM Unique
 newUnique
  = do   us      <- gets stateUS
 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)
                 return uniq
 
 accSpillSL (r1, s1, l1) (_, s2, l2)

diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs
index b9f7049..234701c 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Linear/State.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/State.hs
@@ -131,8 +131,8 @@ getDeltaR = RegM $ \s -> (# s, ra_delta s #)
 
 getUniqueR :: RegM Unique
 getUniqueR = RegM $ \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.
 
 
 -- | Record that a spill instruction was inserted, for profiling.

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index e3633ec..646abca 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -332,9 +332,9 @@ newUnique
  = do { env <- getEnv ;
         let { u_var = env_us env } ;
         us <- readMutVar u_var ;
  = 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
    -- 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