## verbose-g.pkg
#
# Mythryl-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
# Compiled by:
# src/app/yacc/src/mythryl-yacc.lib### ``The whole problem can be stated quite simply by asking,
### "Is there a meaning to music?" My answer would be, "Yes."
### And "Can you state in so many words what the meaning is?"
### My answer to that would be, "No."''
###
### -- Aaron Copland
generic package verbose_g (
#
package errs: Lr_Errs; # Lr_Errs is from src/app/yacc/src/lr-errors.api)
: (weak) Verbose # Verbose is from src/app/yacc/src/verbose.api{
package errs = errs; # Export to client packages.
include package errs;
include package errs::lr_table;
fun make_print_action print
=
{ print_int = print o (int::to_string: Int -> String);
\\ (SHIFT (STATE i)) =>
{ print "\tshift ";
print_int i;
print "\n";};
(REDUCE rulenum) =>
{ print "\treduce by rule ";
print_int rulenum;
print "\n";};
ACCEPT => print "\taccept\n";
ERROR => print "\terror\n"; end ;
};
fun make_print_goto (print_nonterm, print)
=
{ print_int = print o (int::to_string: Int -> String);
\\ (nonterm, STATE i) =>
{ print "\t";
print_nonterm nonterm;
print "\tgoto ";
print_int i;
print "\n";}; end ;
};
fun make_print_term_action (print_term, print)
=
{ print_action = make_print_action print;
\\ (term, action) =>
{ print "\t";
print_term term;
print_action action;}; end ;
};
fun make_print_goto (print_nonterm, print) (nonterm, STATE i)
=
{ print_int = print o (int::to_string: Int -> String);
{ print "\t";
print_nonterm nonterm;
print "\tgoto ";
print_int i;
print "\n";};
};
fun make_print_error (print_term, print_rule, print)
=
{ print_int = print o (int::to_string: Int -> String);
print_state = \\ STATE s => { print " state "; print_int s;}; end ;
\\ (RR (term, state, r1, r2)) =>
{ print "error: ";
print_state state;
print ": reduce/reduce conflict between rule ";
print_int r1;
print " and rule ";
print_int r2;
print " on ";
print_term term;
print "\n";};
(SR (term, state, r1)) =>
{ print "error: ";
print_state state;
print ": shift/reduce conflict ";
print "(shift ";
print_term term;
print ", reduce by rule ";
print_int r1;
print ")\n";};
NOT_REDUCED i =>
{ print "warning: rule <";
print_rule i;
print "> will never be reduced\n";};
START i =>
{ print "warning: start symbol appears on the rhs of ";
print "<";
print_rule i;
print ">\n";};
NS (term, i) =>
{ print "warning: non-shiftable terminal ";
print_term term;
print "appears on the rhs of ";
print "<";
print_rule i;
print ">\n";}; end ;
};
package pair_list: (weak) api {
apply: ((X, Y) -> Void) -> Pairlist( X, Y ) -> Void;
length: Pairlist( X, Y ) -> Int;
}
=
package {
apply = \\ f =
{ fun g EMPTY => ();
g (PAIR (a, b, r)) => { f (a, b); g r; };
end;
g;
};
length = \\ l =
{ fun g (EMPTY, len) => len;
g (PAIR(_, _, r), len) => g (r, len+1);
end;
g (l, 0);
};
};
fun print_verbose { term_to_string, nonterm_to_string, table, state_errors, entries: Int, print, print_rule, errs, print_cores }
=
{ print_term = print o term_to_string;
print_nonterm = print o nonterm_to_string;
print_core = print_cores print;
print_terminal_action = make_print_term_action (print_term, print);
print_action = make_print_action print;
print_goto = make_print_goto (print_nonterm, print);
print_error = make_print_error (print_term, print_rule print, print);
gotos = lr_table::describe_goto table;
actions = lr_table::describe_actions table;
states = state_count table;
goto_table_size = REF 0;
action_table_size = REF 0;
if (length errs > 0)
print_summary print errs;
print "\n";
apply print_error errs;
fi;
fun loop i
=
if (i != states)
s = STATE i;
apply print_error (state_errors s);
print "\n";
print_core s;
my (action_list, default) = actions s;
goto_list = gotos s;
pair_list::apply print_terminal_action action_list;
print "\n";
pair_list::apply print_goto goto_list;
print "\n";
print "\t.";
print_action default;
print "\n";
goto_table_size := *goto_table_size + pair_list::length goto_list;
action_table_size := *action_table_size + pair_list::length action_list + 1;
loop (i+1);
fi;
loop 0;
print ( int::to_string entries + " of "
+ int::to_string *action_table_size
+ " action table entries left after compaction\n"
);
print (int::to_string *goto_table_size + " goto table entries\n");
};
};