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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)

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

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