Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/MLRISC/graphs/isograph.sml
ViewVC logotype

View of /sml/trunk/src/MLRISC/graphs/isograph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 412 - (download) (annotate)
Fri Sep 3 00:25:03 1999 UTC (20 years, 1 month ago) by monnier
File size: 2272 byte(s)
This commit was generated by cvs2svn to compensate for changes in r411,
which included commits to RCS files with non-trunk default branches.
(*
 * Graph isomorphism view.  This works like the map function on lists.
 *
 * -- Allen
 *)

signature ISOMORPHIC_GRAPH_VIEW =
sig
   
    val map : ('n Graph.node -> 'N) ->
              ('e Graph.edge -> 'E) ->
              ('g -> 'G) ->
              ('n,'e,'g) Graph.graph -> 
              ('N,'E,'G) Graph.graph
end

structure IsomorphicGraphView : ISOMORPHIC_GRAPH_VIEW =
struct

   structure G = Graph

   fun map P Q R (G.GRAPH G) =
   let fun rename_node f (i,n)   = f(i,P(i,n))
       fun rename_node' (i,n)    = (i,P(i,n))
       fun rename_edge f (i,j,e) = f(i,j,Q(i,j,e))
       fun rename_edge' (i,j,e)  = (i,j,Q(i,j,e))
       fun rename_edges es  = List.map rename_edge' es
       fun unimplemented _ = raise G.Unimplemented
   in
       G.GRAPH
       { name            = #name G,
         graph_info      = R(#graph_info G),
         new_id          = unimplemented,
         add_node        = unimplemented,
         add_edge        = unimplemented,
         remove_node     = unimplemented,
         set_in_edges    = unimplemented,
         set_out_edges   = unimplemented,
         set_entries     = unimplemented,
         set_exits       = unimplemented,
         garbage_collect = #garbage_collect G,
         nodes           = fn () => List.map rename_node' (#nodes G ()),
         edges           = fn () => rename_edges (#edges G ()),
         order           = #order G,
         size            = #size G,
         capacity        = #capacity G,
         out_edges       = fn i => rename_edges (#out_edges G i),
         in_edges        = fn i => rename_edges (#in_edges G i),
         succ            = #succ G,
         pred            = #pred G,
         has_edge        = #has_edge G,
         has_node        = #has_node G,
         node_info       = fn i => P(i,#node_info G i),
         entries         = #entries G,
         exits           = #exits G,
         entry_edges     = fn i => rename_edges (#entry_edges G i),
         exit_edges      = fn i => rename_edges (#exit_edges G i),
         forall_nodes    = fn f => #forall_nodes G (rename_node f),
         forall_edges    = fn f => #forall_edges G (rename_edge f)
	 (*
         fold_nodes      = fold_nodes,
         fold_edges      = fold_edges
	 *)
       }
   end
end


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