1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
module ShouldSucceed where
-- import TheUtils
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List (partition )
data Digraph vertex = MkDigraph [vertex]
type Edge vertex = (vertex, vertex)
type Cycle vertex = [vertex]
mkDigraph = MkDigraph
stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
stronglyConnComp es vs
= snd (span_tree (new_range reversed_edges)
([],[])
( snd (dfs (new_range es) ([],[]) vs) )
)
where
reversed_edges = map swap es
swap :: Edge v -> Edge v
swap (x,y) = (y, x)
new_range [] w = []
new_range ((x,y):xys) w
= if x==w
then (y : (new_range xys w))
else (new_range xys w)
span_tree r (vs,ns) [] = (vs,ns)
span_tree r (vs,ns) (x:xs)
| x `elem` vs = span_tree r (vs,ns) xs
| otherwise = span_tree r (vs',(x:ns'):ns) xs
where
(vs',ns') = dfs r (x:vs,[]) (r x)
dfs r (vs,ns) [] = (vs,ns)
dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
| otherwise = dfs r (vs',(x:ns')++ns) xs
where
(vs',ns') = dfs r (x:vs,[]) (r x)
isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool
isCyclic edges [v] = (v,v) `elem` edges
isCyclic edges vs = True
topSort :: (Eq vertex) => [Edge vertex] -> [vertex]
-> MaybeErr [vertex] [[vertex]]
topSort edges vertices
= case cycles of
[] -> Succeeded [v | [v] <- singletons]
_ -> Failed cycles
where
sccs = stronglyConnComp edges vertices
(cycles, singletons) = partition (isCyclic edges) sccs
type FlattenedDependencyInfo vertex name code
= [(vertex, Set name, Set name, code)]
mkVertices :: FlattenedDependencyInfo vertex name code -> [vertex]
mkVertices info = [ vertex | (vertex,_,_,_) <- info]
mkEdges :: (Eq vertex, Ord name) =>
[vertex]
-> FlattenedDependencyInfo vertex name code
-> [Edge vertex]
mkEdges vertices flat_info
= [ (source_vertex, target_vertex)
| (source_vertex, _, used_names, _) <- flat_info,
target_name <- Set.toList used_names,
target_vertex <- vertices_defining target_name flat_info
]
where
vertices_defining name flat_info
= [ vertex | (vertex, names_defined, _, _) <- flat_info,
name `Set.member` names_defined
]
lookupVertex :: (Eq vertex, Ord name) =>
FlattenedDependencyInfo vertex name code
-> vertex
-> code
lookupVertex flat_info vertex
= head code_list
where
code_list = [ code | (vertex',_,_,code) <- flat_info, vertex == vertex']
isRecursiveCycle :: (Eq vertex) => Cycle vertex -> [Edge vertex] -> Bool
isRecursiveCycle [vertex] edges = (vertex, vertex) `elem` edges
isRecursiveCycle cycle edges = True
-- may go to TheUtils
data MaybeErr a b = Succeeded a | Failed b
|
