[commit: ghc] master: Avoid printing uniques in specialization rules (a477e81)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a477e8118137b7483d0a7680c1fd337a007a023b/ghc

>---------------------------------------------------------------

commit a477e8118137b7483d0a7680c1fd337a007a023b
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Oct 17 11:09:16 2014 +0200

    Avoid printing uniques in specialization rules
    
    Akio found an avoidable cause of non-determinisim: The names of RULES
    generated by Specialise had uniques in them:
        "SPEC $cshowsPrec_a2QX @ [GHC.Types.Char]" [ALWAYS] forall ...
    By using showSDocForUser instead of showSDocDump when building the rule
    name, this is avoided:
        "SPEC $cshowsPrec @ [Char]" [ALWAYS] forall ...
    See #4012, comments 61ff.


>---------------------------------------------------------------

a477e8118137b7483d0a7680c1fd337a007a023b
 compiler/specialise/Specialise.lhs                 |  6 +++++-
 .../tests/simplCore/should_compile/T6056.stderr    | 24 ++++++++--------------
 .../tests/simplCore/should_compile/T7785.stderr    |  2 +-
 .../tests/simplCore/should_compile/T8848.stderr    | 18 ++++++++--------
 4 files changed, 22 insertions(+), 28 deletions(-)

diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 09acd70..bc04e06 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -1196,8 +1196,12 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs
                            Just this_mod  -- Specialising imoprted fn
                                -> ptext (sLit "SPEC/") <> ppr this_mod
 
-                rule_name = mkFastString $ showSDocDump dflags $
+                rule_name = mkFastString $ showSDocForUser dflags neverQualify $
                             herald <+> ppr fn <+> hsep (map ppr_call_key_ty call_ts)
+                            -- This name ends up in interface files, so use showSDocForUser,
+                            -- otherwise uniques end up there, making builds
+                            -- less deterministic (See #4012 comment:61 ff)
+
                 spec_env_rule = mkRule True {- Auto generated -} is_local
                                   rule_name
                                   inl_act       -- Note [Auto-specialisation and RULES]
diff --git a/testsuite/tests/simplCore/should_compile/T6056.stderr b/testsuite/tests/simplCore/should_compile/T6056.stderr
index d1ae187..b38e34d 100644
--- a/testsuite/tests/simplCore/should_compile/T6056.stderr
+++ b/testsuite/tests/simplCore/should_compile/T6056.stderr
@@ -1,20 +1,12 @@
 Rule fired: foldr/nil
 Rule fired: foldr/nil
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Integer
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
 Rule fired: Class op <
 Rule fired: Class op <
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Integer.Type.Integer
-Rule fired:
-    SPEC/main at main:T6056 T6056a.$wsmallerAndRest @ GHC.Types.Int
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Integer
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Integer
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Int
+Rule fired: SPEC/T6056 $wsmallerAndRest @ Integer
diff --git a/testsuite/tests/simplCore/should_compile/T7785.stderr b/testsuite/tests/simplCore/should_compile/T7785.stderr
index c80738f..db80b99 100644
--- a/testsuite/tests/simplCore/should_compile/T7785.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7785.stderr
@@ -1,6 +1,6 @@
 
 ==================== Tidy Core rules ====================
-"SPEC Foo.shared @ []" [ALWAYS]
+"SPEC shared @ []" [ALWAYS]
     forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int).
       shared @ [] $dMyFunctor irred
       = bar_$sshared
diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr
index ba77c46..dad6b17 100644
--- a/testsuite/tests/simplCore/should_compile/T8848.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8848.stderr
@@ -16,13 +16,11 @@ Rule fired: Class op <*>
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
-Rule fired:
-    SPEC/main at main:T8848 GHC.Base.liftA2 _ _ _ @ (T8848.Shape 'T8848.Z)
+Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape 'Z)
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
-Rule fired:
-    SPEC/main at main:T8848 GHC.Base.liftA2 _ _ _ @ (T8848.Shape 'T8848.Z)
+Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape 'Z)
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
@@ -31,13 +29,13 @@ Rule fired: Class op fmap
 Rule fired: Class op <*>
 Rule fired: Class op fmap
 Rule fired: Class op fmap
-Rule fired: SPEC $cfmap @ 'T8848.Z
-Rule fired: SPEC $c<$ @ 'T8848.Z
-Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z
+Rule fired: SPEC $cfmap @ 'Z
+Rule fired: SPEC $c<$ @ 'Z
+Rule fired: SPEC $fFunctorShape @ 'Z
 Rule fired: Class op fmap
 Rule fired: Class op fmap
-Rule fired: SPEC $c<$ @ 'T8848.Z
-Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z
-Rule fired: SPEC T8848.$fFunctorShape @ 'T8848.Z
+Rule fired: SPEC $c<$ @ 'Z
+Rule fired: SPEC $fFunctorShape @ 'Z
+Rule fired: SPEC $fFunctorShape @ 'Z
 Rule fired: Class op fmap
 Rule fired: Class op fmap