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/branches/idlbasis-devel/src/MLRISC/graphs/subgraph-p.sml
ViewVC logotype

Annotation of /sml/branches/idlbasis-devel/src/MLRISC/graphs/subgraph-p.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/graphs/subgraph-p.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_P_VIEW =
8 :     sig
9 :    
10 :     (* Node and edge induced subgraph; readonly *)
11 :     val subgraph_p_view
12 :     : Graph.node_id list ->
13 :     (Graph.node_id -> bool) ->
14 :     (Graph.node_id * Graph.node_id -> bool) ->
15 :     ('n,'e,'g) Graph.graph ->
16 :     ('n,'e,'g) Graph.graph
17 :     end
18 :    
19 :     structure Subgraph_P_View : SUBGRAPH_P_VIEW =
20 :     struct
21 :    
22 :     structure G = Graph
23 :    
24 :     fun subgraph_p_view nodes node_p edge_p (G.GRAPH G) =
25 :     let
26 :     fun readonly _ = raise G.Readonly
27 :     fun filter_nodes ns = List.filter (fn (i,_) => node_p i) ns
28 :     fun filter_edges es = List.filter (fn (i,j,_) => edge_p(i,j)) es
29 :     fun get_nodes () = map (fn i => (i,#node_info G i)) nodes
30 :     fun get_edges () = List.foldr (fn (n,l) =>
31 :     List.foldr (fn (e as (i,j,_),l) =>
32 :     if edge_p(i,j) then e::l else l) l
33 :     (#out_edges G n)) [] nodes
34 :     fun order () = length nodes
35 :     fun size() = length (get_edges())
36 :     fun out_edges i = filter_edges(#out_edges G i)
37 :     fun in_edges i = filter_edges(#in_edges G i)
38 :     fun get_succ i = List.foldr (fn ((i,j,_),ns) =>
39 :     if edge_p(i,j) then j::ns else ns)
40 :     [] (#out_edges G i)
41 :     fun get_pred i = List.foldr (fn ((i,j,_),ns) =>
42 :     if edge_p(i,j) then i::ns else ns)
43 :     [] (#in_edges G i)
44 :     fun has_edge (i,j) = edge_p(i,j)
45 :     fun has_node i = node_p i
46 :     fun node_info i = #node_info G i
47 :     fun entry_edges i = if node_p i then
48 :     List.filter (fn (i,j,_) => not(edge_p(i,j)))
49 :     (#in_edges G i)
50 :     else []
51 :     fun exit_edges i = if node_p i then
52 :     List.filter (fn (i,j,_) => not(edge_p(i,j)))
53 :     (#out_edges G i)
54 :     else []
55 :     fun entries() = List.foldr (fn (i,ns) =>
56 :     if List.exists (fn (i,j,_) => not(edge_p(i,j)))
57 :     (#in_edges G i) then i::ns else ns) []
58 :     (nodes)
59 :     fun exits() = List.foldr (fn (i,ns) =>
60 :     if List.exists (fn (i,j,_) => not(edge_p(i,j)))
61 :     (#out_edges G i) then i::ns else ns) []
62 :     (nodes)
63 :     fun forall_nodes f = app (fn i => f(i,#node_info G i)) nodes
64 :     fun forall_edges f = app f (get_edges())
65 :     in
66 :     G.GRAPH
67 :     { name = #name G,
68 :     graph_info = #graph_info G,
69 :     new_id = #new_id G,
70 :     add_node = readonly,
71 :     add_edge = readonly,
72 :     remove_node = readonly,
73 :     set_in_edges = readonly,
74 :     set_out_edges = readonly,
75 :     set_entries = readonly,
76 :     set_exits = readonly,
77 :     garbage_collect = #garbage_collect G,
78 :     nodes = get_nodes,
79 :     edges = get_edges,
80 :     order = order,
81 :     size = size,
82 :     capacity = #capacity G,
83 :     out_edges = out_edges,
84 :     in_edges = in_edges,
85 :     succ = get_succ,
86 :     pred = get_pred,
87 :     has_edge = has_edge,
88 :     has_node = has_node,
89 :     node_info = node_info,
90 :     entries = entries,
91 :     exits = exits,
92 :     entry_edges = entry_edges,
93 :     exit_edges = exit_edges,
94 :     forall_nodes = forall_nodes,
95 :     forall_edges = forall_edges
96 :     }
97 :     end
98 :    
99 :    
100 :     end
101 :    

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