PreviousUpNext

15.4.147  src/app/yacc/src/make-graph-g.pkg

## make-graph-g.pkg
#
#  Mythryl-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 

# Compiled by:
#     src/app/yacc/src/mythryl-yacc.lib

###               "If you believe everything you read,
###                better not read."
###
###                            -- Japanese proverb



generic package  make_graph_g (

    package internal_grammar:  Internal_Grammar;                # Internal_Grammar      is from   src/app/yacc/src/internal-grammar.api
    package core:       Core;                                   # Core                  is from   src/app/yacc/src/core.api
    package core_utils: Core_Stuff;                             # Core_Stuff            is from   src/app/yacc/src/core-stuff.api

    sharing internal_grammar == core::internal_grammar
                             == core_utils::internal_grammar;

    sharing core_utils::core == core;
)
: (weak) Lr_Graph                                               # Lr_Graph              is from   src/app/yacc/src/lr-graph.api
{
    include rw_vector;
    include list;

    infix my 9 sub;

    package core             =   core;
    package grammar          =   internal_grammar::grammar;     # internal_grammar      is from   src/app/yacc/src/grammar.pkg
    package internal_grammar =   internal_grammar;

    include core;
    include core::grammar;
    include core_utils;
    include internal_grammar;

    package node_set
        =
        redblack_ord_set_g (
            package {
                 Element = Core;

                eq = eq_core;
                gt = gt_core;
            }
        );

    include node_set;

    exception SHIFT  (Int, Symbol);

    Graph = { edges:   Rw_Vector( List { edge: Symbol, to: Core } ),
                  nodes: List( Core ), node_array:  Rw_Vector( Core ) };

    fun edges (CORE (_, i),{ edges, ... }:Graph)
        =
        edges[i];

    fun nodes ( { nodes, ... } : Graph)
        =
        nodes;

    fun shift ( { edges, nodes, ... } : Graph)
              (a as (i, symbol))
        =
        find edges[i]
        where 

            fun find NIL
                    =>
                    raise exception (SHIFT a);

                find ( { edge, to=>CORE (_, state) } ! r)
                    =>
                    if   (gt_symbol (symbol, edge) )   find r;
                    elif (eq_symbol (edge, symbol) )   state;
                    else                               raise exception (SHIFT a);
                    fi;
            end;
        end;

    fun core ( { node_array, ... } : Graph)
             ( i                       )
        =
        node_array[i];

    fun make_graph_fn (g as (GRAMMAR { start, ... } ))
        =
        {   my { shifts, produces, rules, eps_prods }
                =
                core_utils::make_funcs g;

            fun add_goto ((symbol, a), (nodes, edges, future, num))     # "I have seen the future and it's like the present, only longer." -- Dan Quisenberry
                =
                case (find (CORE (a, 0), nodes))
                  
                     NULL =>
                         {   core = CORE (a, num);
                             edge = { edge=>symbol, to=>core };

                             (   set (core, nodes),
                                 edge ! edges,
                                 core ! future,
                                 num + 1
                             );
                         };

                     THE c
                         =>
                         {   edge = { edge=>symbol, to=>c };

                             (nodes, edge ! edges, future, num);
                         };
                esac;

            fun f (nodes, node_list, edge_list, NIL, NIL, num)
                    =>
                    {   nodes = reverse node_list;

                        {    nodes,
                             edges => rw_vector::from_list (reverse edge_list),
                             node_array => rw_vector::from_list nodes
                        };
                    };

                f (nodes, node_list, edge_list, NIL, y, num)
                    =>
                    f (nodes, node_list, edge_list, reverse y, NIL, num);

                f (nodes, node_list, edge_list, h ! t, y, num)
                    =>
                    {   my (nodes, edges, future, num)
                            =
                            list::fold_backward add_goto (nodes,[], y, num) (shifts h);

                            f (nodes, h ! node_list, edges ! edge_list, t, future, num);
                    };
            end;

            {   produces,
                rules,
                eps_prods,
                graph =>  {   make_item = fn (r as (RULE { rhs, ... } ))
                                            =>
                                            ITEM { rule=>r, dot=>0, rhs_after=>rhs }; end ;

                              initial_item_list = map make_item (produces start);
                              ordered_item_list = list::fold_backward core::set [] initial_item_list;
                              initial         = CORE (ordered_item_list, 0);

                              f (empty, NIL, NIL,[initial], NIL, 1);
                          }
            };
        };                      # fun make_graph_fn

    fun pr_graph (a as (nonterm_to_string, term_to_string, print))
                (g                                          )
         =
         {   print_core    =   print_core a;
             print_symbol =   print o nonterm_to_string;
             nodes        =   nodes g;

             fun print_edges n
                 =
                 list::apply
                     (   fn  { edge, to=>CORE (_, state) }
                             =>
                             {   print "\tshift on ";
                                 print_symbol edge;
                                 print " to ";
                                 print (int::to_string state);
                                 print "\n";
                             }; end 
                     )
                     (edges (n, g));

             list::apply
                 (fn c => { print_core c; print "\n"; print_edges c;}; end )
                 nodes;
        };
};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext