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/simple-graph.sml
 [smlnj] / sml / trunk / src / MLRISC / graphs / simple-graph.sml

# View of /sml/trunk/src/MLRISC/graphs/simple-graph.sml

Wed Sep 8 09:47:00 1999 UTC (20 years, 11 months ago) by monnier
File size: 2519 byte(s)
```This commit was generated by cvs2svn to compensate for changes in r429,
which included commits to RCS files with non-trunk default branches.
```
```(*
* This view combinator converts a multigraph into a simple graph.
*
* -- Allen
*)

signature SIMPLE_GRAPH =
sig
val simple_graph :
(Graph.node_id * Graph.node_id * 'e list -> 'e) ->
('n,'e,'g) Graph.graph -> ('n,'e,'g) Graph.graph
end

structure SimpleGraph =
struct

structure G = Graph
structure S = ListMergeSort
fun simple_graph merge (G.GRAPH G) =
let val sort = S.sort (fn ((i,j,_),(i',j',_)) =>
i > i' orelse i = i' andalso j > j')
fun uniq([],_,_,[],es'') = es''
| uniq([],i,j,[e],es'') = (i,j,e)::es''
| uniq([],i,j,es,es'') = (i,j,merge(i,j,es))::es''
| uniq((i,j,e)::es,_,_,[],es'') = uniq(es,i,j,[e],es'')
| uniq((i,j,e)::es,i',j',es',es'') =
if i = i andalso j = j' then
uniq(es,i',j',e::es',es'')
else (case es' of
[e'] => uniq(es,i,j,[e],(i',j',e')::es'')
| _  => uniq(es,i,j,[e],(i',j',merge(i',j',es'))::es'')
)
fun unique es = uniq(sort es,~1,~1,[],[])
fun out_edges v = unique(#out_edges G v)
fun in_edges v  = unique(#in_edges G v)
fun succ v      = map #2 (out_edges v)
fun pred v      = map #1 (in_edges v)
fun edges()     = unique(#edges G ())

in  G.GRAPH
{ name            = #name G,
graph_info      = #graph_info G,
new_id          = #new_id G,
remove_node     = #remove_node G,
set_in_edges    = #set_in_edges G,
set_out_edges   = #set_out_edges G,
set_entries     = #set_entries G,
set_exits       = #set_exits G,
garbage_collect = #garbage_collect G,
nodes           = #nodes G,
edges           = edges,
order           = #order G,
size            = #size G,
capacity        = #capacity G,
out_edges       = out_edges,
in_edges        = in_edges,
succ            = succ,
pred            = pred,
has_edge        = #has_edge G,
has_node        = #has_node G,
node_info       = #node_info G,
entries         = #entries G,
exits           = #exits G,
entry_edges     = #entry_edges G,
exit_edges      = #exit_edges G,
forall_nodes    = #forall_nodes G,
forall_edges    = fn f => app f (edges ())
}
end
end

```