[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