mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-27 15:24:00 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/extras/moose/lalr.m
Julien Fischer 4099cca890 Minor cleanups for moose. 
extras/moose/*.m:
    As above.
2022-04-18 00:00:09 +10:00

560 lines
18 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1998-2000, 2003, 2006, 2011 The University of Melbourne.
% Copyright (C) 2014, 2022 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury Distribution.
%---------------------------------------------------------------------------%
%
% file: lalr.m
% main author: conway
%
% This module builds the lalr items and lookaheads for the grammar.
%
%---------------------------------------------------------------------------%
:- module lalr.
:- interface.
:- import_module grammar.
:- import_module io.
:- import_module map.
:- import_module pair.
:- import_module set.
%---------------------------------------------------------------------------%
:- type item
---> item(prodnum, dot).
:- type items == set(item).
:- type gotos == map(items, map(symbol, items)).
:- type lr1item
---> item(prodnum, dot, terminal).
:- type lr1items == set(lr1item).
:- type prodnum == int.
:- type dot == int.
:- type reaching == map(nonterminal, set(nonterminal)).
:- type propaheads == map(items, map(item, map(items, items))).
:- type lookaheads == map(items, map(item, set(terminal))).
:- type previews == pair(lookaheads, propaheads).
:- pred reaching(rules::in, first::in, reaching::out) is det.
:- pred lr0items(rules::in, reaching::in, set(items)::out, gotos::out) is det.
:- pred lookaheads(set(items)::in, gotos::in, rules::in, first::in, index::in,
lookaheads::out, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module array.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module require.
:- import_module term.
%---------------------------------------------------------------------------%
reaching(Productions, First, Reaching) :-
prodnums(Productions, ProdNums),
init(Reaching0),
reaching(ProdNums, Productions, First, no, Reaching0, Reaching).
:- pred reaching(list(prodnum)::in, rules::in, first::in, bool::in,
reaching::in, reaching::out) is det.
reaching([], _Productions, _First, no, !Reaching).
reaching([], Productions, First, yes, !Reaching) :-
prodnums(Productions, ProdNums),
reaching(ProdNums, Productions, First, no, !Reaching).
reaching([ProdNum | ProdNums], Productions, First, !.Change, !Reaching) :-
map.lookup(Productions, ProdNum, Prod),
Prod = rule(NonTerminal, _Head, Symbols, _, _, _V, _C),
array.max(Symbols, PMax),
reaching_2(0, PMax, Symbols, First, NonTerminal, !Change, !Reaching),
reaching(ProdNums, Productions, First, !.Change, !Reaching).
:- pred reaching_2(int::in, int::in, symbols::in, first::in, nonterminal::in,
bool::in, bool::out, reaching::in, reaching::out) is det.
reaching_2(SN, Max, Symbols, First, C, !Change, !Reaching) :-
( if SN > Max then
true
else
array.lookup(Symbols, SN, Symbol),
(
Symbol = terminal(_)
;
Symbol = nonterminal(A),
reaches(C, A, !Change, !Reaching),
( if map.search(!.Reaching, A, AR) then
set.to_sorted_list(AR, ARList),
list.foldl2(reaches(C), ARList, !Change, !Reaching)
else
true
),
map.lookup(First, A, FirstA),
( if set.member(epsilon, FirstA) then
reaching_2(SN + 1, Max, Symbols, First, C, !Change, !Reaching)
else
true
)
)
).
:- pred reaches(nonterminal::in, nonterminal::in, bool::in, bool::out,
reaching::in, reaching::out) is det.
reaches(C, A, !Change, !Reaching) :-
( if map.search(!.Reaching, C, As0) then
( if set.member(A, As0) then
true
else
!:Change = yes,
As = As0 `set.union` set.make_singleton_set(A),
map.set(C, As, !Reaching)
)
else
!:Change = yes,
As = set.make_singleton_set(A),
map.set(C, As, !Reaching)
).
%---------------------------------------------------------------------------%
lr0items(Productions, Reaching, C, Gotos) :-
I0 = set.make_singleton_set(item(0, 0)),
C0 = set.make_singleton_set(I0),
Pending = set.make_singleton_set(I0),
map.init(Gotos0),
lr0items1(Pending, Productions, Reaching, Gotos0, Gotos, C0, C).
:- pred lr0items1(set(items)::in, rules::in, reaching::in,
gotos::in, gotos::out, set(items)::in, set(items)::out) is det.
lr0items1(Pending0, Productions, Reaching, !Gotos, !C) :-
( if set.remove_least(J, Pending0, Pending1) then
set.to_sorted_list(J, JList),
lr0items_1(JList, J, Productions, Reaching, !Gotos, set.init, NewSet),
set.to_sorted_list(NewSet, NewItems),
list.map(
( pred(Pair::in, J0::out) is det :-
Pair = I0 - X,
map.lookup(!.Gotos, I0, I0Gotos),
map.lookup(I0Gotos, X, J0)
), NewItems, PendingList),
set.list_to_set(PendingList, NewPending0),
NewPending = NewPending0 `set.difference` !.C,
!:C = !.C `set.union` NewPending,
Pending = Pending1 `set.union` NewPending,
lr0items1(Pending, Productions, Reaching, !Gotos, !C)
else
true
).
:- type new == set(pair(items, symbol)).
:- pred lr0items_1(list(item)::in, items::in, rules::in, reaching::in,
gotos::in, gotos::out, new::in, new::out) is det.
lr0items_1([], _I, _Productions, _Reaching, !Gotos, !New).
lr0items_1([BItem | RestItems], I, Productions, Reaching, !Gotos, !New) :-
BItem = item(BProdNum, BDot),
map.lookup(Productions, BProdNum, BProd),
BProd = rule(_NonTerminal, _Head, BSyms, _, _, _V, _C),
array.max(BSyms, BMax),
( if BDot =< BMax then
array.lookup(BSyms, BDot, X),
add_goto(I, X, item(BProdNum, BDot + 1), !Gotos, !New)
else
true
),
( if
BDot =< BMax,
lookup(BSyms, BDot, nonterminal(C))
then
( if map.search(Reaching, C, As) then
set.to_sorted_list(As, AXList)
else
AXList = []
),
addAs([C | AXList], I, Productions, !Gotos, !New)
else
true
),
lr0items_1(RestItems, I, Productions, Reaching, !Gotos, !New).
:- pred add_goto(items::in, symbol::in, item::in,
gotos::in, gotos::out, new::in, new::out) is det.
add_goto(I, X, NewItem, !Gotos, !New) :-
( if map.search(!.Gotos, I, IGotos0) then
IGotos1 = IGotos0
else
init(IGotos1)
),
( if map.search(IGotos1, X, GotoIX0) then
GotoIX1 = GotoIX0
else
GotoIX1 = set.init
),
GotoIX = GotoIX1 `set.union` set.make_singleton_set(NewItem),
map.set(X, GotoIX, IGotos1, IGotos),
map.set(I, IGotos, !Gotos),
( if GotoIX = GotoIX1 then
true
else
!:New = !.New `set.union` set.make_singleton_set(I - X)
).
:- pred addAs(list(nonterminal)::in, items::in, rules::in,
gotos::in, gotos::out, new::in, new::out) is det.
addAs([], _I, _Productions, !Gotos, !New).
addAs([A | As], I, Productions, !Gotos, !New) :-
prodnums(Productions, ProdNums),
addAs_2(ProdNums, A, I, Productions, !Gotos, !New),
addAs(As, I, Productions, !Gotos, !New).
:- pred addAs_2(list(prodnum)::in, nonterminal::in, items::in, rules::in,
gotos::in, gotos::out, new::in, new::out) is det.
addAs_2([], _A, _I, _Productions, !Gotos, !New).
addAs_2([Pn | Pns], A, I, Productions, !Gotos, !New) :-
map.lookup(Productions, Pn, Prod),
( if
Prod = rule(A, _Head, Symbols, _, _, _V, _C),
array.max(Symbols, Max),
Max >= 0
then
array.lookup(Symbols, 0, X),
add_goto(I, X, item(Pn, 1), !Gotos, !New)
else
true
),
addAs_2(Pns, A, I, Productions, !Gotos, !New).
%---------------------------------------------------------------------------%
lookaheads(C, Gotos, Rules, First, Index, !:Lookaheads, !IO) :-
map.from_assoc_list([item(0, 0) - set.make_singleton_set(($))], I0),
map.from_assoc_list([set.make_singleton_set(item(0, 0)) - I0],
!:Lookaheads),
map.init(Propaheads0),
set.to_sorted_list(C, CList),
lookaheads(CList, Gotos, Rules, First, Index,
!.Lookaheads - Propaheads0, !:Lookaheads - Propaheads),
%foldl((pred(_I::in, IPs::in, di, uo) is det -->
% foldl((pred(Item::in, ItemsMap::in, di, uo) is det -->
% write(Item), write_string(" :\n"),
% foldl((pred(ToItems::in, ToItem::in, di, uo) is det -->
% write_string("\t"),
% write(ToItems), nl,
% write_string("\t\t"),
% write(ToItem), nl
% ), ItemsMap), nl
% ), IPs), nl
%), Propaheads),
io.stderr_stream(StdErr, !IO),
io.write_string(StdErr, "\tpropagating...\n", !IO),
propagate(C, Propaheads, !Lookaheads).
:- pred lookaheads(list(items)::in, gotos::in, rules::in, first::in, index::in,
previews::in, previews::out) is det.
lookaheads([], _Gotos, _Rules, _First, _Index, !Lookaheads).
lookaheads([K | Ks], Gotos, Rules, First, Index, !Lookaheads) :-
set.to_sorted_list(K, KList),
lookaheads1(KList, K, Gotos, Rules, First, Index, !Lookaheads),
lookaheads(Ks, Gotos, Rules, First, Index, !Lookaheads).
:- pred lookaheads1(list(item)::in, items::in, gotos::in, rules::in, first::in,
index::in, previews::in, previews::out) is det.
lookaheads1([], _I, _Gotos, _Rules, _First, _Index, !Lookaheads).
lookaheads1([BItem | BItems], I, Gotos, Rules, First, Index, !Lookaheads) :-
BItem = item(Bp, Bd),
BItem0 = item(Bp, Bd, (*)),
J0 = closure(set.make_singleton_set(BItem0), Rules, First, Index),
set.to_sorted_list(J0, JList0),
% Reverse the list so that in add_spontaneous, the set insertions
% are in reverse sorted order not sorted order, thereby taking the cost
% from O(n) to O(1).
list.reverse(JList0, JList),
lookaheads2(JList, BItem, I, Gotos, Rules, !Lookaheads),
lookaheads1(BItems, I, Gotos, Rules, First, Index, !Lookaheads).
:- func closure(lr1items, rules, first, index) = lr1items.
closure(I0, Rules, First, Index) = I :-
closure(Rules, First, Index, I0, I0, I).
:- pred closure(rules::in, first::in, index::in, lr1items::in, lr1items::in,
lr1items::out) is det.
closure(Rules, First, Index, !.New, I0, I) :-
set.to_sorted_list(!.New, NewList),
closure1(NewList, Rules, First, Index, [I0], Is),
do_union(Is, I1),
!:New = I1 `set.difference` I0,
( if set.is_empty(!.New) then
I = I1
else
closure(Rules, First, Index, !.New, I1, I)
).
:- pred closure1(list(lr1item)::in, rules::in, first::in, index::in,
list(lr1items)::in, list(lr1items)::out) is det.
closure1([], _Rules, _First, _Index, !I).
closure1([AItem | AItems], Rules, First, Index, !I) :-
AItem = item(Ap, Ad, Asym),
map.lookup(Rules, Ap, rule(_, _, Asyms, _, _, _, _)),
array.max(Asyms, AMax),
( if Ad =< AMax then
array.lookup(Asyms, Ad, BSym),
( if BSym = nonterminal(Bn) then
Bf0 = first(First, Asyms, Ad + 1),
( if set.member(epsilon, Bf0) then
set.delete(epsilon, Bf0, Bf1),
set.insert(Asym, Bf1, Bf)
%Bf = Bf1 \/ { Asym }
else
Bf = Bf0
),
set.to_sorted_list(Bf, BfList0),
% Reverse the list so that we construct the new items
% in reverse sorted order so that the accumulated list
% is in sorted order. Thus we don't have to sort the list
% to turn it into a set. Reduces running time by > 10%.
list.reverse(BfList0, BfList),
map.lookup(Index, Bn, Bps),
make_items(Bps, BfList, [], NList),
set.sorted_list_to_set(NList, N),
list.append([N], !I)
else
true
)
else
true
),
closure1(AItems, Rules, First, Index, !I).
% create the union of a list of sets.
% The simple `foldl' way has O(n^2) cost, so we do a pairwise union
% until there is only one set left. This has a cost of O(n log n).
%
:- pred do_union(list(lr1items)::in, lr1items::out) is det.
do_union([], I) :-
init(I).
do_union(Is, I) :-
Is = [_ | _],
do_union(Is, [], I).
:- pred do_union(list(lr1items)::in, list(lr1items)::in, lr1items::out)
is det.
do_union([], [], _) :-
error("do_union: empty list").
do_union([], Is, I) :-
Is = [_ | _],
do_union(Is, [], I).
do_union([I], [], I).
do_union([I0], Is, I) :-
Is = [_ | _],
do_union([I0 | Is], [], I).
do_union([I0, I1 | Is0], Is1, I) :-
I2 = I0 `set.union` I1,
do_union(Is0, [I2 | Is1], I).
:- pred lookaheads2(list(lr1item)::in, item::in, items::in, gotos::in,
rules::in, previews::in, previews::out) is det.
lookaheads2([], _B, _I, _Gotos, _Rules, !Lookaheads).
lookaheads2([A | As], B, I, Gotos, Rules, !Lookaheads) :-
A = item(Ap, Ad, Alpha),
map.lookup(Rules, Ap, rule(_, _, ASyms, _, _, _, _)),
array.max(ASyms, AMax),
( if Ad =< AMax then
array.lookup(ASyms, Ad, X),
( if goto(Gotos, I, X, Gix) then
Ad1 = Ad + 1,
( if Alpha = (*) then
add_propagated(I, B, Gix, item(Ap, Ad1), !Lookaheads)
else
add_spontaneous(Gix, item(Ap, Ad1), Alpha, !Lookaheads)
)
else
true
)
else
true
),
lookaheads2(As, B, I, Gotos, Rules, !Lookaheads).
:- pred make_items(list(prodnum)::in, list(terminal)::in,
list(lr1item)::in, list(lr1item)::out) is det.
make_items([], _, !Items).
make_items([Bp | Bps], BfList, !Items) :-
make_items1(Bp, BfList, !Items),
make_items(Bps, BfList, !Items).
:- pred make_items1(prodnum::in, list(terminal)::in,
list(lr1item)::in, list(lr1item)::out) is det.
make_items1(_, [], !Items).
make_items1(Bp, [Bt | Bts], !Items) :-
list.append([item(Bp, 0, Bt)], !Items),
make_items1(Bp, Bts, !Items).
:- pred goto(gotos::in, items::in, symbol::in, items::out) is semidet.
goto(Gotos, I, X, A) :-
map.search(Gotos, I, IXs),
map.search(IXs, X, A).
:- pred add_propagated(items::in, item::in, items::in, item::in,
previews::in, previews::out) is det.
add_propagated(I, B, Ia, A, L - P0, L - P) :-
( if map.search(P0, I, X0) then
X1 = X0
else
map.init(X1)
),
( if map.search(X1, B, Y0) then
Y1 = Y0
else
map.init(Y1)
),
( if map.search(Y1, Ia, As0) then
As1 = As0
else
set.init(As1)
),
set.insert(A, As1, As),
map.set(Ia, As, Y1, Y),
map.set(B, Y, X1, X),
map.set(I, X, P0, P).
:- pred add_spontaneous(items::in, item::in, terminal::in,
previews::in, previews::out) is det.
add_spontaneous(I, B, Alpha, L0 - P, L - P) :-
( if map.search(L0, I, X0) then
X1 = X0
else
map.init(X1)
),
( if map.search(X1, B, As0) then
As1 = As0
else
set.init(As1)
),
set.insert(Alpha, As1, As),
map.set(B, As, X1, X),
map.set(I, X, L0, L).
:- pred propagate(set(items)::in, propaheads::in,
lookaheads::in, lookaheads::out) is det.
propagate(C, Props, !Lookaheads) :-
set.to_sorted_list(C, CList),
propagate(CList, Props, no, Change, !Lookaheads),
(
Change = no
;
Change = yes,
propagate(C, Props, !Lookaheads)
).
:- pred propagate(list(items)::in, propaheads::in, bool::in, bool::out,
lookaheads::in, lookaheads::out) is det.
propagate([], _Props, !Change, !Lookaheads).
propagate([I | Is], Props, !Change, !Lookaheads) :-
set.to_sorted_list(I, IList),
propagate1(IList, I, Props, !Change, !Lookaheads),
propagate(Is, Props, !Change, !Lookaheads).
:- pred propagate1(list(item)::in, items::in, propaheads::in,
bool::in, bool::out, lookaheads::in, lookaheads::out) is det.
propagate1([], _I, _Props, !Change, !Lookaheads).
propagate1([Item | Items], I, Props, !Change, !Lookaheads) :-
( if
map.search(!.Lookaheads, I, X),
map.search(X, Item, Ts),
map.search(Props, I, Y),
map.search(Y, Item, Ps)
then
map.keys(Ps, Pkeys),
propagate2(Pkeys, Ps, Ts, !Change, !Lookaheads)
else
true
),
propagate1(Items, I, Props, !Change, !Lookaheads).
:- pred propagate2(list(items)::in, map(items, items)::in, set(terminal)::in,
bool::in, bool::out, lookaheads::in, lookaheads::out) is det.
propagate2([], _Ps, _Ts, !Change, !Lookaheads).
propagate2([I | Pks], Ps, Ts, !Change, !Lookaheads) :-
map.lookup(Ps, I, Ips),
set.to_sorted_list(Ips, IPList),
propagate3(IPList, I, Ts, !Change, !Lookaheads),
propagate2(Pks, Ps, Ts, !Change, !Lookaheads).
:- pred propagate3(list(item)::in, items::in, set(terminal)::in,
bool::in, bool::out, lookaheads::in, lookaheads::out) is det.
propagate3([], _I, _Ts, !Change, !Lookaheads).
propagate3([Item | Items], I, Ts0, !Change, !Lookaheads) :-
( if map.search(!.Lookaheads, I, X0) then
X1 = X0
else
map.init(X1)
),
( if map.search(X1, Item, Ts1) then
Ts2 = Ts1
else
set.init(Ts2)
),
NewTs = Ts0 `set.difference` Ts2,
( if set.is_empty(NewTs) then
true
else
Ts = Ts2 `set.union` NewTs,
map.set(Item, Ts, X1, X),
map.set(I, X, !Lookaheads),
!:Change = yes
),
propagate3(Items, I, Ts0, !Change, !Lookaheads).
%---------------------------------------------------------------------------%
:- pred prodnums(rules::in, list(prodnum)::out) is det.
prodnums(Rules, ProdNums) :-
map.keys(Rules, ProdNums).
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink