From: Simon Marlow Date: Tue, 25 Jul 2006 14:08:16 +0000 (+0000) Subject: optimisations to newUnique X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=bb3dcf3988d766149f7793b93210db5f64e91542 optimisations to newUnique It turned out that newUnique was wasting one node of the splittable uniq supply per invocation: it took the current supply, split it, used the unique from one half and stored the other half in the monad. In other words, the unique in the supply stored in the monad was never used. This optimisation fixes that and adds a bit of strictness, which together lead to small reduction in allocations by the compiler, and possibly an improvement in residency (hard to tell for sure when GCs move around). --- diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index f515334..1fa44ca 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -323,17 +323,28 @@ getEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env) \begin{code} newUnique :: TcRnIf gbl lcl Unique -newUnique = do { us <- newUniqueSupply ; - return (uniqFromSupply us) } +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 }}} + -- 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 + -- throw away one half of the new split supply. This is safe because this + -- is the only place we use that unique. Using the other half of the split + -- supply is safer, but slower. newUniqueSupply :: TcRnIf gbl lcl UniqSupply newUniqueSupply = do { env <- getEnv ; let { u_var = env_us env } ; us <- readMutVar u_var ; - let { (us1, us2) = splitUniqSupply us } ; + case splitUniqSupply us of { (us1,us2) -> do { writeMutVar u_var us1 ; - return us2 } + return us2 }}} newLocalName :: Name -> TcRnIf gbl lcl Name newLocalName name -- Make a clone