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

5 files changed, 41 insertions, 18 deletions

diff --git a/compiler/basicTypes/FieldLabel.hs b/compiler/basicTypes/FieldLabel.hs
index db9e968df0..8548fd2b72 100644
--- a/compiler/basicTypes/FieldLabel.hs
+++ b/compiler/basicTypes/FieldLabel.hs
@@ -73,6 +73,7 @@ import OccName
 import Name
 
 import FastString
+import FastStringEnv
 import Outputable
 import Binary
 
@@ -83,7 +84,7 @@ import Data.Data
 type FieldLabelString = FastString
 
 -- | A map from labels to all the auxiliary information
-type FieldLabelEnv = FastStringEnv FieldLabel
+type FieldLabelEnv = DFastStringEnv FieldLabel
 
 
 type FieldLabel = FieldLbl Name
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index ebdf74dcd3..88bc662967 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1506,17 +1506,10 @@ tyConToIfaceDecl env tycon
           (con_env2, ex_bndrs') = tidyTyBinders con_env1 ex_bndrs
           to_eq_spec (tv,ty)  = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
 
-    ifaceOverloaded flds = case fsEnvElts flds of
+    ifaceOverloaded flds = case dFsEnvElts flds of
                              fl:_ -> flIsOverloaded fl
                              []   -> False
-    ifaceFields flds = sort $ map flLabel $ fsEnvElts flds
-                       -- We need to sort the labels because they come out
-                       -- of FastStringEnv in arbitrary order, because
-                       -- FastStringEnv is keyed on Uniques.
-                       -- Sorting FastString is ok here, because Uniques
-                       -- are only used for equality checks in the Ord
-                       -- instance for FastString.
-                       -- See Note [Unique Determinism] in Unique.
+    ifaceFields flds = map flLabel $ dFsEnvElts flds
 
 toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
 toIfaceBang _    HsLazy              = IfNoBang
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 73d898f102..c60e410a10 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -1195,20 +1195,20 @@ primRepIsFloat  _            = Just False
 
 -- | The labels for the fields of this particular 'TyCon'
 tyConFieldLabels :: TyCon -> [FieldLabel]
-tyConFieldLabels tc = fsEnvElts $ tyConFieldLabelEnv tc
+tyConFieldLabels tc = dFsEnvElts $ tyConFieldLabelEnv tc
 
 -- | The labels for the fields of this particular 'TyCon'
 tyConFieldLabelEnv :: TyCon -> FieldLabelEnv
 tyConFieldLabelEnv tc
   | isAlgTyCon tc = algTcFields tc
-  | otherwise     = emptyFsEnv
+  | otherwise     = emptyDFsEnv
 
 
 -- | Make a map from strings to FieldLabels from all the data
 -- constructors of this algebraic tycon
 fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv
-fieldsOfAlgTcRhs rhs = mkFsEnv [ (flLabel fl, fl)
-                               | fl <- dataConsFields (visibleDataCons rhs) ]
+fieldsOfAlgTcRhs rhs = mkDFsEnv [ (flLabel fl, fl)
+                                | fl <- dataConsFields (visibleDataCons rhs) ]
   where
     -- Duplicates in this list will be removed by 'mkFsEnv'
     dataConsFields dcs = concatMap dataConFieldLabels dcs
@@ -1314,7 +1314,7 @@ mkTupleTyCon name binders res_kind arity tyvars con sort parent
         algTcStupidTheta = [],
         algTcRhs         = TupleTyCon { data_con = con,
                                         tup_sort = sort },
-        algTcFields      = emptyFsEnv,
+        algTcFields      = emptyDFsEnv,
         algTcParent      = parent,
         algTcRec         = NonRecursive,
         algTcGadtSyntax  = False
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