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