diff --git a/compiler/basicTypes/NameEnv.hs b/compiler/basicTypes/NameEnv.hs index 46819a7b94abe810ec814989b66dc529240a59d2..024e3d8e06ed0c0932cc0c6c6966b41176bd40f9 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 dafaea31565988e7fe7bcc97f431f142d5616f91..e756b06ac051c7dd98d22fb4d2549131305f3d1d 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 86c03ac2c4c3d677426c52f791245d077490b6aa..5d6710197bc71d64a19837c4efa4a2f63844cccf 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 537d9601b73550676670a1e1e8f62c4382f9e763..1aa3111655e64ee11b85b6aa37d1f84deb5b2a68 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 c02ad7a671d309aa1ccbaf229e1a007becd214f6..93f1cd44bb7418c910f2e7283e866e9611ec4ead 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 6bb7f8a8750bfc3d0a6f0aa800add373507ef2e0..2bf9e1cc2e55565188c16f75270d491d54ea4d7b 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 07ff1ca8871931ac83f6b593879994d9fd20ced7..ac38e2b45016b2d725afd60033f31f0e49247aee 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 ed2ff7bf93b1d33f06730d3ff5186098c87c5a6e..b97246012ae7e21b0b32de864fe8d2df8e8193a1 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 3b23bb602f8d167985e2849e5fb22288e86724b1..4790adad1f5018e4f5493bc20f595503733197dd 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 c9da7b7a428d081bc122949309a9c7610168551c..27e5a7d97e8fe285934e312e0c0374bdad85d2e1 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 d23b9527c5604fbecf75c5a00bc3fe8f846e4d68..7c45ac7b597996ed4978de6e78a95b8dc1ec2974 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 f54ff5723fe7c2ab36e3d8ce0f26e284a1463e75..71f5bb7b91e515a52b52f8c6adf39ca652bff4fc 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 ea1220e14e81606dd5dd8d71a442fe334a66d3ed..a8bb35ddd5c501aad56ec6ad557f363f8ebdf136 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 c04c750bfe84bdc2efa8585ad009f19978f58be0..d073473e980b66360a0216af604e11f34d999c54 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 93161b7f7fd5f654d576a929f4c4b40e937f9f4f..c67b4ef08b8614fe2b125f72870c809de50285ba 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 1d6ef24e61c4be6b8c9c2e392a9d76ade9bffe71..93906b237a893bed3033262cdf5d3f454feefa00 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 75d43d4e36caf3a3e36b83e19569543e817a4398..7963ae73752d2d6b18f676c3237fb7977416c004 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 7d1c5896df4e10e163d275db5792a08914a8a38b..9ba9b7f09e62a763cc97911f3018dcdf7e45e06f 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