Make stronglyConnCompFromEdgedVertices deterministic

This makes it so the result of computing SCC's depends on the order
the nodes were passed to it, but not on the order on the user provided
key type.
The key type is usually `Unique` which is known to be nondeterministic.

Test Plan:
`text` and `aeson` become deterministic after this
./validate

Compare compile time for `text`:
```
$ cabal get text && cd text* && cabal sandbox init && cabal install
--dependencies-only && time cabal build
real    0m59.459s
user    0m57.862s
sys     0m1.185s
$ cabal clean && time cabal build
real    1m0.037s
user    0m58.350s
sys     0m1.199s
$ cabal clean && time cabal build
real    0m57.634s
user    0m56.118s
sys     0m1.202s
$ cabal get text && cd text* && cabal sandbox init && cabal install
--dependencies-only && time cabal build
real    0m59.867s
user    0m58.176s
sys     0m1.188s
$ cabal clean && time cabal build
real    1m0.157s
user    0m58.622s
sys     0m1.177s
$ cabal clean && time cabal build
real    1m0.950s
user    0m59.397s
sys     0m1.083s
```

Reviewers: ezyang, simonmar, austin, bgamari

Reviewed By: simonmar, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1268

GHC Trac Issues: #4012

10 files changed, 109 insertions, 74 deletions

diff --git a/testsuite/tests/determinism/Makefile b/testsuite/tests/determinism/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/determinism/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/determinism/all.T b/testsuite/tests/determinism/all.T
new file mode 100644
index 0000000000..3d4ff2010d
--- /dev/null
+++ b/testsuite/tests/determinism/all.T
@@ -0,0 +1,3 @@
+setTestOpts(extra_hc_opts('-package ghc'))
+
+test('determinism001', normal, compile_and_run, [''])
diff --git a/testsuite/tests/determinism/determinism001.hs b/testsuite/tests/determinism/determinism001.hs
new file mode 100644
index 0000000000..7d1c5896df
--- /dev/null
+++ b/testsuite/tests/determinism/determinism001.hs
@@ -0,0 +1,23 @@
+module Main where
+
+import Digraph
+
+main = mapM_ print
+  [ test001
+  , test002
+  , test003
+  , test004
+  ]
+
+-- These check that the result of SCCs doesn't depend on the order of the key
+-- type (Int here).
+
+test001 = testSCC [("a", 1, []), ("b", 2, []), ("c", 3, [])]
+
+test002 = testSCC [("a", 2, []), ("b", 3, []), ("c", 1, [])]
+
+test003 = testSCC [("b", 1, []), ("c", 2, []), ("a", 3, [])]
+
+test004 = testSCC [("b", 2, []), ("c", 3, []), ("a", 1, [])]
+
+testSCC = flattenSCCs . stronglyConnCompFromEdgedVertices
diff --git a/testsuite/tests/determinism/determinism001.stdout b/testsuite/tests/determinism/determinism001.stdout
new file mode 100644
index 0000000000..c94a1fe80b
--- /dev/null
+++ b/testsuite/tests/determinism/determinism001.stdout
@@ -0,0 +1,4 @@
+["c","b","a"]
+["c","b","a"]
+["a","c","b"]
+["a","c","b"]
diff --git a/testsuite/tests/indexed-types/should_compile/T7837.stderr b/testsuite/tests/indexed-types/should_compile/T7837.stderr
index eff5d02d4f..838a8fb88e 100644
--- a/testsuite/tests/indexed-types/should_compile/T7837.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T7837.stderr
@@ -1,3 +1,3 @@
-Rule fired: Class op abs
 Rule fired: Class op signum
+Rule fired: Class op abs
 Rule fired: normalize/Double
diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout
index 943908249d..6d4b412ba7 100644
--- a/testsuite/tests/numeric/should_compile/T7116.stdout
+++ b/testsuite/tests/numeric/should_compile/T7116.stdout
@@ -1,61 +1,62 @@
-

