[commit: ghc] master: Kill varEnvElts in seqDmdEnv (0ab63cf)

git at git.haskell.org git at git.haskell.org
Fri Jul 1 15:22:11 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/0ab63cf48580abbfe15ece934aec093203f29ed2/ghc

>---------------------------------------------------------------

commit 0ab63cf48580abbfe15ece934aec093203f29ed2
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Fri Jul 1 06:50:55 2016 -0700

    Kill varEnvElts in seqDmdEnv
    
    GHC Trac: #4012


>---------------------------------------------------------------

0ab63cf48580abbfe15ece934aec093203f29ed2
 compiler/basicTypes/Demand.hs | 3 +--
 compiler/utils/UniqFM.hs      | 8 +++++++-
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 9165782..8dc7f3b 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -1306,8 +1306,7 @@ seqDmdType (DmdType env ds res) =
   seqDmdEnv env `seq` seqDemandList ds `seq` seqDmdResult res `seq` ()
 
 seqDmdEnv :: DmdEnv -> ()
-seqDmdEnv env = seqDemandList (varEnvElts env)
-
+seqDmdEnv env = seqEltsUFM seqDemandList env
 
 splitDmdTy :: DmdType -> (Demand, DmdType)
 -- Split off one function argument
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 261dd1c..bb9d95c 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -54,7 +54,7 @@ module UniqFM (
         intersectUFM_C,
         disjointUFM,
         nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
-        anyUFM, allUFM,
+        anyUFM, allUFM, seqEltsUFM,
         mapUFM, mapUFM_Directly,
         elemUFM, elemUFM_Directly,
         filterUFM, filterUFM_Directly, partitionUFM,
@@ -292,6 +292,12 @@ anyUFM p (UFM m) = M.fold ((||) . p) False m
 allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
 allUFM p (UFM m) = M.fold ((&&) . p) True m
 
+seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> ()
+seqEltsUFM seqList = seqList . nonDetEltsUFM
+  -- It's OK to use nonDetEltsUFM here because the type guarantees that
+  -- the only interesting thing this function can do is to force the
+  -- elements.
+
 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
 -- If you use this please provide a justification why it doesn't introduce
 -- nondeterminism.



More information about the ghc-commits mailing list