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/ugraph.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : monnier 245 (*
2 :     * Undirected graph
3 :     *)
4 :    
5 :     signature UNDIRECTED_GRAPH_VIEW =
6 :     sig
7 :    
8 :     val undirected_view : ('n,'e,'g) Graph.graph -> ('n,'e,'g) Graph.graph
9 :    
10 :     end
11 :    
12 :     structure UndirectedGraphView : UNDIRECTED_GRAPH_VIEW =
13 :     struct
14 :    
15 :     structure G = Graph
16 :     structure Sort = Sorting
17 :    
18 :     fun undirected_view (G.GRAPH G) =
19 :     let fun adjacent_edges i =
20 :     let val in_edges = map (fn (i,j,e) => (j,i,e)) (#in_edges G i)
21 :     val out_edges = #out_edges G i
22 :     in
23 :     Sort.sort_uniq (fn ((i,j,_),(i',j',_)) =>
24 :     i < i' orelse i = i' andalso j < j')
25 :     (fn ((i,j,_),(i',j',_)) => i = i' andalso j = j')
26 :     (in_edges @ out_edges)
27 :     end
28 :     fun adjacent_nodes i =
29 :     let val succ = #succ G i
30 :     val pred = #pred G i
31 :     in
32 :     Sort.sort_uniq op< op= (succ @ pred)
33 :     end
34 :    
35 :     fun has_edge (i,j) = #has_edge G (i,j) orelse #has_edge G (j,i)
36 :    
37 :     in
38 :     G.GRAPH
39 :     { name = #name G,
40 :     graph_info = #graph_info G,
41 :     new_id = #new_id G,
42 :     add_node = #add_node G,
43 :     add_edge = #add_edge G,
44 :     remove_node = #remove_node G,
45 :     set_in_edges = #set_in_edges G,
46 :     set_out_edges = #set_out_edges G,
47 :     set_entries = #set_exits G,
48 :     set_exits = #set_entries G,
49 :     garbage_collect = #garbage_collect G,
50 :     nodes = #nodes G,
51 :     edges = #edges G,
52 :     order = #order G,
53 :     size = #size G,
54 :     capacity = #capacity G,
55 :     out_edges = adjacent_edges,
56 :     in_edges = adjacent_edges,
57 :     succ = adjacent_nodes,
58 :     pred = adjacent_nodes,
59 :     has_edge = has_edge,
60 :     has_node = #has_node G,
61 :     node_info = #node_info G,
62 :     entries = #exits G,
63 :     exits = #entries G,
64 :     entry_edges = #entry_edges G,
65 :     exit_edges = #exit_edges G,
66 :     forall_nodes = #forall_nodes G,
67 :     forall_edges = #forall_edges G
68 :     (*
69 :     fold_nodes = #fold_nodes G,
70 :     fold_edges = #fold_edges G
71 :     *)
72 :     }
73 :     end
74 :     end
75 :    
76 :     (*
77 :     * $Log$
78 :     *)

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