Document some benign nondeterminism

I've changed the functions to their nonDet equivalents and explained
why they're OK there. This allowed me to remove foldNameSet,
foldVarEnv, foldVarEnv_Directly, foldVarSet and foldUFM_Directly.

Test Plan: ./validate, there should be no change in behavior

Reviewers: simonpj, simonmar, austin, goldfire, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2244

GHC Trac Issues: #4012

19 files changed, 93 insertions, 71 deletions

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 9a754dd423..a035202c97 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -69,7 +69,6 @@ import FieldLabel
 import Class
 import Name
 import PrelNames
-import NameEnv
 import Var
 import Outputable
 import ListSetOps
@@ -78,6 +77,7 @@ import BasicTypes
 import FastString
 import Module
 import Binary
+import UniqFM
 
 import qualified Data.Data as Data
 import qualified Data.Typeable
@@ -1181,8 +1181,7 @@ isLegacyPromotableDataCon dc
   =  null (dataConEqSpec dc)  -- no GADTs
   && null (dataConTheta dc)   -- no context
   && not (isFamInstTyCon (dataConTyCon dc))   -- no data instance constructors
-  && all isLegacyPromotableTyCon (nameEnvElts $
-                                  tyConsOfType (dataConUserType dc))
+  && allUFM isLegacyPromotableTyCon (tyConsOfType (dataConUserType dc))
 
 -- | Was this tycon promotable before GHC 8.0? That is, is it promotable
 -- without -XTypeInType
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 928b0381d5..1ca65b01cc 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -780,7 +780,10 @@ cleanUseDmd_maybe _                     = Nothing
 splitFVs :: Bool   -- Thunk
          -> DmdEnv -> (DmdEnv, DmdEnv)
 splitFVs is_thunk rhs_fvs
-  | is_thunk  = foldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs
+  | is_thunk  = nonDetFoldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs
+                -- It's OK to use nonDetFoldUFM_Directly 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)
@@ -1198,7 +1201,10 @@ We
 -- Equality needed for fixpoints in DmdAnal
 instance Eq DmdType where
   (==) (DmdType fv1 ds1 res1)
-       (DmdType fv2 ds2 res2) =  ufmToList fv1 == ufmToList fv2
+       (DmdType fv2 ds2 res2) = nonDetUFMToList fv1 == nonDetUFMToList fv2
+         -- It's OK to use nonDetUFMToList here because we're testing for
+         -- equality and even though the lists will be in some arbitrary
+         -- Unique order, it is the same order for both
                               && ds1 == ds2 && res1 == res2
 
 lubDmdType :: DmdType -> DmdType -> DmdType
@@ -1251,7 +1257,9 @@ instance Outputable DmdType where
             else braces (fsep (map pp_elt fv_elts))]
     where
       pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
-      fv_elts = ufmToList fv
+      fv_elts = nonDetUFMToList fv
+        -- It's OK to use nonDetUFMToList here because we only do it for
+        -- pretty printing
 
 emptyDmdEnv :: VarEnv Demand
 emptyDmdEnv = emptyVarEnv
diff --git a/compiler/basicTypes/NameEnv.hs b/compiler/basicTypes/NameEnv.hs
index 740c40605e..46819a7b94 100644
--- a/compiler/basicTypes/NameEnv.hs
+++ b/compiler/basicTypes/NameEnv.hs
@@ -13,7 +13,7 @@ module NameEnv (
         -- ** Manipulating these environments
         mkNameEnv,
         emptyNameEnv, isEmptyNameEnv,
-        unitNameEnv, nameEnvElts, nameEnvUniqueElts,
+        unitNameEnv, nameEnvElts,
         extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
         extendNameEnvList, extendNameEnvList_C,
         filterNameEnv, anyNameEnv,
@@ -35,7 +35,6 @@ module NameEnv (
 
 import Digraph
 import Name
-import Unique
 import UniqFM
 import UniqDFM
 import Maybes
@@ -89,7 +88,6 @@ emptyNameEnv       :: NameEnv a
 isEmptyNameEnv     :: NameEnv a -> Bool
 mkNameEnv          :: [(Name,a)] -> NameEnv a
 nameEnvElts        :: NameEnv a -> [a]
-nameEnvUniqueElts  :: NameEnv a -> [(Unique, a)]
 alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
 extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
 extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
@@ -123,7 +121,6 @@ plusNameEnv x y          = plusUFM x y
 plusNameEnv_C f x y      = plusUFM_C f x y
 extendNameEnv_C f x y z  = addToUFM_C f x y z
 mapNameEnv f x           = mapUFM f x
-nameEnvUniqueElts x      = ufmToList x
 extendNameEnv_Acc x y z a b  = addToUFM_Acc x y z a b
 extendNameEnvList_C x y z = addListToUFM_C x y z
 delFromNameEnv x y      = delFromUFM x y
diff --git a/compiler/basicTypes/NameSet.hs b/compiler/basicTypes/NameSet.hs
index b332fe29e0..14007750b9 100644
--- a/compiler/basicTypes/NameSet.hs
+++ b/compiler/basicTypes/NameSet.hs
@@ -11,7 +11,7 @@ module NameSet (
         -- ** Manipulating these sets
         emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
         minusNameSet, elemNameSet, nameSetElems, extendNameSet, extendNameSetList,
-        delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
+        delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
         intersectsNameSet, intersectNameSet,
         nameSetAny, nameSetAll,
 
@@ -59,7 +59,6 @@ nameSetElems      :: NameSet -> [Name]
 isEmptyNameSet     :: NameSet -> Bool
 delFromNameSet     :: NameSet -> Name -> NameSet
 delListFromNameSet :: NameSet -> [Name] -> NameSet
-foldNameSet        :: (Name -> b -> b) -> b -> NameSet -> b
 filterNameSet      :: (Name -> Bool) -> NameSet -> NameSet
 intersectNameSet   :: NameSet -> NameSet -> NameSet
 intersectsNameSet  :: NameSet -> NameSet -> Bool
@@ -78,7 +77,6 @@ minusNameSet      = minusUniqSet
 elemNameSet       = elementOfUniqSet
 nameSetElems     = uniqSetToList
 delFromNameSet    = delOneFromUniqSet
-foldNameSet       = foldUniqSet
 filterNameSet     = filterUniqSet
 intersectNameSet  = intersectUniqSets
 
diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs
index 906434fddd..dd6125744a 100644
--- a/compiler/basicTypes/VarEnv.hs
+++ b/compiler/basicTypes/VarEnv.hs
@@ -9,7 +9,7 @@ module VarEnv (
 
         -- ** Manipulating these environments
         emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
-        elemVarEnv, varEnvElts, varEnvKeys, varEnvToList,
+        elemVarEnv, varEnvElts,
         extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,
         extendVarEnvList,
         plusVarEnv, plusVarEnv_C, plusVarEnv_CD, alterVarEnv,
@@ -18,7 +18,7 @@ module VarEnv (
         lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
         mapVarEnv, zipVarEnv,
         modifyVarEnv, modifyVarEnv_Directly,
-        isEmptyVarEnv, foldVarEnv, foldVarEnv_Directly,
+        isEmptyVarEnv,
         elemVarEnvByKey, lookupVarEnv_Directly,
         filterVarEnv, filterVarEnv_Directly, restrictVarEnv,
         partitionVarEnv,
@@ -435,8 +435,6 @@ plusVarEnv_CD     :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
 mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b
 modifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a
 varEnvElts        :: VarEnv a -> [a]
-varEnvKeys        :: VarEnv a -> [Unique]
-varEnvToList      :: VarEnv a -> [(Unique, a)]
 
 isEmptyVarEnv     :: VarEnv a -> Bool
 lookupVarEnv      :: VarEnv a -> Var -> Maybe a
@@ -445,8 +443,6 @@ lookupVarEnv_NF   :: VarEnv a -> Var -> a
 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
 elemVarEnv        :: Var -> VarEnv a -> Bool
 elemVarEnvByKey   :: Unique -> VarEnv a -> Bool
-foldVarEnv        :: (a -> b -> b) -> b -> VarEnv a -> b
-foldVarEnv_Directly :: (Unique -> a -> b -> b) -> b -> VarEnv a -> b
 
 elemVarEnv       = elemUFM
 elemVarEnvByKey  = elemUFM_Directly
@@ -471,12 +467,8 @@ mkVarEnv         = listToUFM
 mkVarEnv_Directly= listToUFM_Directly
 emptyVarEnv      = emptyUFM
 varEnvElts       = eltsUFM
-varEnvKeys       = keysUFM
-varEnvToList     = ufmToList
 unitVarEnv       = unitUFM
 isEmptyVarEnv    = isNullUFM
-foldVarEnv       = foldUFM
-foldVarEnv_Directly = foldUFM_Directly
 lookupVarEnv_Directly = lookupUFM_Directly
 filterVarEnv_Directly = filterUFM_Directly
 delVarEnv_Directly    = delFromUFM_Directly
diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs
index 2c2066a1cf..4663a41a5b 100644
--- a/compiler/basicTypes/VarSet.hs
+++ b/compiler/basicTypes/VarSet.hs
@@ -16,7 +16,7 @@ module VarSet (
         unionVarSet, unionVarSets, mapUnionVarSet,
         intersectVarSet, intersectsVarSet, disjointVarSet,
         isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
-        minusVarSet, foldVarSet, filterVarSet,
+        minusVarSet, filterVarSet,
         varSetAny, varSetAll,
         transCloVarSet, fixVarSet,
         lookupVarSet, lookupVarSetByName,
@@ -82,7 +82,6 @@ delVarSetList   :: VarSet -> [Var] -> VarSet
 minusVarSet     :: VarSet -> VarSet -> VarSet
 isEmptyVarSet   :: VarSet -> Bool
 mkVarSet        :: [Var] -> VarSet
-foldVarSet      :: (Var -> a -> a) -> a -> VarSet -> a
 lookupVarSet    :: VarSet -> Var -> Maybe Var
                         -- Returns the set element, which may be
                         -- (==) to the argument, but not the same as
@@ -116,7 +115,6 @@ delVarSet       = delOneFromUniqSet
 delVarSetList   = delListFromUniqSet
 isEmptyVarSet   = isEmptyUniqSet
 mkVarSet        = mkUniqSet
-foldVarSet      = foldUniqSet
 lookupVarSet    = lookupUniqSet
 lookupVarSetByName = lookupUniqSet
 sizeVarSet      = sizeUniqSet
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index 8dbb646cdc..d60828cd0d 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -44,6 +44,7 @@ import Control.Monad
 import Name
 import StgSyn
 import Outputable
+import UniqFM
 
 -------------------------------------
 --        Non-void types
@@ -158,7 +159,8 @@ cgLookupPanic id
         pprPanic "StgCmmEnv: variable not found"
                 (vcat [ppr id,
                 text "local binds for:",
-                vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
+                pprUFM local_binds $ \infos ->
+                  vcat [ ppr (cg_id info) | info <- infos ]
               ])
 
 
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 34df427923..75f6a3491b 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -148,7 +148,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  = foldNameSet add_mv emptyModuleEnv used_names
+    ent_map  = nonDetFoldUFM add_mv emptyModuleEnv used_names
+     -- nonDetFoldUFM 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/main/HscMain.hs b/compiler/main/HscMain.hs
index a969e8962c..71f2ce2059 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -212,7 +212,9 @@ allKnownKeyNames                -- where templateHaskellNames are defined
     namesEnv      = foldl (\m n -> extendNameEnv_Acc (:) singleton m n n)
                           emptyUFM all_names
     badNamesEnv   = filterNameEnv (\ns -> length ns > 1) namesEnv
-    badNamesPairs = nameEnvUniqueElts badNamesEnv
+    badNamesPairs = nonDetUFMToList badNamesEnv
+      -- It's OK to use nonDetUFMToList here because the ordering only affects
+      -- the message when we get a panic
     badNamesStrs  = map pairToStr badNamesPairs
     badNamesStr   = unlines badNamesStrs
 
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index d91ce86cff..4a71f2d083 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -1349,7 +1349,9 @@ depAnalTyClDecls rdr_env ds_w_fvs
 
 toParents :: GlobalRdrEnv -> NameSet -> NameSet
 toParents rdr_env ns
-  = foldNameSet add emptyNameSet ns
+  = nonDetFoldUFM add emptyNameSet ns
+  -- It's OK to use nonDetFoldUFM because we immediately forget the
+  -- ordering by creating a set
   where
     add n s = extendNameSet s (getParent rdr_env n)
 
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index b9edba7bd9..33e0c45140 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -1129,7 +1129,8 @@ occAnalNonRecRhs env bndr rhs
     not_stable = not (isStableUnfolding (idUnfolding bndr))
 
 addIdOccs :: UsageDetails -> VarSet -> UsageDetails
-addIdOccs usage id_set = foldVarSet addIdOcc usage id_set
+addIdOccs usage id_set = nonDetFoldUFM addIdOcc usage id_set
+  -- It's OK to use nonDetFoldUFM here because addIdOcc commutes
 
 addIdOcc :: Id -> UsageDetails -> UsageDetails
 addIdOcc v u | isId v    = addOneOcc u v NoOccInfo
@@ -1594,7 +1595,9 @@ transClosureFV env
   | no_change = env
   | otherwise = transClosureFV (listToUFM new_fv_list)
   where
-    (no_change, new_fv_list) = mapAccumL bump True (ufmToList env)
+    (no_change, new_fv_list) = mapAccumL bump True (nonDetUFMToList env)
+      -- It's OK to use nonDetUFMToList here because we'll forget the
+      -- ordering by creating a new set with listToUFM
     bump no_change (b,fvs)
       | no_change_here = (no_change, (b,fvs))
       | otherwise      = (False,     (b,new_fvs))
@@ -1615,7 +1618,8 @@ extendFvs env s
   = (s `unionVarSet` extras, extras `subVarSet` s)
   where
     extras :: VarSet    -- env(s)
-    extras = foldUFM unionVarSet emptyVarSet $
+    extras = nonDetFoldUFM unionVarSet emptyVarSet $
+      -- It's OK to use nonDetFoldUFM here because unionVarSet commutes
              intersectUFM_C (\x _ -> x) env s
 
 {-
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index 86442ab54b..94a7e9e90e 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -84,7 +84,7 @@ import UniqSupply
 import Util
 import Outputable
 import FastString
-import UniqDFM (udfmToUfm)
+import UniqDFM
 import FV
 
 {-
@@ -911,7 +911,8 @@ isFunction (_, AnnLam b e) | isId b    = True
 isFunction _                           = False
 
 countFreeIds :: DVarSet -> Int
-countFreeIds = foldVarSet add 0 . udfmToUfm
+countFreeIds = nonDetFoldUDFM add 0
+  -- It's OK to use nonDetFoldUDFM here because we're just counting things.
   where
     add :: Var -> Int -> Int
     add v n | isId v    = n+1
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs
index aebfbc744e..e11de97902 100644
--- a/compiler/specialise/Rules.hs
+++ b/compiler/specialise/Rules.hs
@@ -568,7 +568,9 @@ matchN (in_scope, id_unf) rule_name tmpl_vars tmpl_es target_es
           kind = Type.substTy (mkTCvSubst in_scope (tv_subst, cv_subst))
                               (tyVarKind tmpl_var)
 
-          to_co_env env = foldVarEnv_Directly to_co emptyVarEnv env
+          to_co_env env = nonDetFoldUFM_Directly to_co emptyVarEnv env
+            -- It's OK to use nonDetFoldUFM_Directly because we forget the
+            -- order immediately by creating a new env
           to_co uniq expr env
             | Just co <- exprToCoercion_maybe expr
             = extendVarEnv_Directly env uniq co
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 07c0a234f4..4c621ddf2f 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -42,6 +42,7 @@ import Unify         ( tcMatchTy )
 import Util
 import Var
 import VarSet
+import UniqFM
 import BasicTypes    ( IntWithInf, intGtLimit )
 import ErrUtils      ( emptyMessages )
 import qualified GHC.LanguageExtensions as LangExt
@@ -1367,7 +1368,9 @@ neededEvVars ev_binds initial_seeds
 
    also_needs :: VarSet -> VarSet
    also_needs needs
-     = foldVarSet add emptyVarSet needs
+     = nonDetFoldUFM add emptyVarSet needs
+     -- It's OK to use nonDetFoldUFM here because we immediately forget
+     -- about the ordering by creating a set
      where
        add v needs
         | Just ev_bind <- lookupEvBind ev_binds v
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index a515d29e90..7499e5d505 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -122,6 +122,7 @@ import PrelNames
 import TysPrim          ( eqPhantPrimTyCon )
 import ListSetOps
 import Maybes
+import UniqFM
 
 import Control.Monad (foldM)
 import Control.Arrow ( first )
@@ -1614,7 +1615,10 @@ liftEnvSubst :: (forall a. Pair a -> a) -> TCvSubst -> LiftCoEnv -> TCvSubst
 liftEnvSubst selector subst lc_env
   = composeTCvSubst (TCvSubst emptyInScopeSet tenv cenv) subst
   where
-    pairs            = varEnvToList lc_env
+    pairs            = nonDetUFMToList lc_env
+                       -- It's OK to use nonDetUFMToList here because we
+                       -- immediately forget the ordering by creating
+                       -- a VarEnv
     (tpairs, cpairs) = partitionWith ty_or_co pairs
     tenv             = mkVarEnv_Directly tpairs
     cenv             = mkVarEnv_Directly cpairs
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index b1ffccbb0a..c7a73eab94 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -2107,7 +2107,9 @@ checkValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a
              text "needInScope" <+> ppr needInScope )
     a
   where
-  substDomain = varEnvKeys tenv ++ varEnvKeys cenv
+  substDomain = nonDetKeysUFM tenv ++ nonDetKeysUFM cenv
+    -- It's OK to use nonDetKeysUFM here, because we only use this list to
+    -- remove some elements from a set
   needInScope = (tyCoVarsOfTypes tys `unionVarSet` tyCoVarsOfCos cos)
                   `delListFromUFM_Directly` substDomain
   tysCosFVsInScope = needInScope `varSetInScope` in_scope
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index 381f9482d1..859403d2b3 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -36,6 +36,7 @@ import TyCoRep hiding ( getTvSubstEnv, getCvSubstEnv )
 import Util
 import Pair
 import Outputable
+import UniqFM
 
 import Control.Monad
 #if __GLASGOW_HASKELL__ > 710
@@ -457,7 +458,9 @@ niFixTCvSubst tenv = f tenv
           not_fixpoint  = varSetAny in_domain range_tvs
           in_domain tv  = tv `elemVarEnv` tenv
 
-          range_tvs     = foldVarEnv (unionVarSet . tyCoVarsOfType) emptyVarSet tenv
+          range_tvs     = nonDetFoldUFM (unionVarSet . tyCoVarsOfType) emptyVarSet tenv
+                          -- It's OK to use nonDetFoldUFM here because we
+                          -- forget the order immediately by creating a set
           subst         = mkTvSubst (mkInScopeSet range_tvs) tenv
 
              -- env' extends env by replacing any free type with
@@ -467,7 +470,10 @@ niFixTCvSubst tenv = f tenv
                                                  setTyVarKind rtv $
                                                  substTy subst $
                                                  tyVarKind rtv)
-                                         | rtv <- varSetElems range_tvs
+                                         | rtv <- nonDetEltsUFM range_tvs
+                                         -- It's OK to use nonDetEltsUFM here
+                                         -- because we forget the order
+                                         -- immediatedly by putting it in VarEnv
                                          , not (in_domain rtv) ]
           subst' = mkTvSubst (mkInScopeSet range_tvs) tenv'
 
@@ -476,7 +482,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
-  = foldVarSet (unionVarSet . get) emptyVarSet tvs
+  = nonDetFoldUFM (unionVarSet . get) emptyVarSet tvs
+  -- It's OK to nonDetFoldUFM here because we immediately forget the
+  -- ordering by creating a set.
   where
     get tv
       | Just ty <- lookupVarEnv tsubst tv
diff --git a/compiler/utils/FastStringEnv.hs b/compiler/utils/FastStringEnv.hs
index 02ee0292b9..fea627e6ca 100644
--- a/compiler/utils/FastStringEnv.hs
+++ b/compiler/utils/FastStringEnv.hs
@@ -12,7 +12,7 @@ module FastStringEnv (
 
         -- ** Manipulating these environments
         mkFsEnv,
-        emptyFsEnv, unitFsEnv, fsEnvElts, fsEnvUniqueElts,
+        emptyFsEnv, unitFsEnv, fsEnvElts,
         extendFsEnv_C, extendFsEnv_Acc, extendFsEnv,
         extendFsEnvList, extendFsEnvList_C,
         filterFsEnv,
@@ -21,7 +21,6 @@ module FastStringEnv (
         elemFsEnv, mapFsEnv,
     ) where
 
-import Unique
 import UniqFM
 import Maybes
 import FastString
@@ -32,7 +31,6 @@ type FastStringEnv a = UniqFM a  -- Domain is FastString
 emptyFsEnv         :: FastStringEnv a
 mkFsEnv            :: [(FastString,a)] -> FastStringEnv a
 fsEnvElts          :: FastStringEnv a -> [a]
-fsEnvUniqueElts    :: FastStringEnv a -> [(Unique, a)]
 alterFsEnv         :: (Maybe a-> Maybe a) -> FastStringEnv a -> FastString -> FastStringEnv a
 extendFsEnv_C      :: (a->a->a) -> FastStringEnv a -> FastString -> a -> FastStringEnv a
 extendFsEnv_Acc    :: (a->b->b) -> (a->b) -> FastStringEnv b -> FastString -> a -> FastStringEnv b
@@ -63,7 +61,6 @@ plusFsEnv x y             = plusUFM x y
 plusFsEnv_C f x y         = plusUFM_C f x y
 extendFsEnv_C f x y z     = addToUFM_C f x y z
 mapFsEnv f x              = mapUFM f x
-fsEnvUniqueElts x         = ufmToList x
 extendFsEnv_Acc x y z a b = addToUFM_Acc x y z a b
 extendFsEnvList_C x y z   = addListToUFM_C x y z
 delFromFsEnv x y          = delFromUFM x y
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index f49dabc904..f9832d5455 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -53,7 +53,8 @@ module UniqFM (
         intersectUFM,
         intersectUFM_C,
         disjointUFM,
-        foldUFM, foldUFM_Directly, anyUFM, allUFM,
+        nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
+        anyUFM, allUFM,
         mapUFM, mapUFM_Directly,
         elemUFM, elemUFM_Directly,
         filterUFM, filterUFM_Directly, partitionUFM,
@@ -61,17 +62,15 @@ module UniqFM (
         isNullUFM,
         lookupUFM, lookupUFM_Directly,
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
-        nonDetEltsUFM, eltsUFM, nonDetKeysUFM, keysUFM, splitUFM,
+        nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
         ufmToSet_Directly,
-        ufmToList, ufmToIntMap,
-        joinUFM, pprUniqFM, pprUFM, pluralUFM
+        nonDetUFMToList, ufmToList, ufmToIntMap,
+        pprUniqFM, pprUFM, pluralUFM
     ) where
 
 import Unique           ( Uniquable(..), Unique, getKey )
 import Outputable
 
-import Compiler.Hoopl   hiding (Unique)
-
 import qualified Data.IntMap as M
 import qualified Data.IntSet as S
 import Data.Typeable
@@ -165,7 +164,6 @@ intersectUFM_C  :: (elt1 -> elt2 -> elt3)
 disjointUFM     :: UniqFM elt1 -> UniqFM elt2 -> Bool
 
 foldUFM         :: (elt -> a -> a) -> a -> UniqFM elt -> a
-foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
 mapUFM          :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 filterUFM       :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
@@ -177,8 +175,6 @@ sizeUFM         :: UniqFM elt -> Int
 elemUFM         :: Uniquable key => key -> UniqFM elt -> Bool
 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
 
-splitUFM        :: Uniquable key => UniqFM elt -> key -> (UniqFM elt, Maybe elt, UniqFM elt)
-                   -- Splits a UFM into things less than, equal to, and greater than the key
 lookupUFM       :: Uniquable key => UniqFM elt -> key -> Maybe elt
 lookupUFM_Directly  -- when you've got the Unique already
                 :: UniqFM elt -> Unique -> Maybe elt
@@ -186,7 +182,6 @@ lookupWithDefaultUFM
                 :: Uniquable key => UniqFM elt -> elt -> key -> elt
 lookupWithDefaultUFM_Directly
                 :: UniqFM elt -> elt -> Unique -> elt
-keysUFM         :: UniqFM elt -> [Unique]       -- Get the keys
 eltsUFM         :: UniqFM elt -> [elt]
 ufmToSet_Directly :: UniqFM elt -> S.IntSet
 ufmToList       :: UniqFM elt -> [(Unique, elt)]
@@ -274,7 +269,6 @@ disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)
 foldUFM k z (UFM m) = M.fold k z m
 
 
-foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
 mapUFM f (UFM m) = UFM (M.map f m)
 mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
 filterUFM p (UFM m) = UFM (M.filter p m)
@@ -286,13 +280,10 @@ sizeUFM (UFM m) = M.size m
 elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
 elemUFM_Directly u (UFM m) = M.member (getKey u) m
 
-splitUFM (UFM m) k = case M.splitLookup (getKey $ getUnique k) m of
-                       (less, equal, greater) -> (UFM less, equal, UFM greater)
 lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
 lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
 lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
-keysUFM (UFM m) = map getUnique $ M.keys m
 eltsUFM (UFM m) = M.elems m
 ufmToSet_Directly (UFM m) = M.keysSet m
 ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
@@ -315,19 +306,27 @@ nonDetEltsUFM (UFM m) = M.elems m
 nonDetKeysUFM :: UniqFM elt -> [Unique]
 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.fold 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.foldWithKey (k . getUnique) z m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetUFMToList :: UniqFM elt -> [(Unique, elt)]
+nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
+
 ufmToIntMap :: UniqFM elt -> M.IntMap elt
 ufmToIntMap (UFM m) = m
 
--- Hoopl
-joinUFM :: JoinFun v -> JoinFun (UniqFM v)
-joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, old) new
-    where add k new_v (ch, joinmap) =
-            case lookupUFM_Directly joinmap k of
-                Nothing -> (SomeChange, addToUFM_Directly joinmap k new_v)
-                Just old_v -> case eltJoin l (OldFact old_v) (NewFact new_v) of
-                                (SomeChange, v') -> (SomeChange, addToUFM_Directly joinmap k v')
-                                (NoChange, _) -> (ch, joinmap)
-
 {-
 ************************************************************************
 *                                                                      *
@@ -343,7 +342,9 @@ pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
 pprUniqFM ppr_elt ufm
   = brackets $ fsep $ punctuate comma $
     [ ppr uq <+> text ":->" <+> ppr_elt elt
-    | (uq, elt) <- ufmToList ufm ]
+    | (uq, elt) <- nonDetUFMToList ufm ]
+  -- It's OK to use nonDetUFMToList here because we only use it for
+  -- pretty-printing.
 
 -- | Pretty-print a non-deterministic set.
 -- The order of variables is non-deterministic and for pretty-printing that