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

1 files changed, 15 insertions, 18 deletions

diff --git a/compiler/utils/Digraph.hs b/compiler/utils/Digraph.hs
index d5924a95e2..c6e63fb753 100644
--- a/compiler/utils/Digraph.hs
+++ b/compiler/utils/Digraph.hs
@@ -51,7 +51,6 @@ import Control.Monad.ST
 import Data.Maybe
 import Data.Array
 import Data.List hiding (transpose)
-import Data.Ord
 import Data.Array.ST
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -97,7 +96,9 @@ emptyGraph :: Graph a
 emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing)
 
 graphFromEdgedVertices
-        :: Ord key
+        :: Ord key                      -- We only use Ord for efficiency,
+                                        -- it doesn't effect the result, so
+                                        -- it can be safely used with Unique's.
         => [Node key payload]           -- The graph; its ok for the
                                         -- out-list to contain keys which arent
                                         -- a vertex key, they are ignored
@@ -106,34 +107,30 @@ graphFromEdgedVertices []             = emptyGraph
 graphFromEdgedVertices edged_vertices = Graph graph vertex_fn (key_vertex . key_extractor)
   where key_extractor (_, k, _) = k
         (bounds, vertex_fn, key_vertex, numbered_nodes) = reduceNodesIntoVertices edged_vertices key_extractor
-        graph = array bounds [(v, mapMaybe key_vertex ks) | (v, (_, _, ks)) <- numbered_nodes]
+        graph = array bounds [ (v, sort $ mapMaybe key_vertex ks)
+                             | (v, (_, _, ks)) <- numbered_nodes]
+                -- We normalize outgoing edges by sorting on node order, so
+                -- that the result doesn't depend on the order of the edges
+
 
 reduceNodesIntoVertices
         :: Ord key
         => [node]
         -> (node -> key)
-        -> (Bounds, Vertex -> node, key -> Maybe Vertex, [(Int, node)])
+        -> (Bounds, Vertex -> node, key -> Maybe Vertex, [(Vertex, node)])
 reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_vertex, numbered_nodes)
   where
     max_v           = length nodes - 1
     bounds          = (0, max_v) :: (Vertex, Vertex)
 
-    sorted_nodes    = sortBy (comparing key_extractor) nodes
-    numbered_nodes  = zipWith (,) [0..] sorted_nodes
-
-    key_map         = array bounds [(i, key_extractor node) | (i, node) <- numbered_nodes]
+    -- Keep the order intact to make the result depend on input order
+    -- instead of key order
+    numbered_nodes  = zip [0..] nodes
     vertex_map      = array bounds numbered_nodes
 
-    --key_vertex :: key -> Maybe Vertex
-    -- returns Nothing for non-interesting vertices
-    key_vertex k = find 0 max_v
-      where
-        find a b | a > b = Nothing
-                 | otherwise = let mid = (a + b) `div` 2
-                               in case compare k (key_map ! mid) of
-                                    LT -> find a (mid - 1)
-                                    EQ -> Just mid
-                                    GT -> find (mid + 1) b
+    key_map = Map.fromList
+      [ (key_extractor node, v) | (v, node) <- numbered_nodes ]
+    key_vertex k = Map.lookup k key_map
 
 {-
 ************************************************************************