[commit: ghc] master: Make FieldLabelEnv a deterministic set (9cc6fac)
git at git.haskell.org
git at git.haskell.org
Fri Jun 3 16:45:14 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/9cc6fac5c096eb4120173495faf2c948f7a28487/ghc
>---------------------------------------------------------------
commit 9cc6fac5c096eb4120173495faf2c948f7a28487
Author: Bartosz Nitka <niteria at gmail.com>
Date: Fri Jun 3 09:11:10 2016 -0700
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
>---------------------------------------------------------------
9cc6fac5c096eb4120173495faf2c948f7a28487
compiler/basicTypes/FieldLabel.hs | 3 ++-
compiler/iface/MkIface.hs | 11 ++---------
compiler/types/TyCon.hs | 10 +++++-----
compiler/utils/FastStringEnv.hs | 31 ++++++++++++++++++++++++++++---
compiler/utils/UniqDFM.hs | 4 ++++
5 files changed, 41 insertions(+), 18 deletions(-)
diff --git a/compiler/basicTypes/FieldLabel.hs b/compiler/basicTypes/FieldLabel.hs
index db9e968..8548fd2 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 ebdf74d..88bc662 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 73d898f..c60e410 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 fea627e..a3336ae 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 d8efde8..8bd19ad 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
More information about the ghc-commits
mailing list