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 411 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/graphs/subgraph.sml

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

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