Improve some folds over Uniq[D]FMwip/sjakobi/nondetfolds

* Replace some non-deterministic lazy folds with
  strict folds.
* Replace some O(n log n) folds in deterministic order
  with O(n) non-deterministic folds.
* Replace some folds with set-operations on the underlying
  IntMaps.

This reduces max residency when compiling
`nofib/spectral/simple/Main.hs` with -O0 by about 1%.

Maximum residency when compiling Cabal also seems reduced on the
order of 3-9%.

21 files changed, 134 insertions, 86 deletions

diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
index c810aeeac4..ec77d91185 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
@@ -554,8 +554,9 @@ delAssoc :: (Uniquable a)
 delAssoc a m
         | Just aSet     <- lookupUFM  m a
         , m1            <- delFromUFM m a
-        = nonDetFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
-          -- It's OK to use nonDetFoldUFM here because deletion is commutative
+        = nonDetStrictFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
+          -- It's OK to use a non-deterministic fold here because deletion is
+          -- commutative
 
         | otherwise     = m
 
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs
index 1c01f4fddd..c2308761b9 100644
--- a/compiler/GHC/Core/FamInstEnv.hs
+++ b/compiler/GHC/Core/FamInstEnv.hs
@@ -380,8 +380,8 @@ famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts]
   -- See Note [FamInstEnv determinism]
 
 famInstEnvSize :: FamInstEnv -> Int
-famInstEnvSize = nonDetFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0
-  -- It's OK to use nonDetFoldUDFM here since we're just computing the
+famInstEnvSize = nonDetStrictFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0
+  -- It's OK to use nonDetStrictFoldUDFM here since we're just computing the
   -- size.
 
 familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index f9e2b267b2..c4f714eef1 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -2245,8 +2245,8 @@ extendFvs env s
   = (s `unionVarSet` extras, extras `subVarSet` s)
   where
     extras :: VarSet    -- env(s)
