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 /MLRISC/trunk/graphs/isograph.sml
ViewVC logotype

Annotation of /MLRISC/trunk/graphs/isograph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 412 - (view) (download)
Original Path: sml/trunk/src/MLRISC/graphs/isograph.sml

1 : monnier 245 (*
2 : monnier 411 * Graph isomorphism view. This works like the map function on lists.
3 :     *
4 :     * -- Allen
5 : monnier 245 *)
6 :    
7 :     signature ISOMORPHIC_GRAPH_VIEW =
8 :     sig
9 :    
10 :     val map : ('n Graph.node -> 'N) ->
11 :     ('e Graph.edge -> 'E) ->
12 :     ('g -> 'G) ->
13 :     ('n,'e,'g) Graph.graph ->
14 :     ('N,'E,'G) Graph.graph
15 :     end
16 :    
17 :     structure IsomorphicGraphView : ISOMORPHIC_GRAPH_VIEW =
18 :     struct
19 :    
20 :     structure G = Graph
21 :    
22 :     fun map P Q R (G.GRAPH G) =
23 :     let fun rename_node f (i,n) = f(i,P(i,n))
24 :     fun rename_node' (i,n) = (i,P(i,n))
25 :     fun rename_edge f (i,j,e) = f(i,j,Q(i,j,e))
26 :     fun rename_edge' (i,j,e) = (i,j,Q(i,j,e))
27 :     fun rename_edges es = List.map rename_edge' es
28 :     fun unimplemented _ = raise G.Unimplemented
29 :     in
30 :     G.GRAPH
31 :     { name = #name G,
32 :     graph_info = R(#graph_info G),
33 :     new_id = unimplemented,
34 :     add_node = unimplemented,
35 :     add_edge = unimplemented,
36 :     remove_node = unimplemented,
37 :     set_in_edges = unimplemented,
38 :     set_out_edges = unimplemented,
39 :     set_entries = unimplemented,
40 :     set_exits = unimplemented,
41 :     garbage_collect = #garbage_collect G,
42 :     nodes = fn () => List.map rename_node' (#nodes G ()),
43 :     edges = fn () => rename_edges (#edges G ()),
44 :     order = #order G,
45 :     size = #size G,
46 :     capacity = #capacity G,
47 :     out_edges = fn i => rename_edges (#out_edges G i),
48 :     in_edges = fn i => rename_edges (#in_edges G i),
49 :     succ = #succ G,
50 :     pred = #pred G,
51 :     has_edge = #has_edge G,
52 :     has_node = #has_node G,
53 :     node_info = fn i => P(i,#node_info G i),
54 :     entries = #entries G,
55 :     exits = #exits G,
56 :     entry_edges = fn i => rename_edges (#entry_edges G i),
57 :     exit_edges = fn i => rename_edges (#exit_edges G i),
58 :     forall_nodes = fn f => #forall_nodes G (rename_node f),
59 :     forall_edges = fn f => #forall_edges G (rename_edge f)
60 :     (*
61 :     fold_nodes = fold_nodes,
62 :     fold_edges = fold_edges
63 :     *)
64 :     }
65 :     end
66 :     end
67 :    

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