# Mythryl-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi
# Compiled by:
# src/app/yacc/src/mythryl-yacc.lib### "A room without books is like
### a body without a soul."
###
### -- Marcus Tullius Cicero
api Sort_Arg {
Entry;
gt: (Entry, Entry) -> Bool;
};
api Sort {
Entry;
sort: List( Entry ) -> List( Entry );
};
api Equiv_Arg {
Entry;
gt: (Entry, Entry) -> Bool;
eq: (Entry, Entry) -> Bool;
};
api Equiv {
Entry;
# equivalences: take a list of entries and divides them into
# equivalence ilks numbered 0 to n-1.
#
# It returns a triple consisting of:
#
# * the number of equivalence ilks
# * a list which maps each original entry to an equivalence
# class. The nth entry in this list gives the equivalence
# class for the nth entry in the original entry list.
# * a list which maps equivalence classes to some representative
# element. The nth entry in this list is an element from the
# nth equivalence class
equivalences: List( Entry ) -> ((Int, List( Int ), List( Entry )) );
};
# An O (n lg n) merge sort routine # XXX BUGGO FIXME Generic sorts do not belong here. We should use the library one here, or move this one to the library.
generic package merge_sort_g (a: Sort_Arg) # Sort_Arg is from src/app/yacc/src/shrink.pkg: (weak) Sort # Sort is from src/app/yacc/src/shrink.pkg{
Entry = a::Entry;
# sort: an O (n lg n) merge sort routine. We create a list of lists
# and then merge these lists in passes until only one list is left.
fun sort NIL => NIL;
sort l
=>
{ # merge: merge two lists
fun merge (l as a ! at, r as b ! bt)
=>
if (a::gt (a, b))
b ! merge (l, bt);
else a ! merge (at, r);fi;
merge (l, NIL) => l;
merge (NIL, r) => r;
end;
# scan: merge pairs of lists on a list of lists.
# Reduces the number of lists by about 1/2
fun scan (a ! b ! rest)
=>
merge (a, b) ! scan rest;
scan l
=>
l;
end;
# loop: calls scan on a list of lists until only
# one list is left. It terminates only if the list of
# lists is nonempty. (The pattern match for sort
# ensures this.)
fun loop (a ! NIL) => a;
loop l => loop (scan l);
end;
loop (map (\\ a => [a]; end ) l);
};
end;
};
# An O (n lg n) routine for placing items in equivalence ilks
generic package equiv_g (a: Equiv_Arg) # Equiv_Arg is from src/app/yacc/src/shrink.pkg: (weak) Equiv # Equiv is from src/app/yacc/src/shrink.pkg{
include package rw_vector;
include package list;
infix my 9 sub;
# Our algorithm for finding equivalence ilk is simple. The basic
# idea is to sort the entries and place duplicates entries in the same
# equivalence class.
#
# Let the original entry list be E. We map E to a list of a pairs
# consisting of the entry and its position in E, where the positions
# are numbered 0 to n-1. Call this list of pairs EP.
#
# We then sort EP on the original entries. The second elements in the
# pairs now specify a permutation that will return us to EP.
#
# We then scan the sorted list to create a list R of representative
# entries, a list P of integers which permutes the sorted list back to
# the original list and a list SE of integers which gives the
# equivalence ilk for the nth entry in the sorted list .
#
# We then return the length of R, R, and the list that results from
# permuting SE by P.
Entry = a::Entry;
fun gt ((a, _), (b, _))
=
a::gt (a, b);
package sort
=
merge_sort_g (
Entry = (a::Entry, Int);
gt = gt;
);
fun assign_index l
=
loop (0, l)
where
fun loop (index, NIL) => NIL;
loop (index, h ! t) => (h, index) ! loop (index+1, t);
end;
end;
stipulate
fun loop ((e, _) ! t, prev, ilk, rrr, se)
=>
if (a::eq (e, prev))
loop (t, e, ilk, rrr, ilk ! se);
else loop (t, e, ilk+1, e ! rrr, (ilk + 1) ! se); fi;
loop (NIL, _, _, rrr, se)
=>
(reverse rrr, reverse se);
end;
herein
create_equivalences
=
\\ NIL => (NIL, NIL);
(e, _) ! t => loop (t, e, 0, [e],[0]); end ;
end;
fun inverse_permute _ NIL
=>
NIL;
inverse_permute permutation (l as h ! _)
=>
listofarray 0
where
result = make_rw_vector (length l, h);
fun loop (element ! r, dest ! s)
=>
{ set (result, dest, element);
loop (r, s);
};
loop _ => ();
end;
fun listofarray i
=
if (i < rw_vector::length result)
result[ i ] ! listofarray (i+1);
else
NIL;
fi;
loop (l, permutation);
end;
end;
fun make_permutation x
=
map (\\ (_, b) => b; end ) x;
fun equivalences l
=
{ ep = assign_index l;
sorted = sort::sort ep;
p = make_permutation sorted;
my (r, se)
=
create_equivalences sorted;
(length r, inverse_permute p se, r);
};
};
generic package shrink_lr_table_g (package lr_table: Lr_Table;) # Lr_Table is from src/app/yacc/lib/base.api: (weak) Shrink_Lr_Table # Shrink_Lr_Table is from src/app/yacc/src/shrink-lr-table.api{
package lr_table = lr_table;
include package lr_table;
fun gt_action (a, b)
=
case a
SHIFT (STATE s)
=>
case b
SHIFT (STATE s') => s > s';
_ => TRUE;
esac;
REDUCE i
=>
case b
SHIFT _ => FALSE;
REDUCE i' => i > i';
_ => TRUE;
esac;
ACCEPT
=>
case b
ERROR => TRUE;
_ => FALSE;
esac;
ERROR => FALSE;
esac;
package action_entry_list
=
package {
Entry = (Pairlist (Terminal, Action), Action);
stipulate
fun eqlist (EMPTY, EMPTY) => TRUE;
eqlist (PAIR (TERM t, d, r), PAIR (TERM t', d', r')) =>
t==t' and d==d' and eqlist (r, r');
eqlist _ => FALSE;
end;
fun gtlist (PAIR _, EMPTY) => TRUE;
gtlist (PAIR (TERM t, d, r), PAIR (TERM t', d', r')) =>
t>t' or (t==t' and
(gt_action (d, d') or
(d==d' and gtlist (r, r'))));
gtlist _ => FALSE;
end;
herein
fun eq ((l, a): Entry, (l', a'): Entry)
=
a == a' and eqlist (l, l');
fun gt ((l, a): Entry, (l', a'): Entry)
=
gt_action (a, a') or (a==a' and gtlist (l, l'));
end;
};
# package goto_entry_list {
# type entry = pairlist( nonterm, state )
#
# my rec eq =
# \\ (EMPTY, EMPTY) => TRUE
# | (PAIR (t, d, r), PAIR (t', d', r')) =>
# t=t' and d=d' and eq (r, r')
# | _ => FALSE
#
# my rec gt =
# \\ (PAIR _, EMPTY) => TRUE
# | (PAIR (NT t, STATE d, r), PAIR (NT t', STATE d', r')) =>
# t>t' or (t=t' and
# (d>d' or (d=d' and gt (r, r'))))
# | _ => FALSE
# }
package equiv_action_list
=
equiv_g( action_entry_list );
fun states max
=
f 0
where
fun f i
=
if (i < max)
STATE i ! f (i+1);
else
NIL;
fi;
end;
fun length l
=
g (l, 0)
where
fun g (EMPTY, len) => len;
g (PAIR(_, _, r), len) => g (r, len+1);
end;
end;
fun size l
=
{ c = REF 0;
{ apply (\\ (row, _) = c := *c + length row) l; *c;};
};
fun shrink_action_list (table, verbose)
=
case (equiv_action_list::equivalences
(map (describe_actions table) (states (state_count table))))
result as (_, _, l)
=>
( result,
verbose ?? size l
:: 0
);
esac;
};