Bring moose's programming style up to date.

This commit is contained in:
Zoltan Somogyi
2020-05-17 22:59:13 +10:00
parent b2439c15e2
commit 031c7194cd
9 changed files with 2228 additions and 2300 deletions

View File

@@ -25,8 +25,11 @@ install:
cp moose $(INSTALL_BINDIR)
.PHONY: depend
depend: moose.depend
depend: moose.depend
.PHONY: check
check:
true
true
tags:
mtags $(wildcard *.m)

View File

@@ -1,25 +1,27 @@
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1998-2000, 2003, 2006, 2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury Distribution.
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% file: check.m
% main author: conway, November 1998
% main author: conway, November 1998
%
% This module implements various checking predicates for checking the
% input to moose. It checks for the following things:
% - duplicate rule declarations.
% - declared rules with no productions.
% - productions with no rule declaraion.
% - nonterminals with no rule declaraion.
% - productions that are not connected to the start rule.
% - productions that have no finite derivations.
% - duplicate rule declarations.
% - declared rules with no productions.
% - productions with no rule declaraion.
% - nonterminals with no rule declaraion.
% - productions that are not connected to the start rule.
% - productions that have no finite derivations.
%
% Unfortunately, we don't do anything about these yet. We should attempt
% to correct these errors so that we can look for later errors.
%
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module check.
:- interface.
@@ -31,29 +33,29 @@
:- import_module string.
:- import_module term.
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type check.error
---> error(list(string), context).
:- type error
---> error(list(string), context).
:- pred check_rule_decls(list(rule_decl), rule_decls, list(check.error)).
:- mode check_rule_decls(in, out, out) is det.
:- pred check_rule_decls(list(rule_decl)::in,
rule_decls::out, list(check.error)::out) is det.
:- pred check_clauses(list(clause), rule_decls, clauses, list(check.error)).
:- mode check_clauses(in, in, out, out) is det.
:- pred check_clauses(list(clause)::in, rule_decls::in,
clauses::out, list(check.error)::out) is det.
:- pred check_useless(nonterminal, clauses, rule_decls, list(check.error)).
:- mode check_useless(in, in, in, out) is det.
:- pred check_useless(nonterminal::in, clauses::in, rule_decls::in,
list(check.error)::out) is det.
:- pred check_inf_derivations(clauses, rule_decls, list(check.error)).
:- mode check_inf_derivations(in, in, out) is det.
:- pred check_inf_derivations(clauses::in, rule_decls::in,
list(check.error)::out) is det.
% write an error message to stderr.
:- pred write_error(check.error, io, io).
:- mode write_error(in, di, uo) is det.
% Write an error message to stderr.
%
:- pred write_error(check.error::in, io::di, io::uo) is det.
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -62,261 +64,279 @@
:- import_module set.
:- import_module solutions.
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
check_rule_decls(DeclList, Decls, Errors) :-
map.init(Decls0),
check_rule_decls(DeclList, Decls0, Decls, Errors).
map.init(Decls0),
check_rule_decls(DeclList, Decls0, Decls, Errors).
:- pred check_rule_decls(list(rule_decl), rule_decls, rule_decls,
list(check.error)).
:- mode check_rule_decls(in, in, out, out) is det.
:- pred check_rule_decls(list(rule_decl)::in,
rule_decls::in, rule_decls::out, list(check.error)::out) is det.
check_rule_decls([], !Decls, []).
check_rule_decls([Decl | DeclList], !Decls, Errors) :-
Decl = rule(DeclId, _Args, _VarSet, DeclContext),
% Look to see if we already have a declaration for this rule.
( map.search(!.Decls, DeclId, PrevDecl) ->
PrevDecl = rule(_, _, _, PrevDeclContext),
id(DeclId, Name, Arity),
string.format("The previous declaration for %s/%d is here.",
[s(Name), i(Arity)], Msg0),
Err0 = error([Msg0], PrevDeclContext),
string.format("Duplicate declaration for %s/%d.",
[s(Name), i(Arity)], Msg1),
Err1 = error([Msg1], DeclContext),
Errors = [Err0, Err1 | Errors0],
check_rule_decls(DeclList, !Decls, Errors0)
;
map.set(DeclId, Decl, !Decls),
check_rule_decls(DeclList, !Decls, Errors)
).
Decl = rule(DeclId, _Args, _VarSet, DeclContext),
% Look to see if we already have a declaration for this rule.
( if map.search(!.Decls, DeclId, PrevDecl) then
PrevDecl = rule(_, _, _, PrevDeclContext),
id(DeclId, Name, Arity),
string.format("The previous declaration for %s/%d is here.",
[s(Name), i(Arity)], Msg0),
Err0 = error([Msg0], PrevDeclContext),
string.format("Duplicate declaration for %s/%d.",
[s(Name), i(Arity)], Msg1),
Err1 = error([Msg1], DeclContext),
Errors = [Err0, Err1 | Errors0],
check_rule_decls(DeclList, !Decls, Errors0)
else
map.set(DeclId, Decl, !Decls),
check_rule_decls(DeclList, !Decls, Errors)
).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
check_clauses(ClauseList, Decls, Clauses, Errors) :-
map.init(Clauses0),
check_clauses0(ClauseList, Decls, Clauses0, Clauses, Errors0),
map.init(Clauses0),
check_clauses0(ClauseList, Decls, Clauses0, Clauses, CheckClausesErrors),
map.keys(Decls, DeclIds),
set.sorted_list_to_set(DeclIds, DeclSet),
map.keys(Clauses, ClauseIds),
set.sorted_list_to_set(ClauseIds, ClauseSet),
NoDeclSet = ClauseSet `set.difference` DeclSet,
NoClauseSet = DeclSet `set.difference` ClauseSet,
map.keys(Decls, DeclIds),
set.sorted_list_to_set(DeclIds, DeclSet),
map.keys(Clauses, ClauseIds),
set.sorted_list_to_set(ClauseIds, ClauseSet),
NoDeclSet = ClauseSet `set.difference` DeclSet,
NoClauseSet = DeclSet `set.difference` ClauseSet,
% Productions that have no rule declaration.
set.to_sorted_list(NoDeclSet, NoDeclList),
list.map((pred(NoDeclId::in, NoDeclError::out) is det :-
map.lookup(Clauses, NoDeclId, List),
( List = [clause(_, _, _, NoDeclContext)|_] ->
id(NoDeclId, NoDeclName, NoDeclArity),
string.format("No rule declaration for %s/%d.",
[s(NoDeclName), i(NoDeclArity)], NoDeclMsg),
NoDeclError = error([NoDeclMsg], NoDeclContext)
;
error("check_clauses: no clause ids")
)
), NoDeclList, Errors1),
% Productions that have no rule declaration.
set.to_sorted_list(NoDeclSet, NoDeclList),
GenerateNoDeclError =
( pred(NoDeclId::in, NoDeclError::out) is det :-
map.lookup(Clauses, NoDeclId, NoDeclClauseList),
(
NoDeclClauseList = [clause(_, _, _, NoDeclContext) | _],
id(NoDeclId, NoDeclName, NoDeclArity),
string.format("No rule declaration for %s/%d.",
[s(NoDeclName), i(NoDeclArity)], NoDeclMsg),
NoDeclError = error([NoDeclMsg], NoDeclContext)
;
NoDeclClauseList = [],
error("check_clauses: no clause ids")
)
),
list.map(GenerateNoDeclError, NoDeclList, NoDeclErrors),
% Rules that have no productions.
set.to_sorted_list(NoClauseSet, NoClauseList),
list.map((pred(NoClauseId::in, NoClauseError::out) is det :-
map.lookup(Decls, NoClauseId, Decl),
Decl = rule(_, _, _, NoClauseContext),
id(NoClauseId, NoClauseName, NoClauseArity),
string.format("No productions for %s/%d.",
[s(NoClauseName), i(NoClauseArity)], NoClauseMsg),
NoClauseError = error([NoClauseMsg], NoClauseContext)
), NoClauseList, Errors2),
% Rules that have no productions.
set.to_sorted_list(NoClauseSet, NoClauseList),
list.condense([Errors0, Errors1, Errors2], Errors).
GenerateNoClauseError =
( pred(NoClauseId::in, NoClauseError::out) is det :-
map.lookup(Decls, NoClauseId, Decl),
Decl = rule(_, _, _, NoClauseContext),
id(NoClauseId, NoClauseName, NoClauseArity),
string.format("No productions for %s/%d.",
[s(NoClauseName), i(NoClauseArity)], NoClauseMsg),
NoClauseError = error([NoClauseMsg], NoClauseContext)
),
list.map(GenerateNoClauseError, NoClauseList, NoClauseErrors),
:- pred check_clauses0(list(clause), rule_decls, clauses, clauses,
list(check.error)).
:- mode check_clauses0(in, in, in, out, out) is det.
Errors = CheckClausesErrors ++ NoDeclErrors ++ NoClauseErrors.
:- pred check_clauses0(list(clause)::in, rule_decls::in,
clauses::in, clauses::out, list(check.error)::out) is det.
check_clauses0([], _Decls, !Clauses, []).
check_clauses0([Clause | ClauseList], Decls, !Clauses, Errors) :-
Clause = clause(Head, Prod, _, Context),
Id = nonterminal(Head),
( map.search(!.Clauses, Id, ClauseList0) ->
list.append(ClauseList0, [Clause], ClauseList1)
;
ClauseList1 = [Clause]
),
map.set(Id, ClauseList1, !Clauses),
Clause = clause(Head, Prod, _, Context),
Id = nonterminal(Head),
( if map.search(!.Clauses, Id, ClauseList0) then
list.append(ClauseList0, [Clause], ClauseList1)
else
ClauseList1 = [Clause]
),
map.set(Id, ClauseList1, !Clauses),
% Look for used nonterminals that are not declared.
solutions((pred(NonTermId::out) is nondet :-
% XXX performance
nonterminals(Prod, NonTermIds),
list.member(NonTermId, NonTermIds),
not contains(Decls, NonTermId)
), UnDeclaredIds),
list.map((pred(UnDeclaredId::in, UnDeclaredError::out) is det :-
id(Id, CN, CA),
id(UnDeclaredId, NN, NA),
string.format("In production for %s/%d,",
[s(CN), i(CA)], Msg0),
string.format(" the nonterminal %s/%d is undeclared.",
[s(NN), i(NA)], Msg1),
UnDeclaredError = error([Msg0, Msg1], Context)
), UnDeclaredIds, Errors0),
(
Errors0 = [],
check_clauses0(ClauseList, Decls, !Clauses, Errors)
;
% Not tail recursive, so only do it if we have to.
Errors0 = [_|_],
check_clauses0(ClauseList, Decls, !Clauses, Errors1),
list.append(Errors0, Errors1, Errors)
).
% Look for used nonterminals that are not declared.
UndeclaredNonTerminals =
( pred(NonTermId::out) is nondet :-
% XXX performance
nonterminals(Prod, NonTermIds),
list.member(NonTermId, NonTermIds),
not contains(Decls, NonTermId)
),
solutions(UndeclaredNonTerminals, UnDeclaredIds),
GenerateUndeclaredNonterminalError =
( pred(UnDeclaredId::in, UnDeclaredError::out) is det :-
id(Id, CN, CA),
id(UnDeclaredId, NN, NA),
string.format("In production for %s/%d,",
[s(CN), i(CA)], Msg0),
string.format(" the nonterminal %s/%d is undeclared.",
[s(NN), i(NA)], Msg1),
UnDeclaredError = error([Msg0, Msg1], Context)
),
list.map(GenerateUndeclaredNonterminalError, UnDeclaredIds,
UndeclaredNonTerminalErrors),
(
UndeclaredNonTerminalErrors = [],
check_clauses0(ClauseList, Decls, !Clauses, Errors)
;
% Not tail recursive, so only do it if we have to.
UndeclaredNonTerminalErrors = [_ | _],
check_clauses0(ClauseList, Decls, !Clauses, CheckErrors),
Errors = UndeclaredNonTerminalErrors ++ CheckErrors
).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
check_useless(Start, Clauses, Decls, Errors) :-
StartSet = set.make_singleton_set(Start),
useful(StartSet, Clauses, StartSet, UsefulSet),
map.keys(Clauses, AllIds),
set.sorted_list_to_set(AllIds, AllSet),
UselessSet = AllSet `set.difference` UsefulSet,
set.to_sorted_list(UselessSet, UselessList),
list.filter_map((pred(UselessId::in, Error::out) is semidet :-
% Use search rather than lookup in case
% it was an undeclared rule.
map.search(Decls, UselessId, Decl),
Decl = rule(_Id, _Args, _VarSet, Context),
UselessId = Name / Arity,
string.format("Grammar rule %s/%d is not used.",
[s(Name), i(Arity)], Msg),
Error = error([Msg], Context)
), UselessList, Errors).
StartSet = set.make_singleton_set(Start),
useful(StartSet, Clauses, StartSet, UsefulSet),
map.keys(Clauses, AllIds),
set.sorted_list_to_set(AllIds, AllSet),
UselessSet = AllSet `set.difference` UsefulSet,
set.to_sorted_list(UselessSet, UselessList),
GenerateUselessErrors =
( pred(UselessId::in, Error::out) is semidet :-
% Use search rather than lookup in case
% it was an undeclared rule.
map.search(Decls, UselessId, Decl),
Decl = rule(_Id, _Args, _VarSet, Context),
UselessId = Name / Arity,
string.format("Grammar rule %s/%d is not used.",
[s(Name), i(Arity)], Msg),
Error = error([Msg], Context)
),
list.filter_map(GenerateUselessErrors, UselessList, Errors).
% Perform a fixpoint computation to find all the nonterminals
% that are reachable from the start symbol.
:- pred useful(set(nonterminal), clauses, set(nonterminal), set(nonterminal)).
:- mode useful(in, in, in, out) is det.
% Perform a fixpoint computation to find all the nonterminals
% that are reachable from the start symbol.
%
:- pred useful(set(nonterminal)::in, clauses::in,
set(nonterminal)::in, set(nonterminal)::out) is det.
useful(New0, Clauses, !Useful) :-
( set.empty(New0) ->
true
;
solutions_set((pred(UId::out) is nondet :-
set.member(Id, New0),
map.search(Clauses, Id, ClauseList),
list.member(Clause, ClauseList),
Clause = clause(_Head, Prod, _VarSet, _Context),
nonterminal(UId, Prod)
), NewSet),
New1 = NewSet `set.difference` !.Useful,
!:Useful = New1 `set.union`!.Useful,
useful(New1, Clauses, !Useful)
).
( if set.is_empty(New0) then
true
else
solutions_set(
( pred(UId::out) is nondet :-
set.member(Id, New0),
map.search(Clauses, Id, ClauseList),
list.member(Clause, ClauseList),
Clause = clause(_Head, Prod, _VarSet, _Context),
nonterminal(UId, Prod)
), NewSet),
New1 = NewSet `set.difference` !.Useful,
!:Useful = New1 `set.union`!.Useful,
useful(New1, Clauses, !Useful)
).
:- pred nonterminal(nonterminal, prod).
:- mode nonterminal(out, in) is nondet.
:- pred nonterminal(nonterminal::out, prod::in) is nondet.
nonterminal(nonterminal(Term), nonterminal(Term)).
nonterminal(NonTerminal, (A, B)) :-
(
nonterminal(NonTerminal, A)
;
nonterminal(NonTerminal, B)
).
(
nonterminal(NonTerminal, A)
;
nonterminal(NonTerminal, B)
).
nonterminal(NonTerminal, (A ; B)) :-
(
nonterminal(NonTerminal, A)
;
nonterminal(NonTerminal, B)
).
(
nonterminal(NonTerminal, A)
;
nonterminal(NonTerminal, B)
).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
check_inf_derivations(Clauses, Decls, Errors) :-
map.keys(Clauses, AllIds),
set.sorted_list_to_set(AllIds, InfSet0),
set.init(FinSet0),
finite(InfSet0, FinSet0, Clauses, InfSet),
set.to_sorted_list(InfSet, InfList),
list.filter_map((pred(InfId::in, Error::out) is semidet :-
% Use search rather than lookup in case
% it was an undeclared rule.
map.search(Decls, InfId, Decl),
Decl = rule(_Id, _Args, _VarSet, Context),
InfId = Name / Arity,
string.format("Rule %s/%d does not have any finite derivations.",
[s(Name), i(Arity)], Msg),
Error = error([Msg], Context)
), InfList, Errors).
map.keys(Clauses, AllIds),
set.sorted_list_to_set(AllIds, InfSet0),
set.init(FinSet0),
finite(FinSet0, Clauses, InfSet0, InfSet),
set.to_sorted_list(InfSet, InfList),
GenerateInfiniteErrors =
( pred(InfId::in, Error::out) is semidet :-
% Use search rather than lookup in case
% it was an undeclared rule.
map.search(Decls, InfId, Decl),
Decl = rule(_Id, _Args, _VarSet, Context),
InfId = Name / Arity,
string.format("Rule %s/%d does not have any finite derivations.",
[s(Name), i(Arity)], Msg),
Error = error([Msg], Context)
),
list.filter_map(GenerateInfiniteErrors, InfList, Errors).
:- pred finite(set(nonterminal), set(nonterminal), clauses, set(nonterminal)).
:- mode finite(in, in, in, out) is det.
:- pred finite(set(nonterminal)::in, clauses::in,
set(nonterminal)::in, set(nonterminal)::out) is det.
finite(!.Inf, Fin0, Clauses, !:Inf) :-
solutions_set((pred(NewFinId::out) is nondet :-
set.member(NewFinId, !.Inf),
% search rather than lookup in case the nonterminal
% doesn't have any clauses. This may lead to
% spurious infinite derivations.
map.search(Clauses, NewFinId, ClauseList),
list.member(Clause, ClauseList),
Clause = clause(_Head, Prod, _VarSet, _Context),
nonterminals(Prod, NonTerms),
(
NonTerms = []
;
NonTerms = [_|_],
all [NId] (
list.member(NId, NonTerms) =>
set.member(NId, Fin0)
)
)
), NewFinSet),
NewFin = NewFinSet `set.difference` Fin0,
( set.empty(NewFin) ->
true
;
!:Inf = !.Inf `set.difference` NewFin,
Fin = Fin0 `set.union` NewFin,
finite(!.Inf, Fin, Clauses, !:Inf)
).
finite(Fin0, Clauses, !Inf) :-
solutions_set(
( pred(NewFinId::out) is nondet :-
set.member(NewFinId, !.Inf),
% search rather than lookup in case the nonterminal
% doesn't have any clauses. This may lead to
% spurious infinite derivations.
map.search(Clauses, NewFinId, ClauseList),
list.member(Clause, ClauseList),
Clause = clause(_Head, Prod, _VarSet, _Context),
nonterminals(Prod, NonTerms),
(
NonTerms = []
;
NonTerms = [_ | _],
all [NId] (
list.member(NId, NonTerms)
=>
set.member(NId, Fin0)
)
)
), NewFinSet),
NewFin = NewFinSet `set.difference` Fin0,
( if set.is_empty(NewFin) then
true
else
!:Inf = !.Inf `set.difference` NewFin,
Fin = Fin0 `set.union` NewFin,
finite(Fin, Clauses, !Inf)
).
:- pred nonterminals(prod, list(nonterminal)).
:- mode nonterminals(in, out) is nondet.
:- pred nonterminals(prod::in, list(nonterminal)::out) is nondet.
nonterminals([], []).
nonterminals(terminal(_), []).
nonterminals(nonterminal(Term), [nonterminal(Term)]).
nonterminals((A, B), Syms) :-
nonterminals(A, ASyms),
nonterminals(B, BSyms),
append(ASyms, BSyms, Syms).
nonterminals(A, ASyms),
nonterminals(B, BSyms),
append(ASyms, BSyms, Syms).
nonterminals((A ; _B), Syms) :-
nonterminals(A, Syms).
nonterminals(A, Syms).
nonterminals((_A ; B), Syms) :-
nonterminals(B, Syms).
nonterminals(B, Syms).
nonterminals(action(_), []).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred id(nonterminal::in, name::out, arity::out) is det.
id(Name/Arity, Name, Arity).
id(start, _, _) :-
error("id: unexpected start").
error("id: unexpected start").
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
write_error(error(MsgLines, Context), !IO) :-
Context = term.context(File, Line),
string.format("%s:%d: ", [s(File), i(Line)], ContextMsg),
io.stderr_stream(StdErr, !IO),
list.foldl((pred(Msg::in, !.IO::di, !:IO::uo) is det :-
io.write_string(StdErr, ContextMsg, !IO),
io.write_string(StdErr, Msg, !IO),
io.nl(StdErr, !IO)
), MsgLines, !IO).
Context = term.context(File, Line),
string.format("%s:%d: ", [s(File), i(Line)], ContextMsg),
io.stderr_stream(StdErr, !IO),
WriteContextAndMsg =
( pred(Msg::in, !.IO::di, !:IO::uo) is det :-
io.write_string(StdErr, ContextMsg, !IO),
io.write_string(StdErr, Msg, !IO),
io.nl(StdErr, !IO)
),
list.foldl(WriteContextAndMsg, MsgLines, !IO).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

