5 import List (partition )
7 data Digraph vertex = MkDigraph [vertex]
9 type Edge vertex = (vertex, vertex)
10 type Cycle vertex = [vertex]
14 stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
15 stronglyConnComp es vs
16 = snd (span_tree (new_range reversed_edges)
18 ( snd (dfs (new_range es) ([],[]) vs) )
21 reversed_edges = map swap es
23 swap :: Edge v -> Edge v
27 new_range ((x,y):xys) w
29 then (y : (new_range xys w))
30 else (new_range xys w)
32 span_tree r (vs,ns) [] = (vs,ns)
33 span_tree r (vs,ns) (x:xs)
34 | x `elem` vs = span_tree r (vs,ns) xs
35 | otherwise = span_tree r (vs',(x:ns'):ns) xs
37 (vs',ns') = dfs r (x:vs,[]) (r x)
39 dfs r (vs,ns) [] = (vs,ns)
40 dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
41 | otherwise = dfs r (vs',(x:ns')++ns) xs
43 (vs',ns') = dfs r (x:vs,[]) (r x)
46 isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool
47 isCyclic edges [v] = (v,v) `elem` edges
48 isCyclic edges vs = True
51 topSort :: (Eq vertex) => [Edge vertex] -> [vertex]
52 -> MaybeErr [vertex] [[vertex]]
55 topSort edges vertices
57 [] -> Succeeded [v | [v] <- singletons]
60 sccs = stronglyConnComp edges vertices
61 (cycles, singletons) = partition (isCyclic edges) sccs
64 type FlattenedDependencyInfo vertex name code
65 = [(vertex, Set name, Set name, code)]
67 mkVertices :: FlattenedDependencyInfo vertex name code -> [vertex]
68 mkVertices info = [ vertex | (vertex,_,_,_) <- info]
70 mkEdges :: (Eq vertex, Ord name) =>
72 -> FlattenedDependencyInfo vertex name code
75 mkEdges vertices flat_info
76 = [ (source_vertex, target_vertex)
77 | (source_vertex, _, used_names, _) <- flat_info,
78 target_name <- setToList used_names,
79 target_vertex <- vertices_defining target_name flat_info
82 vertices_defining name flat_info
83 = [ vertex | (vertex, names_defined, _, _) <- flat_info,
84 name `elementOf` names_defined
87 lookupVertex :: (Eq vertex, Ord name) =>
88 FlattenedDependencyInfo vertex name code
92 lookupVertex flat_info vertex
95 code_list = [ code | (vertex',_,_,code) <- flat_info, vertex == vertex']
98 isRecursiveCycle :: (Eq vertex) => Cycle vertex -> [Edge vertex] -> Bool
99 isRecursiveCycle [vertex] edges = (vertex, vertex) `elem` edges
100 isRecursiveCycle cycle edges = True
104 -- may go to TheUtils
106 data MaybeErr a b = Succeeded a | Failed b