15.4.787  src/lib/graph/seme.pkg

#
# Single-entry-multiple exit view.  Add a new exit node to graph view.
#
# All exit edges are now directed into the exit node.
# The unique node with entry edges becomes the new entry node.  
#
# -- Allen Leung

# Compiled by:
#     src/lib/graph/graphs.lib

stipulate
    package odg =  oop_digraph;                                         # oop_digraph                   is from   src/lib/graph/oop-digraph.pkg
herein

    api Single_Entry_Multiple_Exit_View {
        #
        exception NO_ENTRY; 
        exception MULTIPLE_ENTRIES  List( odg::Node_Id );

        seme:  { exit:  odg::Node( N ) }
                    -> 
                    odg::Digraph(N,E,G)                                 # Here N,E,G stand stead for the types of client-package-supplied records associated with (respectively) nodes, edges and graphs.
                    ->
                    odg::Digraph (N,E,G);
    };
end;

stipulate
    package odg =  oop_digraph;                                         # oop_digraph                   is from   src/lib/graph/oop-digraph.pkg
herein

    package   single_entry_multiple_exit
    : (weak)  Single_Entry_Multiple_Exit_View                           # Single_Entry_Multiple_Exit_View       is from   src/lib/graph/seme.pkg
    {

        exception NO_ENTRY; 
        exception MULTIPLE_ENTRIES  List( odg::Node_Id );

        fun seme { exit as (exit_i, ex) } (odg::DIGRAPH graph)
            =
            {   fun readonly _  = raise exception odg::READ_ONLY; 
                fun get_nodes () = exit ! graph.nodes ();
                fun order ()     = graph.order () + 1;
                fun capacity ()  = int::max (exit_i+1, graph.capacity ());

                fun find_entry ()
                    =  
                    case (graph.entries ())
                        #
                        [entry] =>  entry;
                        []      =>  raise exception  NO_ENTRY; 
                        nodes   =>  raise exception  MULTIPLE_ENTRIES nodes;
                    esac;

                entry =   find_entry ();

                fun exit_edges n
                    =
                    map
                        (\\ (i, j, e) =  (i, exit_i, e))
                        (graph.exit_edges n);

                fun out_edges n
                    =
                    exit_edges n @ graph.out_edges n; 

                fun in_edges n
                    =
                    if (n == exit_i)   exit_edges n;
                    else               graph.in_edges n;
                    fi;

                fun get_edges ()
                    =
                    list::cat (map (\\ (n, _) =  out_edges n)
                                                  (get_nodes ()));

                fun get_succ n =  map #2 (out_edges n);
                fun get_pred n =  map #1 (in_edges n );

                fun has_edge (i, j)
                    =
                    list::exists
                        (\\ (_, k, _) =  j == k)
                        (out_edges i);

                fun has_node n
                    =
                    n == exit_i   or   graph.has_node  n;

                fun node_info n
                    =
                    if  (n == exit_i)
                         ex;
                    else
                         graph.node_info n;
                    fi; 

                fun forall_nodes f
                    =
                    {   graph.forall_nodes f;
                        f exit;
                    };

                fun forall_edges f
                    =
                    apply f (get_edges());

                fun entries () =  [entry];
                fun exits   () =  [exit_i];

                odg::DIGRAPH
                  {
                    name                => graph.name,
                    graph_info          => graph.graph_info,
                    allot_node_id       => graph.allot_node_id,
                    add_node            => readonly,
                    add_edge            => readonly,
                    remove_node         => readonly,
                    set_in_edges        => readonly,
                    set_out_edges       => readonly,
                    set_entries         => readonly,
                    set_exits           => readonly,
                    garbage_collect     => graph.garbage_collect,
                    nodes               => get_nodes,
                    edges               => get_edges,
                    order,
                    size                => graph.size,
                    capacity,
                    out_edges,
                    in_edges,
                    next                => get_succ,
                    prior               => get_pred,
                    has_edge,
                    has_node,
                    node_info,
                    entries,
                    exits,
                    entry_edges         => graph.entry_edges,
                    exit_edges          => graph.exit_edges,
                    forall_nodes,
                    forall_edges
                  };
            };                                  # fun seme
    };
end;