summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/basicTypes/NameEnv.hs2
-rw-r--r--compiler/cmm/CmmBuildInfoTables.hs2
-rw-r--r--compiler/codeGen/StgCmmUtils.hs2
-rw-r--r--compiler/iface/MkIface.hs2
-rw-r--r--compiler/main/GhcMake.hs5
-rw-r--r--compiler/nativeGen/AsmCodeGen.hs2
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs4
-rw-r--r--compiler/nativeGen/RegAlloc/Liveness.hs6
-rw-r--r--compiler/rename/RnSource.hs5
-rw-r--r--compiler/simplCore/OccurAnal.hs10
-rw-r--r--compiler/typecheck/TcBinds.hs2
-rw-r--r--compiler/typecheck/TcEvidence.hs2
-rw-r--r--compiler/typecheck/TcSMonad.hs2
-rw-r--r--compiler/typecheck/TcTyDecls.hs5
-rw-r--r--compiler/types/Type.hs2
-rw-r--r--compiler/utils/Digraph.hs127
-rw-r--r--compiler/vectorise/Vectorise/Type/Classify.hs2
-rw-r--r--testsuite/tests/determinism/determinism001.hs2
18 files changed, 136 insertions, 48 deletions
diff --git a/compiler/basicTypes/NameEnv.hs b/compiler/basicTypes/NameEnv.hs
index 46819a7b94..024e3d8e06 100644
--- a/compiler/basicTypes/NameEnv.hs
+++ b/compiler/basicTypes/NameEnv.hs
@@ -66,7 +66,7 @@ depAnal :: (node -> [Name]) -- Defs
--
-- The get_defs and get_uses functions are called only once per node
depAnal get_defs get_uses nodes
- = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
+ = stronglyConnCompFromEdgedVerticesUniq (map mk_node keyed_nodes)
where
keyed_nodes = nodes `zip` [(1::Int)..]
mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index dafaea3156..e756b06ac0 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -273,7 +273,7 @@ mkTopCAFInfo localCAFs = foldl addToTop Map.empty g
cafset = foldr Set.delete (foldl Set.union Set.empty cafsets) lbls
in foldl (\env l -> Map.insert l (flatten env cafset) env) env lbls
- g = stronglyConnCompFromEdgedVertices
+ g = stronglyConnCompFromEdgedVerticesOrd
[ ((l,cafs), l, Set.elems cafs) | (cafs, Just l) <- localCAFs ]
flatten :: Map CLabel CAFSet -> CAFSet -> CAFSet
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 86c03ac2c4..5d6710197b 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -411,7 +411,7 @@ unscramble dflags vertices = mapM_ do_component components
stmt1 `mustFollow` stmt2 ]
components :: [SCC Vrtx]
- components = stronglyConnCompFromEdgedVertices edges
+ components = stronglyConnCompFromEdgedVerticesUniq edges
-- do_components deal with one strongly-connected component
-- Not cyclic, or singleton? Just do it
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 537d9601b7..1aa3111655 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -416,7 +416,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
where n = ifName d
-- strongly-connected groups of declarations, in dependency order
- groups = stronglyConnCompFromEdgedVertices edges
+ groups = stronglyConnCompFromEdgedVerticesUniq edges
global_hash_fn = mkHashFun hsc_env eps
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index c02ad7a671..93f1cd44bb 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1479,7 +1479,7 @@ topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
-- the specified node.
let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
| otherwise = throwGhcException (ProgramError "module does not exist")
- in graphFromEdgedVertices (seq root (reachableG graph root))
+ in graphFromEdgedVerticesUniq (seq root (reachableG graph root))
type SummaryNode = (ModSummary, Int, [Int])
@@ -1491,7 +1491,8 @@ summaryNodeSummary (s, _, _) = s
moduleGraphNodes :: Bool -> [ModSummary]
-> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
-moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
+moduleGraphNodes drop_hs_boot_nodes summaries =
+ (graphFromEdgedVerticesUniq nodes, lookup_node)
where
numbered_summaries = zip summaries [1..]
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 6bb7f8a875..2bf9e1cc2e 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -764,7 +764,7 @@ sccBlocks
, BlockId
, [BlockId])]
-sccBlocks blocks = stronglyConnCompFromEdgedVerticesR (map mkNode blocks)
+sccBlocks blocks = stronglyConnCompFromEdgedVerticesUniqR (map mkNode blocks)
-- we're only interested in the last instruction of
-- the block, and only if it has a single destination.
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 07ff1ca887..ac38e2b450 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -169,7 +169,7 @@ joinToTargets_again
--
-- We need to do the R2 -> R3 move before R1 -> R2.
--
- let sccs = stronglyConnCompFromEdgedVerticesR graph
+ let sccs = stronglyConnCompFromEdgedVerticesOrdR graph
{- -- debugging
pprTrace
@@ -313,7 +313,7 @@ handleComponent delta instr
instrLoad <- loadR (RegReal dreg) slot
remainingFixUps <- mapM (handleComponent delta instr)
- (stronglyConnCompFromEdgedVerticesR rest)
+ (stronglyConnCompFromEdgedVerticesOrdR rest)
-- make sure to do all the reloads after all the spills,
-- so we don't end up clobbering the source values.
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index ed2ff7bf93..b97246012a 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -679,13 +679,13 @@ sccBlocks blocks entries = map (fmap get_node) sccs
nodes = [ (block, id, getOutEdges instrs)
| block@(BasicBlock id instrs) <- blocks ]
- g1 = graphFromEdgedVertices nodes
+ g1 = graphFromEdgedVerticesUniq nodes
reachable :: BlockSet
reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ]
- g2 = graphFromEdgedVertices [ node | node@(_,id,_) <- nodes
- , id `setMember` reachable ]
+ g2 = graphFromEdgedVerticesUniq [ node | node@(_,id,_) <- nodes
+ , id `setMember` reachable ]
sccs = stronglyConnCompG g2
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 3b23bb602f..4790adad1f 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -49,7 +49,8 @@ import DynFlags
import Util ( debugIsOn, partitionWith )
import HscTypes ( HscEnv, hsc_dflags )
import ListSetOps ( findDupsEq, removeDups, equivClasses )
-import Digraph ( SCC, flattenSCC, flattenSCCs, stronglyConnCompFromEdgedVertices )
+import Digraph ( SCC, flattenSCC, flattenSCCs
+ , stronglyConnCompFromEdgedVerticesUniq )
import UniqFM
import qualified GHC.LanguageExtensions as LangExt
@@ -1338,7 +1339,7 @@ depAnalTyClDecls :: GlobalRdrEnv
-> [SCC (LTyClDecl Name)]
-- See Note [Dependency analysis of type, class, and instance decls]
depAnalTyClDecls rdr_env ds_w_fvs
- = stronglyConnCompFromEdgedVertices edges
+ = stronglyConnCompFromEdgedVerticesUniq edges
where
edges = [ (d, tcdName (unLoc d), map (getParent rdr_env) (nonDetEltsUFM fvs))
| (d, fvs) <- ds_w_fvs ]
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index c9da7b7a42..27e5a7d97e 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -34,7 +34,7 @@ import VarEnv
import Var
import Demand ( argOneShots, argsOneShots )
import Maybes ( orElse )
-import Digraph ( SCC(..), stronglyConnCompFromEdgedVerticesR )
+import Digraph ( SCC(..), stronglyConnCompFromEdgedVerticesUniqR )
import Unique
import UniqFM
import Util
@@ -193,10 +193,12 @@ occAnalRecBind env imp_rule_edges pairs body_usage
bndr_set = mkVarSet (map fst pairs)
sccs :: [SCC (Node Details)]
- sccs = {-# SCC "occAnalBind.scc" #-} stronglyConnCompFromEdgedVerticesR nodes
+ sccs = {-# SCC "occAnalBind.scc" #-}
+ stronglyConnCompFromEdgedVerticesUniqR nodes
nodes :: [Node Details]
- nodes = {-# SCC "occAnalBind.assoc" #-} map (makeNode env imp_rule_edges bndr_set) pairs
+ nodes = {-# SCC "occAnalBind.assoc" #-}
+ map (makeNode env imp_rule_edges bndr_set) pairs
{-
Note [Dead code]
@@ -863,7 +865,7 @@ loopBreakNodes :: Int
-> [Binding]
-- Return the bindings sorted into a plausible order, and marked with loop breakers.
loopBreakNodes depth bndr_set weak_fvs nodes binds
- = go (stronglyConnCompFromEdgedVerticesR nodes) binds
+ = go (stronglyConnCompFromEdgedVerticesUniqR nodes) binds
where
go [] binds = binds
go (scc:sccs) binds = loop_break_scc scc (go sccs binds)
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index d23b9527c5..7c45ac7b59 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -441,7 +441,7 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside
isPatSyn _ = False
sccs :: [SCC (LHsBind Name)]
- sccs = stronglyConnCompFromEdgedVertices (mkEdges sig_fn binds)
+ sccs = stronglyConnCompFromEdgedVerticesUniq (mkEdges sig_fn binds)
go :: [SCC (LHsBind Name)] -> TcM (LHsBinds TcId, thing)
go (scc:sccs) = do { (binds1, ids1) <- tc_scc scc
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index f54ff5723f..71f5bb7b91 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -687,7 +687,7 @@ evVarsOfTerms = mapUnionVarSet evVarsOfTerm
-- | Do SCC analysis on a bag of 'EvBind's.
sccEvBinds :: Bag EvBind -> [SCC EvBind]
-sccEvBinds bs = stronglyConnCompFromEdgedVertices edges
+sccEvBinds bs = stronglyConnCompFromEdgedVerticesUniq edges
where
edges :: [(EvBind, EvVar, [EvVar])]
edges = foldrBag ((:) . mk_node) [] bs
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index ea1220e14e..a8bb35ddd5 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -2473,7 +2473,7 @@ checkForCyclicBinds ev_binds
= pprPanic "Cycle in coercion bindings" $ ppr coercion_cycles
where
cycles :: [[EvBind]]
- cycles = [c | CyclicSCC c <- stronglyConnCompFromEdgedVertices edges]
+ cycles = [c | CyclicSCC c <- stronglyConnCompFromEdgedVerticesUniq edges]
coercion_cycles = [c | c <- cycles, any is_co_bind c]
is_co_bind (EvBind { eb_lhs = b }) = isEqPred (varType b)
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index c04c750bfe..d073473e98 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -141,7 +141,7 @@ mkSynEdges syn_decls = [ (ldecl, name, nonDetEltsUFM fvs)
-- Note [Deterministic SCC] in Digraph.
calcSynCycles :: [LTyClDecl Name] -> [SCC (LTyClDecl Name)]
-calcSynCycles = stronglyConnCompFromEdgedVertices . mkSynEdges
+calcSynCycles = stronglyConnCompFromEdgedVerticesUniq . mkSynEdges
{- Note [Superclass cycle check]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -471,7 +471,8 @@ findLoopBreakers deps
= go [(tc,tc,ds) | (tc,ds) <- deps]
where
go edges = [ name
- | CyclicSCC ((tc,_,_) : edges') <- stronglyConnCompFromEdgedVerticesR edges,
+ | CyclicSCC ((tc,_,_) : edges') <-
+ stronglyConnCompFromEdgedVerticesUniqR edges,
name <- tyConName tc : go edges']
{-
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 93161b7f7f..c67b4ef08b 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -1847,7 +1847,7 @@ isVoidTy ty = case repType ty of
toposortTyVars :: [TyVar] -> [TyVar]
toposortTyVars tvs = reverse $
[ tv | (tv, _, _) <- topologicalSortG $
- graphFromEdgedVertices nodes ]
+ graphFromEdgedVerticesOrd nodes ]
where
var_ids :: VarEnv Int
var_ids = mkVarEnv (zip tvs [1..])
diff --git a/compiler/utils/Digraph.hs b/compiler/utils/Digraph.hs
index 1d6ef24e61..93906b237a 100644
--- a/compiler/utils/Digraph.hs
+++ b/compiler/utils/Digraph.hs
@@ -3,7 +3,7 @@
{-# LANGUAGE CPP, ScopedTypeVariables #-}
module Digraph(
- Graph, graphFromEdgedVertices,
+ Graph, graphFromEdgedVerticesOrd, graphFromEdgedVerticesUniq,
SCC(..), Node, flattenSCC, flattenSCCs,
stronglyConnCompG,
@@ -17,7 +17,10 @@ module Digraph(
findCycle,
-- For backwards compatability with the simpler version of Digraph
- stronglyConnCompFromEdgedVertices, stronglyConnCompFromEdgedVerticesR,
+ stronglyConnCompFromEdgedVerticesOrd,
+ stronglyConnCompFromEdgedVerticesOrdR,
+ stronglyConnCompFromEdgedVerticesUniq,
+ stronglyConnCompFromEdgedVerticesUniqR,
) where
#include "HsVersions.h"
@@ -57,6 +60,8 @@ import qualified Data.Set as Set
import qualified Data.Graph as G
import Data.Graph hiding (Graph, Edge, transposeG, reachable)
import Data.Tree
+import Unique
+import UniqFM
{-
************************************************************************
@@ -96,29 +101,71 @@ emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing)
-- See Note [Deterministic SCC]
graphFromEdgedVertices
- :: 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
+ :: ReduceFn key payload
+ -> [Node key payload] -- The graph; its ok for the
-- out-list to contain keys which arent
-- a vertex key, they are ignored
-> Graph (Node key payload)
-graphFromEdgedVertices [] = emptyGraph
-graphFromEdgedVertices edged_vertices = Graph graph vertex_fn (key_vertex . key_extractor)
+graphFromEdgedVertices _reduceFn [] = emptyGraph
+graphFromEdgedVertices reduceFn 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
+ (bounds, vertex_fn, key_vertex, numbered_nodes) =
+ reduceFn edged_vertices key_extractor
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
+-- See Note [Deterministic SCC]
+-- See Note [reduceNodesIntoVertices implementations]
+graphFromEdgedVerticesOrd
+ :: Ord key
+ => [Node key payload] -- The graph; its ok for the
+ -- out-list to contain keys which arent
+ -- a vertex key, they are ignored
+ -> Graph (Node key payload)
+graphFromEdgedVerticesOrd = graphFromEdgedVertices reduceNodesIntoVerticesOrd
+
+-- See Note [Deterministic SCC]
+-- See Note [reduceNodesIntoVertices implementations]
+graphFromEdgedVerticesUniq
+ :: Uniquable key
+ => [Node key payload] -- The graph; its ok for the
+ -- out-list to contain keys which arent
+ -- a vertex key, they are ignored
+ -> Graph (Node key payload)
+graphFromEdgedVerticesUniq = graphFromEdgedVertices reduceNodesIntoVerticesUniq
+
+type ReduceFn key payload =
+ [Node key payload] -> (Node key payload -> key) ->
+ (Bounds, Vertex -> Node key payload
+ , key -> Maybe Vertex, [(Vertex, Node key payload)])
+{-
+Note [reduceNodesIntoVertices implementations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+reduceNodesIntoVertices is parameterized by the container type.
+This is to accomodate key types that don't have an Ord instance
+and hence preclude the use of Data.Map. An example of such type
+would be Unique, there's no way to implement Ord Unique
+deterministically.
+
+For such types, there's a version with a Uniquable constraint.
+This leaves us with two versions of every function that depends on
+reduceNodesIntoVertices, one with Ord constraint and the other with
+Uniquable constraint.
+For example: graphFromEdgedVerticesOrd and graphFromEdgedVerticesUniq.
+
+The Uniq version should be a tiny bit more efficient since it uses
+Data.IntMap internally.
+-}
reduceNodesIntoVertices
- :: Ord key
- => [node]
- -> (node -> key)
- -> (Bounds, Vertex -> node, key -> Maybe Vertex, [(Vertex, node)])
-reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_vertex, numbered_nodes)
+ :: ([(key, Vertex)] -> m)
+ -> (key -> m -> Maybe Vertex)
+ -> ReduceFn key payload
+reduceNodesIntoVertices fromList lookup nodes key_extractor =
+ (bounds, (!) vertex_map, key_vertex, numbered_nodes)
where
max_v = length nodes - 1
bounds = (0, max_v) :: (Vertex, Vertex)
@@ -128,9 +175,17 @@ reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_verte
numbered_nodes = zip [0..] nodes
vertex_map = array bounds numbered_nodes
- key_map = Map.fromList
+ key_map = fromList
[ (key_extractor node, v) | (v, node) <- numbered_nodes ]
- key_vertex k = Map.lookup k key_map
+ key_vertex k = lookup k key_map
+
+-- See Note [reduceNodesIntoVertices implementations]
+reduceNodesIntoVerticesOrd :: Ord key => ReduceFn key payload
+reduceNodesIntoVerticesOrd = reduceNodesIntoVertices Map.fromList Map.lookup
+
+-- See Note [reduceNodesIntoVertices implementations]
+reduceNodesIntoVerticesUniq :: Uniquable key => ReduceFn key payload
+reduceNodesIntoVerticesUniq = reduceNodesIntoVertices listToUFM (flip lookupUFM)
{-
************************************************************************
@@ -204,7 +259,10 @@ edges going from them to earlier ones.
{-
Note [Deterministic SCC]
~~~~~~~~~~~~~~~~~~~~~~~~
-stronglyConnCompFromEdgedVertices and stronglyConnCompFromEdgedVerticesR
+stronglyConnCompFromEdgedVerticesUniq,
+stronglyConnCompFromEdgedVerticesUniqR,
+stronglyConnCompFromEdgedVerticesOrd and
+stronglyConnCompFromEdgedVerticesOrdR
provide a following guarantee:
Given a deterministically ordered list of nodes it returns a deterministically
ordered list of strongly connected components, where the list of vertices
@@ -230,22 +288,47 @@ decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest
-- The following two versions are provided for backwards compatability:
-- See Note [Deterministic SCC]
-stronglyConnCompFromEdgedVertices
+-- See Note [reduceNodesIntoVertices implementations]
+stronglyConnCompFromEdgedVerticesOrd
:: Ord key
=> [Node key payload]
-> [SCC payload]
-stronglyConnCompFromEdgedVertices
- = map (fmap get_node) . stronglyConnCompFromEdgedVerticesR
+stronglyConnCompFromEdgedVerticesOrd
+ = map (fmap get_node) . stronglyConnCompFromEdgedVerticesOrdR
+ where get_node (n, _, _) = n
+
+-- The following two versions are provided for backwards compatability:
+-- See Note [Deterministic SCC]
+-- See Note [reduceNodesIntoVertices implementations]
+stronglyConnCompFromEdgedVerticesUniq
+ :: Uniquable key
+ => [Node key payload]
+ -> [SCC payload]
+stronglyConnCompFromEdgedVerticesUniq
+ = map (fmap get_node) . stronglyConnCompFromEdgedVerticesUniqR
where get_node (n, _, _) = n
-- The "R" interface is used when you expect to apply SCC to
-- (some of) the result of SCC, so you dont want to lose the dependency info
-- See Note [Deterministic SCC]
-stronglyConnCompFromEdgedVerticesR
+-- See Note [reduceNodesIntoVertices implementations]
+stronglyConnCompFromEdgedVerticesOrdR
:: Ord key
=> [Node key payload]
-> [SCC (Node key payload)]
-stronglyConnCompFromEdgedVerticesR = stronglyConnCompG . graphFromEdgedVertices
+stronglyConnCompFromEdgedVerticesOrdR =
+ stronglyConnCompG . graphFromEdgedVertices reduceNodesIntoVerticesOrd
+
+-- The "R" interface is used when you expect to apply SCC to
+-- (some of) the result of SCC, so you dont want to lose the dependency info
+-- See Note [Deterministic SCC]
+-- See Note [reduceNodesIntoVertices implementations]
+stronglyConnCompFromEdgedVerticesUniqR
+ :: Uniquable key
+ => [Node key payload]
+ -> [SCC (Node key payload)]
+stronglyConnCompFromEdgedVerticesUniqR =
+ stronglyConnCompG . graphFromEdgedVertices reduceNodesIntoVerticesUniq
{-
************************************************************************
diff --git a/compiler/vectorise/Vectorise/Type/Classify.hs b/compiler/vectorise/Vectorise/Type/Classify.hs
index 75d43d4e36..7963ae7375 100644
--- a/compiler/vectorise/Vectorise/Type/Classify.hs
+++ b/compiler/vectorise/Vectorise/Type/Classify.hs
@@ -96,7 +96,7 @@ type TyConGroup = ([TyCon], UniqSet TyCon)
-- Compute mutually recursive groups of tycons in topological order.
--
tyConGroups :: [TyCon] -> [TyConGroup]
-tyConGroups tcs = map mk_grp (stronglyConnCompFromEdgedVertices edges)
+tyConGroups tcs = map mk_grp (stronglyConnCompFromEdgedVerticesUniq edges)
where
edges = [((tc, ds), tc, nonDetEltsUFM ds) | tc <- tcs
, let ds = tyConsOfTyCon tc]
diff --git a/testsuite/tests/determinism/determinism001.hs b/testsuite/tests/determinism/determinism001.hs
index 7d1c5896df..9ba9b7f09e 100644
--- a/testsuite/tests/determinism/determinism001.hs
+++ b/testsuite/tests/determinism/determinism001.hs
@@ -20,4 +20,4 @@ test003 = testSCC [("b", 1, []), ("c", 2, []), ("a", 3, [])]
test004 = testSCC [("b", 2, []), ("c", 3, []), ("a", 1, [])]
-testSCC = flattenSCCs . stronglyConnCompFromEdgedVertices
+testSCC = flattenSCCs . stronglyConnCompFromEdgedVerticesOrd
View Lorry Controller Status