15.4.145  src/app/yacc/src/make-core-g.pkg

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

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



###              "A wise person makes his own decisions,
###               a weak one obeys public opinion."
###
###                                -- Chinese proverb


# This generic is compiletime invoked (only) from:
#     src/app/yacc/src/make-lr-table-g.pkg

generic package make_core_g (
    #
    package internal_grammar:  Internal_Grammar;                # Internal_Grammar      is from   src/app/yacc/src/internal-grammar.api
)
: (weak) Core                                                   # Core                  is from   src/app/yacc/src/core.api
{
    include package   internal_grammar;
    include package   grammar;

    package internal_grammar =   internal_grammar;
    package          grammar =            grammar;

    Item = ITEM { rule:      Rule,
                  dot:       Int,
                  rhs_after: List( Symbol )
                };

    fun eq_item ( ITEM { rule=>RULE { num=>n, ... }, dot=>d, ... },
                  ITEM { rule=>RULE { num=>m, ... }, dot=>e, ... }
                )
        =
        n == m   and
        d == e;

    fun gt_item ( ITEM { rule=>RULE { num=>n, ... }, dot=>d, ... },
                  ITEM { rule=>RULE { num=>m, ... }, dot=>e, ... }
                )
       =
       n  > m   or
      (n == m   and   d > e);

    package item_list
        =
        list_ord_set_g (
            package {
                 Element = Item;

                eq = eq_item;
                gt = gt_item;
            }
        );

    include package   item_list;

    Core = CORE  (List( Item ), Int);

    fun gt_core (CORE (a, _), CORE (b, _)) =   item_list::set_gt (a, b);
    fun eq_core (CORE (a, _), CORE (b, _)) =   item_list::set_eq (a, b);

    #  Functions for printing and debugging 

    fun print_item (symbol_to_string, nonterm_to_string, print)
        =
        {   print_int = print o (int::to_string:  Int -> String);
            pr_symbol = print o symbol_to_string;
            pr_nonterm = print o nonterm_to_string;

            fun show_rest NIL     =>   ();
                show_rest (h ! t) => { pr_symbol h;   print " ";   show_rest t; };
            end;

            # "Rhs" == "right hand side":
            #
            fun show_rhs (l, 0)     =>   { print ". ";   show_rest l; };
                show_rhs (NIL, _)   =>   ();
                show_rhs (h ! t, n) =>   {   pr_symbol h;
                                            print " ";
                                            show_rhs (t, n - 1);
                                        };
            end;

            \\ (ITEM { rule=>RULE { lhs, rhs, rulenum, num, ... },
                     dot, rhs_after, ... } )
                =
                {   pr_nonterm lhs;
                    print " : ";
                    show_rhs (rhs, dot);

                    case rhs_after
                        #
                        NIL => {   print " (reduce by rule "; 
                                   print_int rulenum;
                                   print ")";
                               };

                        _   => ();
                    esac;

                    if debug
                         print " (num ";
                         print_int num;
                         print ")";
                    fi;
                };
        };

    fun print_core   (a as (_, _, print))
        =
        {   print_item =  print_item a;
            #
            \\ (CORE (items, state))
                =
                {   print "state ";
                    print (int::to_string state);
                    print ":\n\n";

                    apply
                        (   \\ i =  { print "\t"; print_item i; print "\n";})
                        items;

                    print "\n";
                };
       };
};