Make FieldLabelEnv a deterministic set

This lets us kill fsEnvElts function which is nondeterministic.
We also get better guarantees than just comments.
We don't do lookups, but I believe a set is needed for deduplication.

Test Plan: ./validate

Reviewers: bgamari, mpickering, austin, simonmar

Reviewed By: simonmar

Subscribers: thomie

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

GHC Trac Issues: #4012

2 files changed, 32 insertions, 3 deletions

diff --git a/compiler/utils/FastStringEnv.hs b/compiler/utils/FastStringEnv.hs
index fea627e6ca..a3336aeebf 100644
--- a/compiler/utils/FastStringEnv.hs
+++ b/compiler/utils/FastStringEnv.hs
@@ -12,25 +12,36 @@ module FastStringEnv (
 
         -- ** Manipulating these environments
         mkFsEnv,
-        emptyFsEnv, unitFsEnv, fsEnvElts,
+        emptyFsEnv, unitFsEnv,
         extendFsEnv_C, extendFsEnv_Acc, extendFsEnv,
         extendFsEnvList, extendFsEnvList_C,
         filterFsEnv,
         plusFsEnv, plusFsEnv_C, alterFsEnv,
         lookupFsEnv, lookupFsEnv_NF, delFromFsEnv, delListFromFsEnv,
         elemFsEnv, mapFsEnv,
+
+        -- * Deterministic FastString environments (maps)
+        DFastStringEnv,
+
+        -- ** Manipulating these environments
+        mkDFsEnv, emptyDFsEnv, dFsEnvElts,
     ) where
 
 import UniqFM
+import UniqDFM
 import Maybes
 import FastString
 
 
+-- | A non-deterministic set of FastStrings.
+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not
+-- deterministic and why it matters. Use DFastStringEnv if the set eventually
+-- gets converted into a list or folded over in a way where the order
+-- changes the generated code.
 type FastStringEnv a = UniqFM a  -- Domain is FastString
 
 emptyFsEnv         :: FastStringEnv a
 mkFsEnv            :: [(FastString,a)] -> FastStringEnv a
-fsEnvElts          :: FastStringEnv a -> [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
@@ -48,7 +59,6 @@ lookupFsEnv_NF     :: FastStringEnv a -> FastString -> a
 filterFsEnv        :: (elt -> Bool) -> FastStringEnv elt -> FastStringEnv elt
 mapFsEnv           :: (elt1 -> elt2) -> FastStringEnv elt1 -> FastStringEnv elt2
 
-fsEnvElts x               = eltsUFM x
 emptyFsEnv                = emptyUFM
 unitFsEnv x y             = unitUFM x y
 extendFsEnv x y z         = addToUFM x y z
@@ -68,3 +78,18 @@ delListFromFsEnv x y      = delListFromUFM x y
 filterFsEnv x y           = filterUFM x y
 
 lookupFsEnv_NF env n = expectJust "lookupFsEnv_NF" (lookupFsEnv env n)
+
+-- Deterministic FastStringEnv
+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
+-- DFastStringEnv.
+
+type DFastStringEnv a = UniqDFM a  -- Domain is FastString
+
+emptyDFsEnv :: DFastStringEnv a
+emptyDFsEnv = emptyUDFM
+
+dFsEnvElts :: DFastStringEnv a -> [a]
+dFsEnvElts = eltsUDFM
+
+mkDFsEnv :: [(FastString,a)] -> DFastStringEnv a
+mkDFsEnv l = listToUDFM l
diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs
index d8efde8fe5..8bd19ad7ff 100644
--- a/compiler/utils/UniqDFM.hs
+++ b/compiler/utils/UniqDFM.hs
@@ -46,6 +46,7 @@ module UniqDFM (
         intersectsUDFM,
         disjointUDFM, disjointUdfmUfm,
         minusUDFM,
+        listToUDFM,
         udfmMinusUFM,
         partitionUDFM,
         anyUDFM,
@@ -313,6 +314,9 @@ udfmToUfm :: UniqDFM elt -> UniqFM elt
 udfmToUfm (UDFM m _i) =
   listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m]
 
+listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt
+listToUDFM = foldl (\m (k, v) -> addToUDFM m k v) emptyUDFM
+
 listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt
 listToUDFM_Directly = foldl (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM