summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-09-21 12:23:02 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-09-29 09:44:40 -0400
commit42492b7630890e78d80cbb1d3862892fc1d6a8a1 (patch)
tree3789f2c18644983c9f582e41c68b5f29127648a6
parent770fcac8a33983698d0f16249694c76ff649701e (diff)
downloadhaskell-42492b7630890e78d80cbb1d3862892fc1d6a8a1.tar.gz
compiler: Reimplement seqEltsUFM in terms of fold
Rather than nonDetEltsUFM; this should eliminate some unnecessary list allocations.
-rw-r--r--compiler/GHC/Types/Demand.hs2
-rw-r--r--compiler/GHC/Types/Unique/FM.hs4
2 files changed, 3 insertions, 3 deletions
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index 4b9a04b9fb..96b5b21bf7 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -1875,7 +1875,7 @@ seqDmdType (DmdType env ds res) =
seqDmdEnv env `seq` seqDemandList ds `seq` res `seq` ()
seqDmdEnv :: DmdEnv -> ()
-seqDmdEnv env = seqEltsUFM seqDemandList env
+seqDmdEnv env = seqEltsUFM seqDemand env
seqDmdSig :: DmdSig -> ()
seqDmdSig (DmdSig ty) = seqDmdType ty
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index 7c80359d0e..037ced49a6 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -381,8 +381,8 @@ anyUFM p (UFM m) = M.foldr ((||) . p) False m
allUFM :: (elt -> Bool) -> UniqFM key elt -> Bool
allUFM p (UFM m) = M.foldr ((&&) . p) True m
-seqEltsUFM :: ([elt] -> ()) -> UniqFM key elt -> ()
-seqEltsUFM seqList = seqList . nonDetEltsUFM
+seqEltsUFM :: (elt -> ()) -> UniqFM key elt -> ()
+seqEltsUFM seqElt = foldUFM (\v rest -> seqElt v `seq` rest) ()
-- 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.