File diff suppressed because it is too large Load Diff

View File

@@ -1,15 +1,17 @@
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1998-2000, 2003, 2006, 2011 The University of Melbourne.
% 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.
@@ -22,23 +24,23 @@
:- import_module pair.
:- import_module set.
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type item
---> item(prodnum, dot).
---> item(prodnum, dot).
:- type items == set(item).
:- type items == set(item).
:- type gotos == map(items, map(symbol, items)).
:- type gotos == map(items, map(symbol, items)).
:- type lr1item
---> item(prodnum, dot, terminal).
---> item(prodnum, dot, terminal).
:- type lr1items == set(lr1item).
:- type prodnum == int.
:- type prodnum == int.
:- type dot == int.
:- type dot == int.
:- type reaching == map(nonterminal, set(nonterminal)).
@@ -48,534 +50,510 @@
:- type previews == pair(lookaheads, propaheads).
:- pred reaching(rules, first, reaching).
:- mode reaching(in, in, out) is det.
:- pred reaching(rules::in, first::in, reaching::out) is det.
:- pred lr0items(rules, reaching, set(items), gotos).
:- mode lr0items(in, in, out, out) is det.
:- pred lr0items(rules::in, reaching::in, set(items)::out, gotos::out) is det.
:- pred lookaheads(set(items), gotos, rules, first, index, lookaheads,
io, io).
:- mode lookaheads(in, in, in, in, in, out, di, uo) 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 list.
:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module term.
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
reaching(Productions, First, Reaching) :-
prodnums(Productions, ProdNums),
init(Reaching0),
reaching(ProdNums, Productions, First, no, Reaching0, Reaching).
prodnums(Productions, ProdNums),
init(Reaching0),
reaching(ProdNums, Productions, First, no, Reaching0, Reaching).
:- pred reaching(list(prodnum), rules, first, bool, reaching, reaching).
:- mode reaching(in, in, in, in, in, out) is det.
:- 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).
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, int, symbols, first, nonterminal, bool, bool,
reaching, reaching).
:- mode reaching_2(in, in, in, in, in, in, out, in, out) is det.
:- 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) :-
( SN > Max ->
true
;
array.lookup(Symbols, SN, Symbol),
(
Symbol = terminal(_)
;
Symbol = nonterminal(A),
reaches(C, A, !Change, !Reaching),
( map.search(!.Reaching, A, AR) ->
set.to_sorted_list(AR, ARList),
list.foldl2(reaches(C), ARList, !Change,
!Reaching)
;
true
),
map.lookup(First, A, FirstA),
( set.member(epsilon, FirstA) ->
reaching_2(SN + 1, Max, Symbols, First, C,
!Change, !Reaching)
;
true
)
)
).
( 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, nonterminal, bool, bool, reaching, reaching).
:- mode reaches(in, in, in, out, in, out) is det.
:- pred reaches(nonterminal::in, nonterminal::in, bool::in, bool::out,
reaching::in, reaching::out) is det.
reaches(C, A, !Change, !Reaching) :-
( map.search(!.Reaching, C, As0) ->
( set.member(A, As0) ->
true
;
!:Change = yes,
As = As0 `set.union` set.make_singleton_set(A),
map.set(C, As, !Reaching)
)
;
!:Change = yes,
As = set.make_singleton_set(A),
map.set(C, As, !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).
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), rules, reaching, gotos, gotos,
set(items), set(items)).
:- mode lr0items1(in, in, in, in, out, in, out) is det.
:- 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) :-
( set.remove_least(J, Pending0, Pending1) ->
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)
;
true
).
( 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), items, rules, reaching, gotos, gotos, new, new).
:- mode lr0items_1(in, in, in, in, in, out, in, out) is det.
:- 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),
(
BDot =< BMax
->
array.lookup(BSyms, BDot, X),
addgoto(I, X, item(BProdNum, BDot + 1), !Gotos, !New)
;
true
),
(
BDot =< BMax,
lookup(BSyms, BDot, nonterminal(C))
->
( map.search(Reaching, C, As) ->
set.to_sorted_list(As, AXList)
;
AXList = []
),
addAs([C|AXList], I, Productions, !Gotos, !New)
;
true
),
lr0items_1(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 addgoto(items, symbol, item, gotos, gotos, new, new).
:- mode addgoto(in, in, in, in, out, in, out) is det.
:- pred add_goto(items::in, symbol::in, item::in,
gotos::in, gotos::out, new::in, new::out) is det.
addgoto(I, X, NewItem, !Gotos, !New) :-
( map.search(!.Gotos, I, IGotos0) ->
IGotos1 = IGotos0
;
init(IGotos1)
),
( map.search(IGotos1, X, GotoIX0) ->
GotoIX1 = GotoIX0
;
GotoIX1 = set.init
),
GotoIX = GotoIX1 `set.union` set.make_singleton_set(NewItem),
map.set(X, GotoIX, IGotos1, IGotos),
map.set(I, IGotos, !Gotos),
( GotoIX \= GotoIX1 ->
!:New = !.New `set.union` set.make_singleton_set(I - X)
;
true
).
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), items, rules, gotos, gotos, new, new).
:- mode addAs(in, in, in, in, out, in, out) is det.
:- 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).
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), nonterminal, items, rules, gotos, gotos,
new, new).
:- mode addAs_2(in, in, in, in, in, out, in, out) is det.
:- 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),
(
Prod = rule(A, _Head, Symbols, _, _, _V, _C),
array.max(Symbols, Max),
Max >= 0
->
array.lookup(Symbols, 0, X),
addgoto(I, X, item(Pn, 1), !Gotos, !New)
;
true
),
addAs_2(Pns, 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).
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), gotos, rules, first, index, previews, previews).
:- mode lookaheads(in, in, in, in, in, in, out) is det.
:- 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).
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), items, gotos, rules, first, index,
previews, previews).
:- mode lookaheads1(in, in, in, in, in, in, in, out) is det.
:- 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 to 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).
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).
closure(Rules, First, Index, I0, I0, I).
:- pred closure(rules, first, index, lr1items, lr1items, lr1items).
:- mode closure(in, in, in, in, in, out) is det.
:- 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,
( set.empty(!.New) ->
I = I1
;
closure(Rules, First, Index, !.New, I1, 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), rules, first, index,
list(lr1items), list(lr1items)).
:- mode closure1(in, in, in, in, in, out) is det.
:- 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),
( Ad =< AMax ->
array.lookup(Asyms, Ad, BSym),
( BSym = nonterminal(Bn) ->
Bf0 = first(First, Asyms, Ad + 1),
( set.member(epsilon, Bf0) ->
set.delete(epsilon, Bf0, Bf1),
set.insert(Asym, Bf1, Bf)
%Bf = Bf1 \/ { Asym }
;
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)
;
true
)
;
true
),
closure1(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), lr1items).
:- mode do_union(in, out) is det.
% 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).
init(I).
do_union(Is, I) :-
Is = [_|_],
do_union(Is, [], I).
Is = [_ | _],
do_union(Is, [], I).
:- pred do_union(list(lr1items), list(lr1items), lr1items).
:- mode do_union(in, in, out) is det.
do_union([], [], _) :-
error("do_union: empty list").
error("do_union: empty list").
do_union([], Is, I) :-
Is = [_|_],
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).
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), item, items, gotos, rules,
previews, previews).
:- mode lookaheads2(in, in, in, in, in, in, out) is det.
:- 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),
( Ad =< AMax ->
array.lookup(ASyms, Ad, X),
( Gix = goto(Gotos, I, X) ->
Ad1 = Ad + 1,
( Alpha = (*) ->
add_propagated(I, B, Gix, item(Ap, Ad1),
!Lookaheads)
;
add_spontaneous(Gix, item(Ap, Ad1), Alpha,
!Lookaheads)
)
;
true
)
;
true
),
lookaheads2(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), list(terminal), list(lr1item), list(lr1item)).
:- mode make_items(in, in, in, out) is det.
:- 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).
make_items1(Bp, BfList, !Items),
make_items(Bps, BfList, !Items).
:- pred make_items1(prodnum, list(terminal), list(lr1item), list(lr1item)).
:- mode make_items1(in, in, in, out) is det.
:- 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).
list.append([item(Bp, 0, Bt)], !Items),
make_items1(Bp, Bts, !Items).
:- func goto(gotos, items, symbol) = items.
:- mode (goto(in, in, in) = out) is semidet.
:- 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).
goto(Gotos, I, X, A) :-
map.search(Gotos, I, IXs),
map.search(IXs, X, A).
:- pred add_propagated(items, item, items, item, previews, previews).
:- mode add_propagated(in, in, in, in, in, out) is det.
:- 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) :-
( map.search(P0, I, X0) ->
X1 = X0
;
map.init(X1)
),
( map.search(X1, B, Y0) ->
Y1 = Y0
;
map.init(Y1)
),
( map.search(Y1, Ia, As0) ->
As1 = As0
;
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).
( 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, item, terminal, previews, previews).
:- mode add_spontaneous(in, in, in, in, out) is det.
:- pred add_spontaneous(items::in, item::in, terminal::in,
previews::in, previews::out) is det.
add_spontaneous(I, B, Alpha, L0 - P, L - P) :-
( map.search(L0, I, X0) ->
X1 = X0
;
map.init(X1)
),
( map.search(X1, B, As0) ->
As1 = As0
;
set.init(As1)
),
set.insert(Alpha, As1, As),
map.set(B, As, X1, X),
map.set(I, X, L0, L).
( 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), propaheads, lookaheads, lookaheads).
:- mode propagate(in, in, in, out) is det.
:- 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)
).
set.to_sorted_list(C, CList),
propagate(CList, Props, no, Change, !Lookaheads),
(
Change = no
;
Change = yes,
propagate(C, Props, !Lookaheads)
).
:- pred propagate(list(items), propaheads, bool, bool, lookaheads, lookaheads).
:- mode propagate(in, in, in, out, in, out) is det.
:- 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).
set.to_sorted_list(I, IList),
propagate1(IList, I, Props, !Change, !Lookaheads),
propagate(Is, Props, !Change, !Lookaheads).
:- pred propagate1(list(item), items, propaheads, bool, bool,
lookaheads, lookaheads).
:- mode propagate1(in, in, in, in, out, in, out) is det.
:- 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) :-
(
map.search(!.Lookaheads, I, X),
map.search(X, Item, Ts),
map.search(Props, I, Y),
map.search(Y, Item, Ps)
->
map.keys(Ps, Pkeys),
propagate2(Pkeys, Ps, Ts, !Change, !Lookaheads)
;
true
),
propagate1(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), map(items, items), set(terminal), bool, bool,
lookaheads, lookaheads).
:- mode propagate2(in, in, in, in, out, in, out) is det.
:- 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).
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), items, set(terminal), bool, bool,
lookaheads, lookaheads).
:- mode propagate3(in, in, in, in, out, in, out) is det.
:- 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) :-
( map.search(!.Lookaheads, I, X0) ->
X1 = X0
;
map.init(X1)
),
( map.search(X1, Item, Ts1) ->
Ts2 = Ts1
;
set.init(Ts2)
),
NewTs = Ts0 `set.difference` Ts2,
( not set.empty(NewTs) ->
Ts = Ts2 `set.union` NewTs,
map.set(Item, Ts, X1, X),
map.set(I, X, !Lookaheads),
!:Change = yes
;
true
),
propagate3(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, list(prodnum)).
:- mode prodnums(in, out) is det.
prodnums(Rules, ProdNums) :-
map.keys(Rules, ProdNums).
map.keys(Rules, ProdNums).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,8 +1,10 @@
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1998-2000, 2003 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury Distribution.
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module options.
:- interface.
@@ -12,31 +14,28 @@
:- import_module list.
:- import_module string.
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type option
---> help
; verbose
---> help
; verbose
% Debugging options
; dump_action
; dump_first
; dump_follow
; dump_goto
; dump_items
; dump_rules
% Output options
.
% Debugging options
; dump_action
; dump_first
; dump_follow
; dump_goto
; dump_items
; dump_rules.
:- type options == option_table(option).
:- type maybe_options == maybe_option_table(option).
:- pred parse_options(maybe_options, list(string), io.state, io.state).
:- mode parse_options(out, out, di, uo) is det.
:- pred parse_options(maybe_options::out, list(string)::out,
io::di, io::uo) is det.
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -45,46 +44,46 @@
:- import_module char.
:- import_module std_util.
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
parse_options(MOpts, Args, !IO) :-
io.command_line_arguments(Args0, !IO),
OptionOpts = option_ops_multi(short, long, defaults),
getopt.process_options(OptionOpts, Args0, Args, MOpts).
io.command_line_arguments(Args0, !IO),
OptionOpts = option_ops_multi(short, long, defaults),
getopt.process_options(OptionOpts, Args0, Args, MOpts).
:- pred short(char::in, option::out) is semidet.
short('h', help).
short('v', verbose).
short('a', dump_action).
short('f', dump_first).
short('F', dump_follow).
short('g', dump_goto).
short('i', dump_items).
short('r', dump_rules).
short('h', help).
short('v', verbose).
short('a', dump_action).
short('f', dump_first).
short('F', dump_follow).
short('g', dump_goto).
short('i', dump_items).
short('r', dump_rules).
:- pred long(string::in, option::out) is semidet.
long("help", help).
long("verbose", verbose).
long("dump-action", dump_action).
long("dump-first", dump_first).
long("dump-follow", dump_follow).
long("dump-goto", dump_goto).
long("dump-items", dump_items).
long("dump-rules", dump_rules).
long("help", help).
long("verbose", verbose).
long("dump-action", dump_action).
long("dump-first", dump_first).
long("dump-follow", dump_follow).
long("dump-goto", dump_goto).
long("dump-items", dump_items).
long("dump-rules", dump_rules).
:- pred defaults(option::out, option_data::out) is multi.
defaults(help, bool(no)).
defaults(verbose, bool(no)).
defaults(dump_action, bool(no)).
defaults(dump_first, bool(no)).
defaults(dump_follow, bool(no)).
defaults(dump_goto, bool(no)).
defaults(dump_items, bool(no)).
defaults(dump_rules, bool(no)).
defaults(help, bool(no)).
defaults(verbose, bool(no)).
defaults(dump_action, bool(no)).
defaults(dump_first, bool(no)).
defaults(dump_follow, bool(no)).
defaults(dump_goto, bool(no)).
defaults(dump_items, bool(no)).
defaults(dump_rules, bool(no)).
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- end_module options.
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

