tc065.hs 2.75 KB
Newer Older
1
2
3
module ShouldSucceed where

-- import TheUtils
4
5
import qualified Data.Set as Set
import Data.Set (Set)
6
import Data.List (partition )
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

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,
79
     target_name   <- Set.toList used_names,
80
81
82
83
84
     target_vertex <- vertices_defining target_name flat_info
   ]
 where
   vertices_defining name flat_info
    = [ vertex |  (vertex, names_defined, _, _) <- flat_info,
85
   		name `Set.member` names_defined
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
      ]

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