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 430 - (view) (download)

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 : monnier 429 structure G = Graph
21 : monnier 245
22 :     fun subgraph_view nodes edge_pred (G.GRAPH G) =
23 : monnier 429 let val set = Intmap.new(32,G.NotFound)
24 :     val ins = Intmap.add set
25 :     val ins = fn i => ins (i,true)
26 :     val rmv = Intmap.rmv set
27 :     val find = Intmap.mapWithDefault (set,false)
28 :    
29 : monnier 245 val _ = app ins nodes
30 :     fun edge_p (e as (i,j,_)) = find i andalso find j andalso edge_pred e
31 :     fun check i = if find i then () else raise G.Subgraph
32 :     fun check_edge e = if edge_p e then () else raise G.Subgraph
33 :     fun add_node (n as (i,_)) = (ins i; #add_node G n)
34 :     fun add_edge (e as (i,j,_)) = (check i; check j; #add_edge G e)
35 :     fun remove_node i = (check i; rmv i; #remove_node G i)
36 :     fun set_out_edges (i,es) =
37 :     (check i; app check_edge es; #set_out_edges G (i,es))
38 :     fun set_in_edges (j,es) =
39 :     (check j; app check_edge es; #set_in_edges G (j,es))
40 : monnier 429 fun get_nodes () = map (fn (i,_) => (i,#node_info G i))
41 :     (Intmap.intMapToList set)
42 : monnier 245 fun get_edges () =
43 :     let fun find_edges([],l) = l
44 :     | find_edges(e::es,l) =
45 :     if edge_p e then find_edges(es,e::l) else find_edges(es,l)
46 : monnier 429 in foldr (fn ((i,_),l) => find_edges(#out_edges G i,l)) []
47 :     (Intmap.intMapToList set)
48 : monnier 245 end
49 : monnier 429 fun order () = Intmap.elems set
50 : monnier 245 fun size () =
51 :     let fun find_edges([],n) = n
52 :     | find_edges(e::es,n) =
53 :     if edge_p e then find_edges(es,n+1) else find_edges(es,n)
54 : monnier 429 in foldr (fn ((i,_),n) => find_edges(#out_edges G i,n)) 0
55 :     (Intmap.intMapToList set)
56 : monnier 245 end
57 :     fun out_edges i = (List.filter edge_p (#out_edges G i))
58 :     fun in_edges i = (List.filter edge_p (#in_edges G i))
59 :     fun get_succ i = map #2 (out_edges i)
60 :     fun get_pred i = map #1 (in_edges i)
61 :     fun has_edge (i,j) = find i andalso find j
62 :     fun has_node i = find i
63 :     fun node_info i = (check i; #node_info G i)
64 :    
65 :     fun entry_edges i = (List.filter(fn (j,_,_) => not(find j))
66 :     (#in_edges G i))
67 :     fun exit_edges i = (List.filter(fn (_,j,_) => not(find j))
68 :     (#out_edges G i))
69 : monnier 429 fun entries() = foldr (fn ((i,_),l) =>
70 : monnier 245 if List.exists (fn (j,_,_) => not(find j))
71 : monnier 429 (#in_edges G i) then i::l else l) []
72 :     (Intmap.intMapToList set)
73 :     fun exits() = foldr (fn ((i,_),l) =>
74 : monnier 245 if List.exists (fn (_,j,_) => not(find j))
75 : monnier 429 (#out_edges G i) then i::l else l) []
76 :     (Intmap.intMapToList set)
77 :     fun forall_nodes f = Intmap.app (fn (i,_) => f(i,#node_info G i)) set
78 :     fun forall_edges f = Intmap.app (fn (i,_) => app (fn e =>
79 : monnier 245 if edge_p e then f e else ())
80 :     (#out_edges G i)) set
81 :     in
82 :     G.GRAPH
83 :     { name = #name G,
84 :     graph_info = #graph_info G,
85 :     new_id = #new_id G,
86 :     add_node = add_node,
87 :     add_edge = add_edge,
88 :     remove_node = remove_node,
89 :     set_in_edges = set_in_edges,
90 :     set_out_edges = set_out_edges,
91 :     set_entries = fn _ => raise G.Readonly,
92 :     set_exits = fn _ => raise G.Readonly,
93 :     garbage_collect = #garbage_collect G,
94 :     nodes = get_nodes,
95 :     edges = get_edges,
96 :     order = order,
97 :     size = size,
98 :     capacity = #capacity G,
99 :     out_edges = out_edges,
100 :     in_edges = in_edges,
101 :     succ = get_succ,
102 :     pred = get_pred,
103 :     has_edge = has_edge,
104 :     has_node = has_node,
105 :     node_info = node_info,
106 :     entries = entries,
107 :     exits = exits,
108 :     entry_edges = entry_edges,
109 :     exit_edges = exit_edges,
110 :     forall_nodes = forall_nodes,
111 :     forall_edges = forall_edges
112 :     (*
113 :     fold_nodes = fold_nodes,
114 :     fold_edges = fold_edges
115 :     *)
116 :     }
117 :     end
118 :    
119 :    
120 :     end
121 :    

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