View File

@@ -1,8 +1,10 @@
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1998-2000, 2003-2004, 2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury Distribution.
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module tables.
:- interface.
@@ -15,222 +17,218 @@
:- import_module map.
:- import_module set.
%----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type states == map(items, int).
:- type shifts == map(nonterminal, set(terminal)).
:- type actionerrors == list(actionerr).
:- type action_errors == list(action_err).
:- type actionerr
---> warning(actionwarning)
; error(actionerror)
.
:- type action_err
---> warning(action_warning)
; error(action_error).
:- type actionwarning
---> shiftreduce(state, prodnum)
.
:- type action_warning
---> shiftreduce(state, prodnum).
:- type actionerror
---> shiftshift(state, state)
; reducereduce(prodnum, prodnum)
; misc(action, action)
.
:- type action_error
---> shiftshift(state, state)
; reducereduce(prodnum, prodnum)
; misc(action, action).
:- pred shifts(set(items), rules, first, reaching, shifts).
:- mode shifts(in, in, in, in, out) is det.
:- pred shifts(set(items)::in, rules::in, first::in, reaching::in, shifts::out)
is det.
:- pred actions(set(items), rules, lookaheads, gotos, shifts,
states, actiontable, actionerrors).
:- mode actions(in, in, in, in, in, out, out, out) is det.
:- pred actions(set(items)::in, rules::in, lookaheads::in, gotos::in,
shifts::in, states::out, action_table::out, action_errors::out) is det.
:- pred gotos(set(items), states, gotos, gototable).
:- mode gotos(in, in, in, out) is det.
:- pred gotos(set(items)::in, states::in, gotos::in, goto_table::out) is det.
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module array.
:- import_module bool.
:- import_module map.
:- import_module require.
:- import_module std_util.
:- import_module term.
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
shifts(_C, _Rules, First, Reaching, !:Shifts) :-
map.init(!:Shifts),
map.foldl((pred(N::in, Ts0::in, !.Shifts::in, !:Shifts::out) is det :-
( map.search(Reaching, N, Ns0) ->
set.to_sorted_list(Ns0, Ns1)
;
Ns1 = []
),
list.map(map.lookup(First), Ns1, Ts1),
list.foldl(set.union, Ts1, Ts0, Ts2),
Ts = Ts2 `set.difference` set.make_singleton_set(epsilon),
map.set(N, Ts, !Shifts)
), First, !Shifts).
map.init(!:Shifts),
map.foldl(
( pred(N::in, Ts0::in, !.Shifts::in, !:Shifts::out) is det :-
( if map.search(Reaching, N, Ns0) then
set.to_sorted_list(Ns0, Ns1)
else
Ns1 = []
),
list.map(map.lookup(First), Ns1, Ts1),
list.foldl(set.union, Ts1, Ts0, Ts2),
Ts = Ts2 `set.difference` set.make_singleton_set(epsilon),
map.set(N, Ts, !Shifts)
), First, !Shifts).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
actions(C, Rules, Lookaheads, Gotos, Shifts, !:States, !:Actions, Errs) :-
set.to_sorted_list(C, CList),
map.init(!:States),
number_states(CList, 0, !States),
map.init(!:Actions),
actions1(CList, Rules, Lookaheads, !.States, Gotos, Shifts, !Actions,
[], Errs).
set.to_sorted_list(C, CList),
map.init(!:States),
number_states(CList, 0, !States),
map.init(!:Actions),
actions1(CList, Rules, Lookaheads, !.States, Gotos, Shifts, !Actions,
[], Errs).
:- pred number_states(list(items), int, states, states).
:- mode number_states(in, in, in, out) is det.
:- pred number_states(list(items)::in, int::in, states::in, states::out)
is det.
number_states([], _N, !States).
number_states([I | Is], N, !States) :-
map.det_insert(I, N, !States),
number_states(Is, N + 1, !States).
map.det_insert(I, N, !States),
number_states(Is, N + 1, !States).
:- pred actions1(list(items), rules, lookaheads, states, gotos, shifts,
actiontable, actiontable, actionerrors, actionerrors).
:- mode actions1(in, in, in, in, in, in, in, out, in, out) is det.
:- pred actions1(list(items)::in, rules::in, lookaheads::in, states::in,
gotos::in, shifts::in, action_table::in, action_table::out,
action_errors::in, action_errors::out) is det.
actions1([], _Rules, _Lookaheads, _States, _Gotos, _Shifts, !Actions, !Errs).
actions1([I | Is], Rules, Lookaheads, States, Gotos, Shifts, !Actions, !Errs) :-
map.lookup(States, I, Sn),
set.to_sorted_list(I, IList),
actions2(IList, I, Sn, Rules, Lookaheads, States, Gotos, Shifts,
!Actions, !Errs),
actions1(Is, Rules, Lookaheads, States, Gotos, Shifts, !Actions, !Errs).
map.lookup(States, I, Sn),
set.to_sorted_list(I, IList),
actions2(IList, I, Sn, Rules, Lookaheads, States, Gotos, Shifts,
!Actions, !Errs),
actions1(Is, Rules, Lookaheads, States, Gotos, Shifts, !Actions, !Errs).
:- pred actions2(list(item), items, state, rules, lookaheads, states, gotos,
shifts, actiontable, actiontable, actionerrors, actionerrors).
:- mode actions2(in, in, in, in, in, in, in, in, in, out, in, out) is det.
:- pred actions2(list(item)::in, items::in, state::in, rules::in,
lookaheads::in, states::in, gotos::in, shifts::in,
action_table::in, action_table::out, action_errors::in, action_errors::out)
is det.
actions2([], _I, _Sn, _Rules, _LA, _States, _Gotos, _Shifts, !Actions, !Errs).
actions2([A | As], I, Sn, Rules, LA, States, Gotos, Shifts, !Actions, !Errs) :-
A = item(Ip, Id),
map.lookup(Rules, Ip, rule(_, _, Syms, _, _, _, _)),
array.max(Syms, Max),
( Id =< Max ->
array.lookup(Syms, Id, X),
map.lookup(Gotos, I, IGs),
(
X = terminal(T0),
Ts = set.make_singleton_set(T0)
;
X = nonterminal(N),
( map.search(Shifts, N, Ts0) ->
Ts = Ts0
;
set.init(Ts)
)
),
set.to_sorted_list(Ts, TList),
list.foldl2((pred(T::in, !.Actions::in, !:Actions::out,
!.Errs::in, !:Errs::out) is det :-
map.lookup(IGs, terminal(T), J),
map.lookup(States, J, Jn),
addaction(Sn, T, shift(Jn), !Actions, !Errs)
), TList, !Actions, !Errs)
;
% A -> alpha .
(
map.search(LA, I, ILAs),
map.search(ILAs, A, Alphas)
->
set.to_sorted_list(Alphas, AlphaList),
list.foldl2((pred(T::in,
!.Actions::in, !:Actions::out,
!.Errs::in, !:Errs::out) is det :-
( Ip = 0, T = ($) ->
addaction(Sn, T, accept, !Actions,
!Errs)
;
addaction(Sn, T, reduce(Ip), !Actions,
!Errs)
)
), AlphaList, !Actions, !Errs)
;
true
)
),
actions2(As, I, Sn, Rules, LA, States, Gotos, Shifts, !Actions, !Errs).
A = item(Ip, Id),
map.lookup(Rules, Ip, rule(_, _, Syms, _, _, _, _)),
array.max(Syms, Max),
( if Id =< Max then
array.lookup(Syms, Id, X),
map.lookup(Gotos, I, IGs),
(
X = terminal(T0),
Ts = set.make_singleton_set(T0)
;
X = nonterminal(N),
( if map.search(Shifts, N, Ts0) then
Ts = Ts0
else
set.init(Ts)
)
),
set.to_sorted_list(Ts, TList),
list.foldl2(
( pred(T::in, !.Actions::in, !:Actions::out,
!.Errs::in, !:Errs::out) is det :-
map.lookup(IGs, terminal(T), J),
map.lookup(States, J, Jn),
addaction(Sn, T, shift(Jn), !Actions, !Errs)
), TList, !Actions, !Errs)
else
% A -> alpha .
( if
map.search(LA, I, ILAs),
map.search(ILAs, A, Alphas)
then
set.to_sorted_list(Alphas, AlphaList),
list.foldl2(
( pred(T::in, !.Actions::in, !:Actions::out,
!.Errs::in, !:Errs::out) is det :-
( if Ip = 0, T = ($) then
addaction(Sn, T, accept, !Actions, !Errs)
else
addaction(Sn, T, reduce(Ip), !Actions, !Errs)
)
), AlphaList, !Actions, !Errs)
else
true
)
),
actions2(As, I, Sn, Rules, LA, States, Gotos, Shifts, !Actions, !Errs).
:- pred addaction(state, terminal, action, actiontable, actiontable,
actionerrors, actionerrors).
:- pred addaction(state, terminal, action, action_table, action_table,
action_errors, action_errors).
:- mode addaction(in, in, in, in, out, in, out) is det.
addaction(Sn, T, A0, !Actions, !Errs) :-
( map.search(!.Actions, Sn, State0) ->
State1 = State0
;
map.init(State1)
),
( map.search(State1, T, A1) ->
( A0 = A1 ->
A = A1
;
(
A0 = shift(S),
A1 = reduce(R),
A2 = A0,
Err = warning(shiftreduce(S, R))
;
A0 = reduce(R),
A1 = shift(S),
A2 = A1,
Err = warning(shiftreduce(S, R))
)
->
A = A2,
list.append([Err], !Errs)
;
A = A0,
(
A0 = shift(S0),
A1 = shift(S1)
->
Err = error(shiftshift(S0, S1))
;
A0 = reduce(R0),
A1 = reduce(R1)
->
Err = error(reducereduce(R0, R1))
;
Err = error(misc(A0, A1))
),
list.append([Err], !Errs)
)
;
A = A0
),
map.set(T, A, State1, State),
map.set(Sn, State, !Actions).
( if map.search(!.Actions, Sn, State0) then
State1 = State0
else
map.init(State1)
),
( if map.search(State1, T, A1) then
( if A0 = A1 then
A = A1
else if
(
A0 = shift(S),
A1 = reduce(R),
A2 = A0,
Err = warning(shiftreduce(S, R))
;
A0 = reduce(R),
A1 = shift(S),
A2 = A1,
Err = warning(shiftreduce(S, R))
)
then
A = A2,
list.append([Err], !Errs)
else
A = A0,
( if
A0 = shift(S0),
A1 = shift(S1)
then
Err = error(shiftshift(S0, S1))
else if
A0 = reduce(R0),
A1 = reduce(R1)
then
Err = error(reducereduce(R0, R1))
else
Err = error(misc(A0, A1))
),
list.append([Err], !Errs)
)
else
A = A0
),
map.set(T, A, State1, State),
map.set(Sn, State, !Actions).
%------------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
gotos(_C, States, Gotos, !:GotoTable) :-
map.init(!:GotoTable),
map.foldl((pred(I0::in, IGs::in, !.GotoTable::in,
!:GotoTable::out) is det :-
map.lookup(States, I0, Sf),
map.foldl((pred(Sym::in, J0::in, !.GotoTable::in,
!:GotoTable::out) is det :-
( Sym = nonterminal(N) ->
map.lookup(States, J0, St),
( map.search(!.GotoTable, Sf, X0) ->
X1 = X0
;
map.init(X1)
),
map.set(N, St, X1, X),
map.set(Sf, X, !GotoTable)
;
true
)
), IGs, !GotoTable)
), Gotos, !GotoTable).
map.init(!:GotoTable),
map.foldl(
( pred(I0::in, IGs::in, !.GotoTable::in, !:GotoTable::out) is det :-
map.lookup(States, I0, Sf),
map.foldl(
( pred(Sym::in, J0::in, !.GotoTable::in, !:GotoTable::out)
is det :-
( if Sym = nonterminal(N) then
map.lookup(States, J0, St),
( if map.search(!.GotoTable, Sf, X0) then
X1 = X0
else
map.init(X1)
),
map.set(N, St, X1, X),
map.set(Sf, X, !GotoTable)
else
true
)
), IGs, !GotoTable)
), Gotos, !GotoTable).

View File

@@ -1,6 +1,6 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module bug499.
:- interface.