-==================== Tidy Core ====================

-Result size of Tidy Core = {terms: 22, types: 14, coercions: 0}

-

--- RHS size: {terms: 8, types: 3, coercions: 0}

-dl :: Double -> Double

-[GblId,

- Arity=1,

- Caf=NoCafRefs,

- Str=DmdType <S,1*U(U)>m,

- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,

-         WorkFree=True, Expandable=True,

-         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)

-         Tmpl= \ (x [Occ=Once!] :: Double) ->

-                 case x of _ [Occ=Dead] { D# y -> D# (+## y y) }}]

-dl =

-  \ (x :: Double) -> case x of _ [Occ=Dead] { D# y -> D# (+## y y) }

-

--- RHS size: {terms: 1, types: 0, coercions: 0}

-dr :: Double -> Double

-[GblId,

- Arity=1,

- Caf=NoCafRefs,

- Str=DmdType <S,1*U(U)>m,

- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,

-         WorkFree=True, Expandable=True,

-         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)

-         Tmpl= \ (x [Occ=Once!] :: Double) ->

-                 case x of _ [Occ=Dead] { D# x1 -> D# (+## x1 x1) }}]

-dr = dl

-

--- RHS size: {terms: 8, types: 3, coercions: 0}

-fl :: Float -> Float

-[GblId,

- Arity=1,

- Caf=NoCafRefs,

- Str=DmdType <S,1*U(U)>m,

- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,

-         WorkFree=True, Expandable=True,

-         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)

-         Tmpl= \ (x [Occ=Once!] :: Float) ->

-                 case x of _ [Occ=Dead] { F# y -> F# (plusFloat# y y) }}]

-fl =

-  \ (x :: Float) ->

-    case x of _ [Occ=Dead] { F# y -> F# (plusFloat# y y) }

-

--- RHS size: {terms: 1, types: 0, coercions: 0}

-fr :: Float -> Float

-[GblId,

- Arity=1,

- Caf=NoCafRefs,

- Str=DmdType <S,1*U(U)>m,

- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,

-         WorkFree=True, Expandable=True,

-         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)

-         Tmpl= \ (x [Occ=Once!] :: Float) ->

-                 case x of _ [Occ=Dead] { F# x1 -> F# (plusFloat# x1 x1) }}]

-fr = fl

-

-

-

+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 22, types: 14, coercions: 0}
+
+-- RHS size: {terms: 8, types: 3, coercions: 0}
+dr :: Double -> Double
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x [Occ=Once!] :: Double) ->
+                 case x of _ [Occ=Dead] { D# x1 -> D# (+## x1 x1) }}]
+dr =
+  \ (x :: Double) ->
+    case x of _ [Occ=Dead] { D# x1 -> D# (+## x1 x1) }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0}
+dl :: Double -> Double
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x [Occ=Once!] :: Double) ->
+                 case x of _ [Occ=Dead] { D# y -> D# (+## y y) }}]
+dl = dr
+
+-- RHS size: {terms: 8, types: 3, coercions: 0}
+fr :: Float -> Float
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x [Occ=Once!] :: Float) ->
+                 case x of _ [Occ=Dead] { F# x1 -> F# (plusFloat# x1 x1) }}]
+fr =
+  \ (x :: Float) ->
+    case x of _ [Occ=Dead] { F# x1 -> F# (plusFloat# x1 x1) }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0}
+fl :: Float -> Float
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x [Occ=Once!] :: Float) ->
+                 case x of _ [Occ=Dead] { F# y -> F# (plusFloat# y y) }}]
+fl = fr
+
+
+
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 7ded1feac4..296a6c2742 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -578,11 +578,12 @@ test('T9020',
           [(wordsize(32), 343005716, 10),
            # Original:    381360728
            # 2014-07-31:  343005716 (Windows) (general round of updates)
-           (wordsize(64), 680162056, 10)])
+           (wordsize(64), 786189008, 10)])
            # prev:        795469104
            # 2014-07-17:  728263536 (general round of updates)
            # 2014-09-10:  785871680 post-AMP-cleanup
            # 2014-11-03:  680162056 Further Applicative and Monad adjustments
+           # 2015-10-21:  786189008 Make stronglyConnCompFromEdgedVertices deterministic
       ],
       compile,[''])
 
diff --git a/testsuite/tests/simplCore/should_compile/T8274.stdout b/testsuite/tests/simplCore/should_compile/T8274.stdout
index 9da4d97f9e..35f2412bc4 100644
--- a/testsuite/tests/simplCore/should_compile/T8274.stdout
+++ b/testsuite/tests/simplCore/should_compile/T8274.stdout
@@ -1,2 +1,2 @@
-n = T8274.Negatives -4# -4.0# -4.0##
 p = T8274.Positives 42# 4.23# 4.23## '4'# 4##
+n = T8274.Negatives -4# -4.0# -4.0##
diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr
index 5bdd0076ce..abd6839db2 100644
--- a/testsuite/tests/simplCore/should_compile/T8848.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8848.stderr
@@ -3,18 +3,14 @@ Rule fired: Class op <*>
 Rule fired: Class op <*>
 Rule fired: SPEC map2
 Rule fired: Class op fmap
-Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
-Rule fired: Class op <*>
+Rule fired: Class op fmap
 Rule fired: Class op $p1Applicative
 Rule fired: Class op <$
 Rule fired: Class op <*>
 Rule fired: Class op $p1Applicative
-Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
-Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape 'Z)
-Rule fired: Class op $p1Applicative
 Rule fired: Class op $p1Applicative
 Rule fired: Class op <$
 Rule fired: Class op <*>
@@ -24,8 +20,12 @@ Rule fired: Class op <*>
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
+Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
-Rule fired: Class op fmap
+Rule fired: Class op <*>
+Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape 'Z)
+Rule fired: Class op $p1Applicative
+Rule fired: Class op $p1Applicative
 Rule fired: SPEC $cfmap @ 'Z
 Rule fired: SPEC $c<$ @ 'Z
 Rule fired: SPEC $fFunctorShape @ 'Z
@@ -41,21 +41,21 @@ Rule fired: SPEC $c<*> @ 'Z
 Rule fired: SPEC $c*> @ 'Z
 Rule fired: SPEC $c<* @ 'Z
 Rule fired: SPEC $fApplicativeShape @ 'Z
-Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
 Rule fired: Class op $p1Applicative
 Rule fired: Class op <$
 Rule fired: Class op <*>
+Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
 Rule fired: Class op $p1Applicative
 Rule fired: Class op <$
 Rule fired: Class op <*>
-Rule fired: SPEC $c<* @ 'Z
 Rule fired: SPEC $c*> @ 'Z
+Rule fired: SPEC $c<* @ 'Z
 Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: Class op $p1Applicative
@@ -68,10 +68,10 @@ Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
-Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape ('S 'Z))
 Rule fired: Class op $p1Applicative
 Rule fired: Class op fmap
 Rule fired: Class op <*>
+Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape ('S 'Z))
 Rule fired: SPEC $fFunctorShape @ 'Z
 Rule fired: Class op fmap
 Rule fired: Class op fmap
diff --git a/testsuite/tests/stranal/should_compile/T10482a.stdout b/testsuite/tests/stranal/should_compile/T10482a.stdout
index bb19e36946..80ec26d661 100644
--- a/testsuite/tests/stranal/should_compile/T10482a.stdout
+++ b/testsuite/tests/stranal/should_compile/T10482a.stdout
@@ -1,4 +1,4 @@
+Foo.$wf4 [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# -> Int#
 Foo.$wf2 [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# -> Int#
 Foo.$wf1 [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int#
 Foo.$wf3 [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# -> Int#
-Foo.$wf4 [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# -> Int#