## traitful-graphtree-g.pkg
#
# See overview comments in
# src/lib/std/graphtree/traitful-graphtree.api# Compiled by:
# src/lib/std/standard.lib# This generic package gets expanded in:
# src/lib/std/dot/dot-graphtree.pkg# src/lib/std/dot/planar-graphtree.pkg # Traitful_Graphtree is from src/lib/std/graphtree/traitful-graphtree.apistipulate
package sm = string_map; # string_map is from src/lib/src/string-map.pkgherein
generic package traitful_graphtree_g (
#
Graph_Info; # E.g. from src/lib/std/dot/dot-graphtree-traits.pkg Edge_Info; # E.g. from src/lib/std/dot/dot-graphtree-traits.pkg Node_Info; # E.g. from src/lib/std/dot/dot-graphtree-traits.pkg ): (weak) Traitful_Graphtree
{
fun opt_info_fn (THE info, make_default_info) => info;
opt_info_fn (NULL, make_default_info) => make_default_info ();
end;
Mapref(X)
=
Ref( sm::Map(X) );
fun drop (d, k)
=
d := sm::drop (*d, k);
fun peek (d, k)
=
sm::get(*d, k); # Returns Null_Or(X)
fun insert (d, k, v)
=
d := sm::set(*d, k, v);
fun rm_node_name (d, n)
=
d := sm::drop (*d, n);
User_Node_Info = Node_Info;
User_Edge_Info = Edge_Info;
User_Graph_Info = Graph_Info;
Node_Info
=
{ name: String,
traits: Mapref( String ), # Arbitrary runtime-specified string key-value pairs.
info: User_Node_Info # Application-specific per-node record.
};
Edge_Info
=
{ traits: Mapref( String ), # Arbitrary runtime-specified string key-value pairs.
info: User_Edge_Info # Application-specific per-edge record.
};
Graph_Info
=
{ info: User_Graph_Info, # Application-specific per-graph record.
name: String,
#
default_node_traits: Mapref( String ),
default_edge_traits: Mapref( String ),
traits: Mapref( String ) # Arbitrary runtime-specified string key-value pairs.
};
# graphtree_g is from src/lib/std/graphtree/graphtree-g.pkg package g # This is -not- part of Traitful_Graphtree api.
=
graphtree_g(
#
Edge_Info = Edge_Info;
Node_Info = Node_Info;
Graph_Info = Graph_Info;
);
include package g;
Node = Node; # Export 'Node' to external code.
Edge = Edge; # Export 'Edge' to external code.
Traitful_Graph
=
TRAITFUL_GRAPH
{ graph: g::Graph, # This particular sub/graph in the graphtree.
graphtree: Graphtree # Information global to the entire tree of sub/graphs.
}
also
Graphtree
=
GRAPHTREE
{
make_default_graph_info: Void -> User_Graph_Info, # Function to initialize per-graph application-specific info.
make_default_edge_info: Void -> User_Edge_Info, # Function to initialize per-edge application-specific info.
make_default_node_info: Void -> User_Node_Info, # Function to initialize per-node application-specific info.
#
nodes: Ref( sm::Map( Node ) ), # Map our node names to node records.
graphs: Ref( sm::Map( Traitful_Graph ) ) # Map sub/graph names to graph records.
};
# Fold graphs, edges and nodes into a single type,
# so that our trait functions get_trait/set_trait/...
# can operate on any of them:
#
Graph_Part
#
= GRAPH_PART Traitful_Graph
| EDGE_PART Edge
| NODE_PART Node
#
| PROTONODE_PART Traitful_Graph # Holds default traits for newly created nodes.
| PROTOEDGE_PART Traitful_Graph # Holds default traits for newly created edges.
;
fun node_name (node: g::Node)
=
{ info = g::node_info_of node;
#
info.name;
};
fun graph_name (TRAITFUL_GRAPH { graph, ... } ) = (g::graph_info_of graph).name;
fun node_count (TRAITFUL_GRAPH { graph, ... } ) = g::node_count graph;
fun edge_count (TRAITFUL_GRAPH { graph, ... } ) = g::edge_count graph;
fun make_graph
{ name: String,
info: Null_Or( User_Graph_Info ),
#
make_default_graph_info: Void -> User_Graph_Info,
make_default_edge_info: Void -> User_Edge_Info,
make_default_node_info: Void -> User_Node_Info
}
=
{ graphtree
=
GRAPHTREE
{
make_default_graph_info,
make_default_edge_info,
make_default_node_info,
#
nodes => REF (sm::empty),
graphs => REF (sm::empty)
};
info = { name,
info => opt_info_fn (info, make_default_graph_info),
#
traits => REF (sm::empty),
#
default_node_traits => REF (sm::empty),
default_edge_traits => REF (sm::empty)
};
graph = TRAITFUL_GRAPH
{ graph => g::make_graph info,
graphtree
};
graphtree -> GRAPHTREE { graphs, ... };
insert (graphs, name, graph);
graph;
};
fun find_subgraph (TRAITFUL_GRAPH { graphtree => GRAPHTREE { graphs, ... }, ... }, name)
=
peek (graphs, name);
fun make_subgraph (g as TRAITFUL_GRAPH { graph, graphtree }, name, opt_info)
=
case (find_subgraph (g, name))
#
NULL =>
{ info = graph_info_of graph;
graphtree -> GRAPHTREE { graphs, make_default_graph_info, ... };
info' = { name,
info => opt_info_fn (opt_info, make_default_graph_info),
#
traits => REF (*info.traits),
#
default_node_traits => REF *info.default_node_traits,
default_edge_traits => REF *info.default_edge_traits
};
subgraph = TRAITFUL_GRAPH { graphtree, graph=>g::make_subgraph (graph, info') };
insert (graphs, name, subgraph);
subgraph;
};
_ => raise exception GRAPHTREE_ERROR "traitful_graphtree::make_subgraph";
esac;
fun has_node (TRAITFUL_GRAPH { graph, ... }, node)
=
g::has_node (graph, node);
fun drop_node (g as TRAITFUL_GRAPH { graph, graphtree }, node)
=
{ g::drop_node (graph, node);
if (g::is_root graph)
#
graphtree -> GRAPHTREE { nodes, ... };
#
rm_node_name (nodes, (node_info_of node).name);
fi;
};
fun make_node (g as TRAITFUL_GRAPH { graph, graphtree }, name, opt_info)
=
{ graphtree -> GRAPHTREE { nodes, make_default_node_info, ... };
traits = *(.default_node_traits (graph_info_of graph));
info = { name,
traits => REF traits,
info => opt_info_fn (opt_info, make_default_node_info)
};
node = g::make_node (graph, info);
# printf "%g: make_node %s\n" (graphName g) name;
insert (nodes, name, node);
node;
};
fun get_or_make_node (arg as (g as TRAITFUL_GRAPH { graph, graphtree }, name, _))
=
{ graphtree -> GRAPHTREE { nodes, ... };
case (peek (nodes, name))
#
THE node
=>
{ if (not (g::has_node (graph, node)))
# printf "%s: put_node %s\n" (graph_name g) name;
put_node (graph, node);
fi;
node;
};
NULL => make_node arg;
esac;
};
fun find_node (g as TRAITFUL_GRAPH { graph, graphtree => GRAPHTREE { nodes, ... }}, name)
=
case (peek (nodes, name))
#
the_node as (THE node)
=>
if (g::is_root graph) the_node;
elif (g::has_node (graph, node)) the_node;
else NULL;
fi;
#
NULL => NULL;
esac;
fun has_edge (TRAITFUL_GRAPH { graph, ... }, edge) = g::has_edge (graph, edge);
fun drop_edge (TRAITFUL_GRAPH { graph, ... }, edge) = g::drop_edge (graph, edge);
fun make_edge { graph => g as TRAITFUL_GRAPH { graph, graphtree, ... }, info, head, tail }
=
{ traits = *(graph_info_of graph).default_edge_traits;
graphtree -> GRAPHTREE { make_default_edge_info, ... };
info = { traits => REF traits,
info => opt_info_fn (info, make_default_edge_info)
};
# printf "%s: adding edge %s -> %s\n" (graph_name g) (node_name tail) (node_name head);
g::make_edge { graph, head, tail, info };
};
fun nodes (TRAITFUL_GRAPH { graph, ... } ) = g::nodes graph;
fun nodes_fold f (TRAITFUL_GRAPH { graph, ... } ) a = g::nodes_fold f graph a;
fun nodes_apply f (TRAITFUL_GRAPH { graph, ... } ) = g::nodes_apply f graph;
fun edges (TRAITFUL_GRAPH { graph, ... } ) = g::edges graph;
fun in_edges (TRAITFUL_GRAPH { graph, ... }, node) = g::in_edges (graph, node);
fun out_edges (TRAITFUL_GRAPH { graph, ... }, node) = g::out_edges (graph, node);
fun in_edges_apply f (TRAITFUL_GRAPH { graph, ... }, n) = g::in_edges_apply f (graph, n);
fun out_edges_apply f (TRAITFUL_GRAPH { graph, ... }, n) = g::out_edges_apply f (graph, n);
stipulate
fun get d k = peek (d, k);
fun del d k = drop (d, k);
fun ins d (k, v)
=
insert (d, k, v);
fun apply d f = sm::keyed_apply f *d;
fun count d = sm::vals_count *d;
fun do_part f (GRAPH_PART (TRAITFUL_GRAPH { graph, ... } )) => f (graph_info_of graph).traits;
#
do_part f (EDGE_PART edge) => f (edge_info_of edge).traits;
do_part f (NODE_PART node) => f (node_info_of node).traits;
#
do_part f (PROTONODE_PART (TRAITFUL_GRAPH { graph, ... } )) => f (graph_info_of graph).default_node_traits;
do_part f (PROTOEDGE_PART (TRAITFUL_GRAPH { graph, ... } )) => f (graph_info_of graph).default_edge_traits;
end;
herein
get_trait = do_part get;
set_trait = do_part ins;
drop_trait = do_part del;
trait_apply = do_part apply;
count_trait = do_part count;
end;
fun node_info_of node = (g::node_info_of node).info;
fun edge_info_of edge = (g::edge_info_of edge).info;
fun graph_info_of (TRAITFUL_GRAPH { graph, ... } )
=
(g::graph_info_of graph).info;
Node_Info = User_Node_Info;
Edge_Info = User_Edge_Info;
Graph_Info = User_Graph_Info;
fun eq_graph
( TRAITFUL_GRAPH { graph => g, ... },
TRAITFUL_GRAPH { graph => g', ... }
)
=
g::eq_graph (g, g');
}; # generic package traitful_graphtree_g
end;
## COPYRIGHT (c) 1994 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.