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

Annotation of /sml/trunk/src/MLRISC/graphs/simple-graph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 410 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/graphs/simple-graph.sml

1 : monnier 409 (*
2 :     * This view combinator converts a multigraph into a simple graph.
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 :     signature SIMPLE_GRAPH =
8 :     sig
9 :     val simple_graph :
10 :     (Graph.node_id * Graph.node_id * 'e list -> 'e) ->
11 :     ('n,'e,'g) Graph.graph -> ('n,'e,'g) Graph.graph
12 :     end
13 :    
14 :     structure SimpleGraph =
15 :     struct
16 :    
17 :     structure G = Graph
18 :     structure S = Sorting
19 :     fun simple_graph merge (G.GRAPH G) =
20 :     let val sort = S.sort (fn ((i,j,_),(i',j',_)) =>
21 :     i < i' orelse i = i' andalso j < j')
22 :     fun uniq([],_,_,[],es'') = es''
23 :     | uniq([],i,j,[e],es'') = (i,j,e)::es''
24 :     | uniq([],i,j,es,es'') = (i,j,merge(i,j,es))::es''
25 :     | uniq((i,j,e)::es,_,_,[],es'') = uniq(es,i,j,[e],es'')
26 :     | uniq((i,j,e)::es,i',j',es',es'') =
27 :     if i = i andalso j = j' then
28 :     uniq(es,i',j',e::es',es'')
29 :     else (case es' of
30 :     [e'] => uniq(es,i,j,[e],(i',j',e')::es'')
31 :     | _ => uniq(es,i,j,[e],(i',j',merge(i',j',es'))::es'')
32 :     )
33 :     fun unique es = uniq(sort es,~1,~1,[],[])
34 :     fun out_edges v = unique(#out_edges G v)
35 :     fun in_edges v = unique(#in_edges G v)
36 :     fun succ v = map #2 (out_edges v)
37 :     fun pred v = map #1 (in_edges v)
38 :     fun edges() = unique(#edges G ())
39 :    
40 :     in G.GRAPH
41 :     { name = #name G,
42 :     graph_info = #graph_info G,
43 :     new_id = #new_id G,
44 :     add_node = #add_node G,
45 :     add_edge = #add_edge G,
46 :     remove_node = #remove_node G,
47 :     set_in_edges = #set_in_edges G,
48 :     set_out_edges = #set_out_edges G,
49 :     set_entries = #set_entries G,
50 :     set_exits = #set_exits G,
51 :     garbage_collect = #garbage_collect G,
52 :     nodes = #nodes G,
53 :     edges = edges,
54 :     order = #order G,
55 :     size = #size G,
56 :     capacity = #capacity G,
57 :     out_edges = out_edges,
58 :     in_edges = in_edges,
59 :     succ = succ,
60 :     pred = pred,
61 :     has_edge = #has_edge G,
62 :     has_node = #has_node G,
63 :     node_info = #node_info G,
64 :     entries = #entries G,
65 :     exits = #exits G,
66 :     entry_edges = #entry_edges G,
67 :     exit_edges = #exit_edges G,
68 :     forall_nodes = #forall_nodes G,
69 :     forall_edges = fn f => app f (edges ())
70 :     }
71 :     end
72 :     end
73 :    

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