[commit: ghc] master: Localize orphan-related nondeterminism (cb9f635)
git at git.haskell.org
git at git.haskell.org
Thu Jun 2 16:46:34 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/cb9f635eae76c61f189b9b55af4ed7628ccafda1/ghc
>---------------------------------------------------------------
commit cb9f635eae76c61f189b9b55af4ed7628ccafda1
Author: Bartosz Nitka <niteria at gmail.com>
Date: Thu Jun 2 09:39:47 2016 -0700
Localize orphan-related nondeterminism
chooseOrphanAnchor now takes a NameSet, relieving the callers
from the burden of converting it to a list
Test Plan: ./validate
Reviewers: bgamari, ezyang, austin, simonmar, simonpj
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2294
GHC Trac Issues: #4012
>---------------------------------------------------------------
cb9f635eae76c61f189b9b55af4ed7628ccafda1
compiler/coreSyn/CoreSyn.hs | 11 +++++++----
compiler/iface/MkIface.hs | 2 +-
compiler/specialise/Rules.hs | 4 ++--
compiler/types/InstEnv.hs | 2 +-
4 files changed, 11 insertions(+), 8 deletions(-)
diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index 8a34c35..6fb1a33 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -95,6 +95,7 @@ import Var
import Type
import Coercion
import Name
+import NameSet
import NameEnv( NameEnv, emptyNameEnv )
import Literal
import DataCon
@@ -104,6 +105,7 @@ import BasicTypes
import DynFlags
import Outputable
import Util
+import UniqFM
import SrcLoc ( RealSrcSpan, containsSpan )
import Binary
@@ -741,7 +743,7 @@ notOrphan :: IsOrphan -> Bool
notOrphan NotOrphan{} = True
notOrphan _ = False
-chooseOrphanAnchor :: [Name] -> IsOrphan
+chooseOrphanAnchor :: NameSet -> IsOrphan
-- Something (rule, instance) is relate to all the Names in this
-- list. Choose one of them to be an "anchor" for the orphan. We make
-- the choice deterministic to avoid gratuitious changes in the ABI
@@ -751,10 +753,11 @@ chooseOrphanAnchor :: [Name] -> IsOrphan
-- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically
--
chooseOrphanAnchor local_names
- | null local_names = IsOrphan
- | otherwise = NotOrphan (minimum occs)
+ | isEmptyNameSet local_names = IsOrphan
+ | otherwise = NotOrphan (minimum occs)
where
- occs = map nameOccName local_names
+ occs = map nameOccName $ nonDetEltsUFM local_names
+ -- It's OK to use nonDetEltsUFM here, see comments above
instance Binary IsOrphan where
put_ bh IsOrphan = putByte bh 0
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 64c7831..7652421 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1641,7 +1641,7 @@ famInstToIfaceFamInst (FamInst { fi_axiom = axiom,
orph | is_local fam_decl
= NotOrphan (nameOccName fam_decl)
| otherwise
- = chooseOrphanAnchor $ nameSetElems lhs_names
+ = chooseOrphanAnchor lhs_names
--------------------------
toIfaceLetBndr :: Id -> IfaceLetBndr
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs
index e11de97..4868424 100644
--- a/compiler/specialise/Rules.hs
+++ b/compiler/specialise/Rules.hs
@@ -181,13 +181,13 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs
-- Compute orphanhood. See Note [Orphans] in InstEnv
-- A rule is an orphan only if none of the variables
-- mentioned on its left-hand side are locally defined
- lhs_names = nameSetElems (extendNameSet (exprsOrphNames args) fn)
+ lhs_names = extendNameSet (exprsOrphNames args) fn
-- Since rules get eventually attached to one of the free names
-- from the definition when compiling the ABI hash, we should make
-- it deterministic. This chooses the one with minimal OccName
-- as opposed to uniq value.
- local_lhs_names = filter (nameIsLocalOrFrom this_mod) lhs_names
+ local_lhs_names = filterNameSet (nameIsLocalOrFrom this_mod) lhs_names
orph = chooseOrphanAnchor local_lhs_names
--------------
diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs
index ec6babc..e214f12 100644
--- a/compiler/types/InstEnv.hs
+++ b/compiler/types/InstEnv.hs
@@ -255,7 +255,7 @@ mkLocalInstance dfun oflag tvs cls tys
do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names
, not (tv `elem` rtvs)]
- choose_one nss = chooseOrphanAnchor (nameSetElems (unionNameSets nss))
+ choose_one nss = chooseOrphanAnchor (unionNameSets nss)
mkImportedInstance :: Name
-> [Maybe Name]
More information about the ghc-commits
mailing list