-    extras = nonDetFoldUFM unionVarSet emptyVarSet $
-      -- It's OK to use nonDetFoldUFM here because unionVarSet commutes
+    extras = nonDetStrictFoldUFM unionVarSet emptyVarSet $
+      -- It's OK to use nonDetStrictFoldUFM here because unionVarSet commutes
              intersectUFM_C (\x _ -> x) env (getUniqSet s)
 
 {-
@@ -2567,8 +2567,8 @@ addManyOcc v u | isId v    = addManyOccId u v
         --      (Same goes for INLINE.)
 
 addManyOccs :: UsageDetails -> VarSet -> UsageDetails
-addManyOccs usage id_set = nonDetFoldUniqSet addManyOcc usage id_set
-  -- It's OK to use nonDetFoldUFM here because addManyOcc commutes
+addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set
+  -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes
 
 delDetails :: UsageDetails -> Id -> UsageDetails
 delDetails ud bndr
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs
index 8f5d9c654a..ed6f4c61fe 100644
--- a/compiler/GHC/Core/Opt/SetLevels.hs
+++ b/compiler/GHC/Core/Opt/SetLevels.hs
@@ -83,7 +83,7 @@ import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.Var
 import GHC.Types.Var.Set
-import GHC.Types.Unique.Set   ( nonDetFoldUniqSet )
+import GHC.Types.Unique.Set   ( nonDetStrictFoldUniqSet )
 import GHC.Types.Unique.DSet  ( getUniqDSet )
 import GHC.Types.Var.Env
 import GHC.Types.Literal      ( litIsTrivial )
@@ -1469,8 +1469,8 @@ isFunction (_, AnnLam b e) | isId b    = True
 isFunction _                           = False
 
 countFreeIds :: DVarSet -> Int
-countFreeIds = nonDetFoldUDFM add 0 . getUniqDSet
-  -- It's OK to use nonDetFoldUDFM here because we're just counting things.
+countFreeIds = nonDetStrictFoldUDFM add 0 . getUniqDSet
+  -- It's OK to use nonDetStrictFoldUDFM here because we're just counting things.
   where
     add :: Var -> Int -> Int
     add v n | isId v    = n+1
@@ -1581,12 +1581,14 @@ placeJoinCeiling le@(LE { le_ctxt_lvl = lvl })
 
 maxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level
 maxFvLevel max_me env var_set
-  = foldDVarSet (maxIn max_me env) tOP_LEVEL var_set
+  = nonDetStrictFoldDVarSet (maxIn max_me env) tOP_LEVEL var_set
+    -- It's OK to use a non-deterministic fold here because maxIn commutes.
 
 maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level
 -- Same but for TyCoVarSet
 maxFvLevel' max_me env var_set
-  = nonDetFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set
+  = nonDetStrictFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set
+    -- It's OK to use a non-deterministic fold here because maxIn commutes.
 
 maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level
 maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 09af3d9d2d..92cd8fdb7e 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -2431,8 +2431,8 @@ unionCallInfoSet (CIS f calls1) (CIS _ calls2) =
 
 callDetailsFVs :: CallDetails -> VarSet
 callDetailsFVs calls =
-  nonDetFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls
-  -- It's OK to use nonDetFoldUDFM here because we forget the ordering
+  nonDetStrictFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls
+  -- It's OK to use nonDetStrictFoldUDFM here because we forget the ordering
   -- immediately by converting to a nondeterministic set.
 
 callInfoFVs :: CallInfoSet -> VarSet
diff --git a/compiler/GHC/Core/TyCo/FVs.hs b/compiler/GHC/Core/TyCo/FVs.hs
index f54cbe71b3..e6083eb521 100644
--- a/compiler/GHC/Core/TyCo/FVs.hs
+++ b/compiler/GHC/Core/TyCo/FVs.hs
@@ -441,7 +441,7 @@ deepCoVarFolder = TyCoFolder { tcf_view = noView
 closeOverKinds :: TyCoVarSet -> TyCoVarSet
 -- For each element of the input set,
 -- add the deep free variables of its kind
-closeOverKinds vs = nonDetFoldVarSet do_one vs vs
+closeOverKinds vs = nonDetStrictFoldVarSet do_one vs vs
   where
     do_one v acc = appEndo (deep_ty (varType v)) acc
 
diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs
index 3801126ba9..8eac3fbf63 100644
--- a/compiler/GHC/Core/Unify.hs
+++ b/compiler/GHC/Core/Unify.hs
@@ -658,9 +658,9 @@ niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet
 -- remembering that the substitution isn't necessarily idempotent
 -- This is used in the occurs check, before extending the substitution
 niSubstTvSet tsubst tvs
-  = nonDetFoldUniqSet (unionVarSet . get) emptyVarSet tvs
-  -- It's OK to nonDetFoldUFM here because we immediately forget the
-  -- ordering by creating a set.
+  = nonDetStrictFoldUniqSet (unionVarSet . get) emptyVarSet tvs
+  -- It's OK to use a non-deterministic fold here because we immediately forget
+  -- the ordering by creating a set.
   where
     get tv
       | Just ty <- lookupVarEnv tsubst tv
diff --git a/compiler/GHC/Data/Graph/Ops.hs b/compiler/GHC/Data/Graph/Ops.hs
index 7d9ce669c6..61f8bfe431 100644
--- a/compiler/GHC/Data/Graph/Ops.hs
+++ b/compiler/GHC/Data/Graph/Ops.hs
@@ -79,8 +79,8 @@ addNode k node graph
  = let
         -- add back conflict edges from other nodes to this one
         map_conflict =
-          nonDetFoldUniqSet
-            -- It's OK to use nonDetFoldUFM here because the
+          nonDetStrictFoldUniqSet
+            -- It's OK to use a non-deterministic fold here because the
             -- operation is commutative
             (adjustUFM_C (\n -> n { nodeConflicts =
                                       addOneToUniqSet (nodeConflicts n) k}))
@@ -89,8 +89,8 @@ addNode k node graph
 
         -- add back coalesce edges from other nodes to this one
         map_coalesce =
-          nonDetFoldUniqSet
-            -- It's OK to use nonDetFoldUFM here because the
+          nonDetStrictFoldUniqSet
+            -- It's OK to use a non-deterministic fold here because the
             -- operation is commutative
             (adjustUFM_C (\n -> n { nodeCoalesce =
                                       addOneToUniqSet (nodeCoalesce n) k}))
@@ -492,9 +492,9 @@ freezeNode k
                 else node       -- panic "GHC.Data.Graph.Ops.freezeNode: edge to freeze wasn't in the coalesce set"
                                 -- If the edge isn't actually in the coelesce set then just ignore it.
 
-        fm2     = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1
-                    -- It's OK to use nonDetFoldUFM here because the operation
-                    -- is commutative
+        fm2     = nonDetStrictFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1
+                    -- It's OK to use a non-deterministic fold here because the
+                    -- operation is commutative
                         $ nodeCoalesce node
 
     in  fm2
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 182466bd7d..fef8fb03c4 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -261,9 +261,9 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
     -- ent_map groups together all the things imported and used
     -- from a particular module
     ent_map :: ModuleEnv [OccName]
-    ent_map  = nonDetFoldUniqSet add_mv emptyModuleEnv used_names
-     -- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
-     -- in ent_hashs
+    ent_map  = nonDetStrictFoldUniqSet add_mv emptyModuleEnv used_names
+     -- nonDetStrictFoldUniqSet is OK here. If you follow the logic, we sort by
+     -- OccName in ent_hashs
      where
       add_mv name mv_map
         | isWiredInName name = mv_map  -- ignore wired-in names
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index a4ca8a5165..73d491776d 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1400,8 +1400,8 @@ depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs
 
 toParents :: GlobalRdrEnv -> NameSet -> NameSet
 toParents rdr_env ns
-  = nonDetFoldUniqSet add emptyNameSet ns
-  -- It's OK to use nonDetFoldUFM because we immediately forget the
+  = nonDetStrictFoldUniqSet add emptyNameSet ns
+  -- It's OK to use a non-deterministic fold because we immediately forget the
   -- ordering by creating a set
   where
     add n s = extendNameSet s (getParent rdr_env n)
diff --git a/compiler/GHC/Stg/Lift/Analysis.hs b/compiler/GHC/Stg/Lift/Analysis.hs
index f6a955adb3..3eea75b21e 100644
--- a/compiler/GHC/Stg/Lift/Analysis.hs
+++ b/compiler/GHC/Stg/Lift/Analysis.hs
@@ -545,7 +545,8 @@ closureGrowth expander sizer group abs_ids = go
         -- we lift @f@
         newbies = abs_ids `minusDVarSet` clo_fvs'
         -- Lifting @f@ removes @f@ from the closure but adds all @newbies@
-        cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs
+        cost = nonDetStrictFoldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs
+        -- Using a non-deterministic fold is OK here because addition is commutative.
     go (RhsSk body_dmd body)
       -- The conservative assumption would be that
       --   1. Every RHS with positive growth would be called multiple times,
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index 40266c3319..f790d4e98c 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -1851,11 +1851,13 @@ neededEvVars implic@(Implic { ic_given = givens
       ; tcvs     <- TcS.getTcEvTyCoVars ev_binds_var
 
       ; let seeds1        = foldr add_implic_seeds old_needs implics
-            seeds2        = foldEvBindMap add_wanted seeds1 ev_binds
+            seeds2        = nonDetStrictFoldEvBindMap add_wanted seeds1 ev_binds
+                            -- It's OK to use a non-deterministic fold here
+                            -- because add_wanted is commutative
             seeds3        = seeds2 `unionVarSet` tcvs
             need_inner    = findNeededEvVars ev_binds seeds3
             live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds
-            need_outer    = foldEvBindMap del_ev_bndr need_inner live_ev_binds
+            need_outer    = varSetMinusEvBindMap need_inner live_ev_binds
                             `delVarSetList` givens
 
       ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds
@@ -1879,9 +1881,6 @@ neededEvVars implic@(Implic { ic_given = givens
      | is_given  = ev_var `elemVarSet` needed
      | otherwise = True   -- Keep all wanted bindings
 
-   del_ev_bndr :: EvBind -> VarSet -> VarSet
-   del_ev_bndr (EvBind { eb_lhs = v }) needs = delVarSet needs v
-
    add_wanted :: EvBind -> VarSet -> VarSet
    add_wanted (EvBind { eb_is_given = is_given, eb_rhs = rhs }) needs
      | is_given  = needs  -- Add the rhs vars of the Wanted bindings only
@@ -2377,7 +2376,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
              seed_skols = mkVarSet skols     `unionVarSet`
                           mkVarSet given_ids `unionVarSet`
                           foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet`
-                          foldEvBindMap add_one_bind emptyVarSet binds
+                          evBindMapToVarSet binds
              -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3)
              -- Include the EvIds of any non-floating constraints
 
@@ -2402,9 +2401,6 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
        ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) }
 
   where
-    add_one_bind :: EvBind -> VarSet -> VarSet
-    add_one_bind bind acc = extendVarSet acc (evBindVar bind)
-
     add_non_flt_ct :: Ct -> VarSet -> VarSet
     add_non_flt_ct ct acc | isDerivedCt ct = acc
                           | otherwise      = extendVarSet acc (ctEvId ct)
diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs
index 49ae605feb..8649871670 100644
--- a/compiler/GHC/Tc/Types/Evidence.hs
+++ b/compiler/GHC/Tc/Types/Evidence.hs
@@ -15,8 +15,12 @@ module GHC.Tc.Types.Evidence (
   -- * Evidence bindings
   TcEvBinds(..), EvBindsVar(..),
   EvBindMap(..), emptyEvBindMap, extendEvBinds,
-  lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap,
+  lookupEvBind, evBindMapBinds,
+  foldEvBindMap, nonDetStrictFoldEvBindMap,
+  filterEvBindMap,
   isEmptyEvBindMap,
+  evBindMapToVarSet,
+  varSetMinusEvBindMap,
   EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
   evBindVar, isCoEvBindsVar,
 
@@ -55,6 +59,8 @@ module GHC.Tc.Types.Evidence (
 
 import GHC.Prelude
 
+import GHC.Types.Unique.DFM
+import GHC.Types.Unique.FM
 import GHC.Types.Var
 import GHC.Core.Coercion.Axiom
 import GHC.Core.Coercion
@@ -496,10 +502,22 @@ evBindMapBinds = foldEvBindMap consBag emptyBag
 foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
 foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)
 
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetStrictFoldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
+nonDetStrictFoldEvBindMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs)
+
 filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap
 filterEvBindMap k (EvBindMap { ev_bind_varenv = env })
   = EvBindMap { ev_bind_varenv = filterDVarEnv k env }
 
+evBindMapToVarSet :: EvBindMap -> VarSet
+evBindMapToVarSet (EvBindMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve))
+
+varSetMinusEvBindMap :: VarSet -> EvBindMap -> VarSet
+varSetMinusEvBindMap vs (EvBindMap dve) = vs `uniqSetMinusUDFM` dve
+
 instance Outputable EvBindMap where
   ppr (EvBindMap m) = ppr m
 
@@ -851,8 +869,8 @@ findNeededEvVars ev_binds seeds
   = transCloVarSet also_needs seeds
   where
    also_needs :: VarSet -> VarSet
-   also_needs needs = nonDetFoldUniqSet add emptyVarSet needs
-     -- It's OK to use nonDetFoldUFM here because we immediately
+   also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs
+     -- It's OK to use a non-deterministic fold here because we immediately
      -- forget about the ordering by creating a set
 
    add :: Var -> VarSet -> VarSet
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 693fd1f132..2ee00a88dc 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -693,7 +693,9 @@ tcTyVarLevel tv
 tcTypeLevel :: TcType -> TcLevel
 -- Max level of any free var of the type
 tcTypeLevel ty
-  = foldDVarSet add topTcLevel (tyCoVarsOfTypeDSet ty)
+  = nonDetStrictFoldDVarSet add topTcLevel (tyCoVarsOfTypeDSet ty)
+    -- It's safe to use a non-deterministic fold because `maxTcLevel` is
+    -- commutative.
   where
     add v lvl
       | isTcTyVar v = lvl `maxTcLevel` tcTyVarLevel v
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index a382bda18d..f36889444c 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -785,16 +785,23 @@ cleanUseDmd_maybe _                     = Nothing
 splitFVs :: Bool   -- Thunk
          -> DmdEnv -> (DmdEnv, DmdEnv)
 splitFVs is_thunk rhs_fvs
-  | is_thunk  = nonDetFoldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs
-                -- It's OK to use nonDetFoldUFM_Directly because we
+  | is_thunk  = strictPairToTuple $
+                nonDetStrictFoldUFM_Directly add (emptyVarEnv :*: emptyVarEnv) rhs_fvs
+                -- It's OK to use a non-deterministic fold because we
                 -- immediately forget the ordering by putting the elements
                 -- in the envs again
   | otherwise = partitionVarEnv isWeakDmd rhs_fvs
   where
-    add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv, sig_fv)
-      | Lazy <- s = (addToUFM_Directly lazy_fv uniq dmd, sig_fv)
-      | otherwise = ( addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })
-                    , addToUFM_Directly sig_fv  uniq (JD { sd = s,    ud = Abs }) )
+    add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv :*: sig_fv)
+      | Lazy <- s = addToUFM_Directly lazy_fv uniq dmd :*: sig_fv
+      | otherwise = addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })
+                    :*:
+                    addToUFM_Directly sig_fv  uniq (JD { sd = s,    ud = Abs })
+
+data StrictPair a b = !a :*: !b
+
+strictPairToTuple :: StrictPair a b -> (a, b)
+strictPairToTuple (x :*: y) = (x, y)
 
 data TypeShape = TsFun TypeShape
                | TsProd [TypeShape]
diff --git a/compiler/GHC/Types/Unique/DFM.hs b/compiler/GHC/Types/Unique/DFM.hs
index 8d79626c19..acce2dc9e6 100644
--- a/compiler/GHC/Types/Unique/DFM.hs
+++ b/compiler/GHC/Types/Unique/DFM.hs
@@ -50,14 +50,14 @@ module GHC.Types.Unique.DFM (
         equalKeysUDFM,
         minusUDFM,
         listToUDFM,
-        udfmMinusUFM,
+        udfmMinusUFM, ufmMinusUDFM,
         partitionUDFM,
         anyUDFM, allUDFM,
         pprUniqDFM, pprUDFM,
 
         udfmToList,
         udfmToUfm,
-        nonDetFoldUDFM,
+        nonDetStrictFoldUDFM,
         alwaysUnsafeUfmToUdfm,
     ) where
 
@@ -72,7 +72,7 @@ import Data.Functor.Classes (Eq1 (..))
 import Data.List (sortBy)
 import Data.Function (on)
 import qualified Data.Semigroup as Semi
-import GHC.Types.Unique.FM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap)
+import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM)
 
 -- Note [Deterministic UniqFM]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -272,12 +272,14 @@ elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m
 foldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
 foldUDFM k z m = foldr k z (eltsUDFM m)
 
--- | Performs a nondeterministic fold over the UniqDFM.
+-- | Performs a nondeterministic strict fold over the UniqDFM.
 -- It's O(n), same as the corresponding function on `UniqFM`.
 -- If you use this please provide a justification why it doesn't introduce
 -- nondeterminism.
-nonDetFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
-nonDetFoldUDFM k z (UDFM m _i) = foldr k z $ map taggedFst $ M.elems m
+nonDetStrictFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
+nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m
+  where
+    k' acc (TaggedVal v _) = k v acc
 
 eltsUDFM :: UniqDFM elt -> [elt]
 eltsUDFM (UDFM m _i) =
@@ -337,6 +339,9 @@ udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i
   -- M.difference returns a subset of a left set, so `i` is a good upper
   -- bound.
 
+ufmMinusUDFM :: UniqFM elt1 -> UniqDFM elt2 -> UniqFM elt1
+ufmMinusUDFM x (UDFM y _i) = unsafeIntMapToUFM (M.difference (ufmToIntMap x) y)
+
 -- | Partition UniqDFM into two UniqDFMs according to the predicate
 partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)
 partitionUDFM p (UDFM m i) =
@@ -349,8 +354,7 @@ delListFromUDFM = foldl' delFromUDFM
 
 -- | This allows for lossy conversion from UniqDFM to UniqFM
 udfmToUfm :: UniqDFM elt -> UniqFM elt
-udfmToUfm (UDFM m _i) =
-  listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m]
+udfmToUfm (UDFM m _i) = unsafeIntMapToUFM (M.map taggedFst m)
 
 listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt
 listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM
diff --git a/compiler/GHC/Types/Unique/DSet.hs b/compiler/GHC/Types/Unique/DSet.hs
index 149f40e06f..1587b89183 100644
--- a/compiler/GHC/Types/Unique/DSet.hs
+++ b/compiler/GHC/Types/Unique/DSet.hs
@@ -26,7 +26,7 @@ module GHC.Types.Unique.DSet (
         unionUniqDSets, unionManyUniqDSets,
         minusUniqDSet, uniqDSetMinusUniqSet,
         intersectUniqDSets, uniqDSetIntersectUniqSet,
-        foldUniqDSet,
+        nonDetStrictFoldUniqDSet,
         elementOfUniqDSet,
         filterUniqDSet,
         sizeUniqDSet,
@@ -98,8 +98,11 @@ uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a
 uniqDSetIntersectUniqSet xs ys
   = UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys))
 
-foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
-foldUniqDSet c n (UniqDSet s) = foldUDFM c n s
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetStrictFoldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
+nonDetStrictFoldUniqDSet f acc (UniqDSet s) = nonDetStrictFoldUDFM f acc s
 
 elementOfUniqDSet :: Uniquable a => a -> UniqDSet a -> Bool
 elementOfUniqDSet k = elemUDFM k . getUniqDSet
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index 4dedf468da..2f78387430 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -56,7 +56,7 @@ module GHC.Types.Unique.FM (
         intersectUFM_C,
         disjointUFM,
         equalKeysUFM,
-        nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
+        nonDetStrictFoldUFM, foldUFM, nonDetStrictFoldUFM_Directly,
         anyUFM, allUFM, seqEltsUFM,
         mapUFM, mapUFM_Directly,
         elemUFM, elemUFM_Directly,
@@ -67,7 +67,7 @@ module GHC.Types.Unique.FM (
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
         nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
         ufmToSet_Directly,
-        nonDetUFMToList, ufmToIntMap,
+        nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM,
         pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
     ) where
 
@@ -318,14 +318,14 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
 -- If you use this please provide a justification why it doesn't introduce
 -- nondeterminism.
-nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
-nonDetFoldUFM k z (UFM m) = M.foldr k z m
+nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m
 
 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
 -- If you use this please provide a justification why it doesn't introduce
 -- nondeterminism.
-nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
-nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m
+nonDetStrictFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetStrictFoldUFM_Directly k z (UFM m) = M.foldlWithKey' (\z' i x -> k (getUnique i) x z') z m
 
 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
 -- If you use this please provide a justification why it doesn't introduce
@@ -359,6 +359,9 @@ instance Traversable NonDetUniqFM where
 ufmToIntMap :: UniqFM elt -> M.IntMap elt
 ufmToIntMap (UFM m) = m
 
+unsafeIntMapToUFM :: M.IntMap elt -> UniqFM elt
+unsafeIntMapToUFM = UFM
+
 -- Determines whether two 'UniqFM's contain the same keys.
 equalKeysUFM :: UniqFM a -> UniqFM b -> Bool
 equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
diff --git a/compiler/GHC/Types/Unique/Set.hs b/compiler/GHC/Types/Unique/Set.hs
index 24f8a40e9b..e3c755fb10 100644
--- a/compiler/GHC/Types/Unique/Set.hs
+++ b/compiler/GHC/Types/Unique/Set.hs
@@ -25,7 +25,7 @@ module GHC.Types.Unique.Set (
         delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet,
         delListFromUniqSet_Directly,
         unionUniqSets, unionManyUniqSets,
-        minusUniqSet, uniqSetMinusUFM,
+        minusUniqSet, uniqSetMinusUFM, uniqSetMinusUDFM,
         intersectUniqSets,
         restrictUniqSetToUFM,
         uniqSetAny, uniqSetAll,
@@ -42,12 +42,12 @@ module GHC.Types.Unique.Set (
         unsafeUFMToUniqSet,
         nonDetEltsUniqSet,
         nonDetKeysUniqSet,
-        nonDetFoldUniqSet,
-        nonDetFoldUniqSet_Directly
+        nonDetStrictFoldUniqSet,
     ) where
 
 import GHC.Prelude
 
+import GHC.Types.Unique.DFM
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
 import Data.Coerce
@@ -111,6 +111,9 @@ restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)
 uniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a
 uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t)
 
+uniqSetMinusUDFM :: UniqSet a -> UniqDFM b -> UniqSet a
+uniqSetMinusUDFM (UniqSet s) t = UniqSet (ufmMinusUDFM s t)
+
 elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
 elementOfUniqSet a (UniqSet s) = elemUFM a s
 
@@ -159,14 +162,8 @@ nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet'
 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
 -- If you use this please provide a justification why it doesn't introduce
 -- nondeterminism.
-nonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a
-nonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s
-
--- See Note [Deterministic UniqFM] to learn about nondeterminism.
--- If you use this please provide a justification why it doesn't introduce
--- nondeterminism.
-nonDetFoldUniqSet_Directly:: (Unique -> elt -> a -> a) -> a -> UniqSet elt -> a
-nonDetFoldUniqSet_Directly f n (UniqSet s) = nonDetFoldUFM_Directly f n s
+nonDetStrictFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a
+nonDetStrictFoldUniqSet c n (UniqSet s) = nonDetStrictFoldUFM c n s
 
 -- See Note [UniqSet invariant]
 mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
diff --git a/compiler/GHC/Types/Var/Env.hs b/compiler/GHC/Types/Var/Env.hs
index aea3982226..27dc71e90a 100644
--- a/compiler/GHC/Types/Var/Env.hs
+++ b/compiler/GHC/Types/Var/Env.hs
@@ -33,7 +33,7 @@ module GHC.Types.Var.Env (
         extendDVarEnv, extendDVarEnv_C,
         extendDVarEnvList,
         lookupDVarEnv, elemDVarEnv,
-        isEmptyDVarEnv, foldDVarEnv,
+        isEmptyDVarEnv, foldDVarEnv, nonDetStrictFoldDVarEnv,
         mapDVarEnv, filterDVarEnv,
         modifyDVarEnv,
         alterDVarEnv,
@@ -575,6 +575,12 @@ lookupDVarEnv = lookupUDFM
 foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
 foldDVarEnv = foldUDFM
 
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetStrictFoldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
+nonDetStrictFoldDVarEnv = nonDetStrictFoldUDFM
+
 mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
 mapDVarEnv = mapUDFM
 
diff --git a/compiler/GHC/Types/Var/Set.hs b/compiler/GHC/Types/Var/Set.hs
index 5f1ea2e6c4..8b6bd21f46 100644
--- a/compiler/GHC/Types/Var/Set.hs
+++ b/compiler/GHC/Types/Var/Set.hs
@@ -23,7 +23,7 @@ module GHC.Types.Var.Set (
         sizeVarSet, seqVarSet,
         elemVarSetByKey, partitionVarSet,
         pluralVarSet, pprVarSet,
-        nonDetFoldVarSet,
+        nonDetStrictFoldVarSet,
 
         -- * Deterministic Var set types
         DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,
@@ -36,7 +36,9 @@ module GHC.Types.Var.Set (
         intersectDVarSet, dVarSetIntersectVarSet,
         intersectsDVarSet, disjointDVarSet,
         isEmptyDVarSet, delDVarSet, delDVarSetList,
-        minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet,
+        minusDVarSet,
+        nonDetStrictFoldDVarSet,
+        filterDVarSet, mapDVarSet,
         dVarSetMinusVarSet, anyDVarSet, allDVarSet,
         transCloDVarSet,
         sizeDVarSet, seqDVarSet,
@@ -152,8 +154,11 @@ allVarSet = uniqSetAll
 mapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
 mapVarSet = mapUniqSet
 
-nonDetFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a
-nonDetFoldVarSet = nonDetFoldUniqSet
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetStrictFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a
+nonDetStrictFoldVarSet = nonDetStrictFoldUniqSet
 
 fixVarSet :: (VarSet -> VarSet)   -- Map the current set to a new set
           -> VarSet -> VarSet
@@ -290,8 +295,11 @@ minusDVarSet = minusUniqDSet
 dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet
 dVarSetMinusVarSet = uniqDSetMinusUniqSet
 
-foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
-foldDVarSet = foldUniqDSet
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetStrictFoldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
+nonDetStrictFoldDVarSet = nonDetStrictFoldUniqDSet
 
 anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
 anyDVarSet p = anyUDFM p . getUniqDSet