Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/graphs/subgraph.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/graphs/subgraph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/graphs/subgraph.sml

1 : monnier 245 (*
2 :     * Subgraph adaptor
3 :     *)
4 :    
5 :     signature SUBGRAPH_VIEW =
6 :     sig
7 :    
8 :     (* Node induced subgraph *)
9 :     val subgraph_view : Graph.node_id list ->
10 :     ('e Graph.edge -> bool) ->
11 :     ('n,'e,'g) Graph.graph ->
12 :     ('n,'e,'g) Graph.graph
13 :     end
14 :    
15 :     structure SubgraphView : SUBGRAPH_VIEW =
16 :     struct
17 :    
18 :     structure G = Graph
19 :     structure Set = HashSet
20 :    
21 :     fun subgraph_view nodes edge_pred (G.GRAPH G) =
22 :     let val set = Set.create{order=Int.compare,hash=fn i=>i} 10
23 :     val ins = Set.insert set
24 :     val rmv = Set.remove set
25 :     val find = Set.contains set
26 :     val _ = app ins nodes
27 :     fun edge_p (e as (i,j,_)) = find i andalso find j andalso edge_pred e
28 :     fun check i = if find i then () else raise G.Subgraph
29 :     fun check_edge e = if edge_p e then () else raise G.Subgraph
30 :     fun add_node (n as (i,_)) = (ins i; #add_node G n)
31 :     fun add_edge (e as (i,j,_)) = (check i; check j; #add_edge G e)
32 :     fun remove_node i = (check i; rmv i; #remove_node G i)
33 :     fun set_out_edges (i,es) =
34 :     (check i; app check_edge es; #set_out_edges G (i,es))
35 :     fun set_in_edges (j,es) =
36 :     (check j; app check_edge es; #set_in_edges G (j,es))
37 :     fun get_nodes () = Set.fold (fn (i,l) => (i,#node_info G i)::l) [] set
38 :     fun get_edges () =
39 :     let fun find_edges([],l) = l
40 :     | find_edges(e::es,l) =
41 :     if edge_p e then find_edges(es,e::l) else find_edges(es,l)
42 :     in Set.fold (fn (i,l) => find_edges(#out_edges G i,l)) [] set
43 :     end
44 :     fun order () = Set.size set
45 :     fun size () =
46 :     let fun find_edges([],n) = n
47 :     | find_edges(e::es,n) =
48 :     if edge_p e then find_edges(es,n+1) else find_edges(es,n)
49 :     in Set.fold (fn (i,n) => find_edges(#out_edges G i,n)) 0 set
50 :     end
51 :     fun out_edges i = (List.filter edge_p (#out_edges G i))
52 :     fun in_edges i = (List.filter edge_p (#in_edges G i))
53 :     fun get_succ i = map #2 (out_edges i)
54 :     fun get_pred i = map #1 (in_edges i)
55 :     fun has_edge (i,j) = find i andalso find j
56 :     fun has_node i = find i
57 :     fun node_info i = (check i; #node_info G i)
58 :    
59 :     fun entry_edges i = (List.filter(fn (j,_,_) => not(find j))
60 :     (#in_edges G i))
61 :     fun exit_edges i = (List.filter(fn (_,j,_) => not(find j))
62 :     (#out_edges G i))
63 :     fun entries() = Set.fold (fn (i,l) =>
64 :     if List.exists (fn (j,_,_) => not(find j))
65 :     (#in_edges G i) then i::l else l) [] set
66 :     fun exits() = Set.fold (fn (i,l) =>
67 :     if List.exists (fn (_,j,_) => not(find j))
68 :     (#out_edges G i) then i::l else l) [] set
69 :     fun forall_nodes f = Set.app (fn i => f(i,#node_info G i)) set
70 :     fun forall_edges f = Set.app (fn i => app (fn e =>
71 :     if edge_p e then f e else ())
72 :     (#out_edges G i)) set
73 :     in
74 :     G.GRAPH
75 :     { name = #name G,
76 :     graph_info = #graph_info G,
77 :     new_id = #new_id G,
78 :     add_node = add_node,
79 :     add_edge = add_edge,
80 :     remove_node = remove_node,
81 :     set_in_edges = set_in_edges,
82 :     set_out_edges = set_out_edges,
83 :     set_entries = fn _ => raise G.Readonly,
84 :     set_exits = fn _ => raise G.Readonly,
85 :     garbage_collect = #garbage_collect G,
86 :     nodes = get_nodes,
87 :     edges = get_edges,
88 :     order = order,
89 :     size = size,
90 :     capacity = #capacity G,
91 :     out_edges = out_edges,
92 :     in_edges = in_edges,
93 :     succ = get_succ,
94 :     pred = get_pred,
95 :     has_edge = has_edge,
96 :     has_node = has_node,
97 :     node_info = node_info,
98 :     entries = entries,
99 :     exits = exits,
100 :     entry_edges = entry_edges,
101 :     exit_edges = exit_edges,
102 :     forall_nodes = forall_nodes,
103 :     forall_edges = forall_edges
104 :     (*
105 :     fold_nodes = fold_nodes,
106 :     fold_edges = fold_edges
107 :     *)
108 :     }
109 :     end
110 :    
111 :    
112 :     end
113 :    
114 :     (*
115 :     * $Log$
116 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0