From 031c7194cdea6afef6f61f1327a35214d7e30a62 Mon Sep 17 00:00:00 2001 From: Zoltan Somogyi Date: Sun, 17 May 2020 22:59:13 +1000 Subject: [PATCH] Bring moose's programming style up to date. --- extras/moose/Mmakefile | 7 +- extras/moose/check.m | 480 +++++++-------- extras/moose/grammar.m | 1038 ++++++++++++++++----------------- extras/moose/lalr.m | 814 +++++++++++++------------- extras/moose/mercury_syntax.m | 962 +++++++++++++++--------------- extras/moose/moose.m | 776 ++++++++++++------------ extras/moose/options.m | 97 ++- extras/moose/tables.m | 350 ++++++----- tests/valid_make_int/bug499.m | 4 +- 9 files changed, 2228 insertions(+), 2300 deletions(-) diff --git a/extras/moose/Mmakefile b/extras/moose/Mmakefile index bfa8c32ba..1308f9ec8 100644 --- a/extras/moose/Mmakefile +++ b/extras/moose/Mmakefile @@ -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) diff --git a/extras/moose/check.m b/extras/moose/check.m index 3ab97772f..fe3522f6a 100644 --- a/extras/moose/check.m +++ b/extras/moose/check.m @@ -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). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% diff --git a/extras/moose/grammar.m b/extras/moose/grammar.m index 4d5d22c6e..0461a80c6 100644 --- a/extras/moose/grammar.m +++ b/extras/moose/grammar.m @@ -1,16 +1,18 @@ -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sw=4 et +%---------------------------------------------------------------------------% % Copyright (C) 1998-2001, 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: grammar.m -% main author: conway, November 1998 +% main author: conway, November 1998 % % This module defines the representation(s) of grammars that moose uses % to construct parsers. % -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- module grammar. :- interface. @@ -22,94 +24,94 @@ :- import_module term. :- import_module varset. -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- type grammar - ---> grammar( - rules, - clauses, - xforms, - int, % Next nonterminal - index, % Rule index - first, - follow - ). +:- type grammar + ---> grammar( + rules, + clauses, + xforms, + int, % Next nonterminal + index, % Rule index + first, + follow + ). - % index maps from each nonterminal to the list (set) of normalized - % rules for that nonterminal. -:- type index == map(nonterminal, list(int)). + % index maps from each nonterminal to the list (set) of normalized + % rules for that nonterminal. +:- type index == map(nonterminal, list(int)). -:- type clauses == map(nonterminal, list(clause)). +:- type clauses == map(nonterminal, list(clause)). :- type (clause) - ---> clause( - term, % Head - prod, % body - varset, - context % Context of the `--->' - ). + ---> clause( + term, % Head + prod, % body + varset, + context % Context of the `--->' + ). :- type prod - ---> terminal(term) - ; nonterminal(term) - ; ( prod , prod ) - ; { prod ; prod } - ; action(term) - ; []. % epsilon + ---> terminal(term) + ; nonterminal(term) + ; ( prod , prod ) + ; { prod ; prod } + ; action(term) + ; []. % epsilon :- type name == string. :- type arity == int. :- type terminal - ---> epsilon % epsilon isn't really a terminal, but it avoids the - % need for wrappers in the FIRST(alpha) situations. - ; (name / arity) - ; ($) % the special end-of-input symbol - ; (*). % the dummy symbol used for lookahead computation. + ---> epsilon % epsilon isn't really a terminal, but it avoids the + % need for wrappers in the FIRST(alpha) situations. + ; (name / arity) + ; ($) % the special end-of-input symbol + ; (*). % the dummy symbol used for lookahead computation. :- type nonterminal - ---> start % S' - the distinguished start symbol. Will always - % correspond to prodnum == 0. - ; (name / arity). + ---> start % S' - the distinguished start symbol. Will always + % correspond to prodnum == 0. + ; (name / arity). :- type symbol - ---> terminal(terminal) - ; nonterminal(nonterminal). + ---> terminal(terminal) + ; nonterminal(nonterminal). -:- type symbols == array(symbol). +:- type symbols == array(symbol). :- type bodyterm - ---> terminal(term) - ; nonterminal(term). + ---> terminal(term) + ; nonterminal(term). :- type rule_decls == map(nonterminal, rule_decl). :- type rule_decl - ---> rule( - nonterminal, % Name/Arity - list(term), % types of the attributes - varset, % type variables of the attributes - context % context of the declaration. - ). + ---> rule( + nonterminal, % Name/Arity + list(term), % types of the attributes + varset, % type variables of the attributes + context % context of the declaration. + ). :- type rules == map(int, (rule)). :- type (rule) - ---> rule( - nonterminal, % the nonterm that this rule belongs to - term, % Head - symbols, % Body - list(bodyterm), % NTs with their arguments - list(term), % Actions - varset, - context % context from the clause. - ). + ---> rule( + nonterminal, % the nonterm that this rule belongs to + term, % Head + symbols, % Body + list(bodyterm), % NTs with their arguments + list(term), % Actions + varset, + context % context from the clause. + ). :- type xform - ---> xform( - nonterminal, - string - ). + ---> xform( + nonterminal, + string + ). :- type xforms == map(nonterminal, xform). @@ -117,42 +119,39 @@ :- type follow == map(nonterminal, set(terminal)). -:- type state == int. +:- type state == int. :- type action - ---> accept - ; shift(int) - ; reduce(int). + ---> accept + ; shift(int) + ; reduce(int). -:- type actiontable == map(state, map(terminal, action)). -%:- type actiontable == (state -> terminal -> action). +:- type action_table == map(state, map(terminal, action)). +% :- type action_table == (state -> terminal -> action). -:- type gototable == map(state, map(nonterminal, state)). -%:- type gototable == (state -> nonterminal -> state). +:- type goto_table == map(state, map(nonterminal, state)). +% :- type goto_table == (state -> nonterminal -> state). -:- pred term_to_clause(term, varset, nonterminal, clause). -:- mode term_to_clause(in, in, out, out) is semidet. +:- pred term_to_clause(term::in, varset::in, nonterminal::out, clause::out) + is semidet. -:- pred add_clause(clauses, nonterminal, clause, clauses). -:- mode add_clause(in, in, in, out) is det. +:- pred add_clause(clauses::in, nonterminal::in, clause::in, clauses::out) + is det. -:- pred construct_grammar(nonterminal, clauses, xforms, grammar). -:- mode construct_grammar(in, in, in, out) is det. +:- pred construct_grammar(nonterminal::in, clauses::in, xforms::in, + grammar::out) is det. -:- pred compute_first(rules, first). -:- mode compute_first(in, out) is det. +:- pred compute_first(rules::in, first::out) is det. -:- pred compute_follow(rules, nonterminal, terminal, first, follow). -:- mode compute_follow(in, in, in, in, out) is det. - - % Misc predicates. +:- pred compute_follow(rules::in, nonterminal::in, terminal::in, first::in, + follow::out) is det. :- func terminal(term) = terminal. :- func nonterminal(term) = nonterminal. :- func first(first, symbols, int) = set(terminal). -%------------------------------------------------------------------------------% -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- implementation. @@ -163,543 +162,522 @@ :- import_module string. :- import_module solutions. -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% term_to_clause(functor(Atom, Args, Context), VarSet, Id, Rule) :- - Atom = atom("--->"), - Args = [Head, Body], - Head = functor(atom(Name), HeadArgs, _), - list.length(HeadArgs, Arity), - Id = Name/Arity, - Rule = clause(Head, Prod, VarSet, Context), - term_to_prod(Body, Prod). + Atom = atom("--->"), + Args = [Head, Body], + Head = functor(atom(Name), HeadArgs, _), + list.length(HeadArgs, Arity), + Id = Name/Arity, + Rule = clause(Head, Prod, VarSet, Context), + term_to_prod(Body, Prod). :- pred term_to_prod(term, prod). :- mode term_to_prod(in, out) is semidet. term_to_prod(functor(Atom, Args, Ctxt), Prod) :- - ( Atom = atom(","), Args = [Arg1, Arg2] -> - term_to_prod(Arg1, Left), - term_to_prod(Arg2, Right), - Prod = (Left, Right) - ; Atom = atom(";"), Args = [Arg1, Arg2] -> - term_to_prod(Arg1, Left), - term_to_prod(Arg2, Right), - Prod = (Left; Right) - ; Atom = atom("{}"), Args = [Goal] -> - Prod = action(Goal) - ; Atom = atom("{}"), Args = [Goal | Goals] -> - list.foldl( - (pred(G::in, Left::in, (Left, action(G))::out) is det), - Goals, action(Goal), Prod) - ; Atom = atom("[]"), Args = [] -> - Prod = [] - ; Atom = atom("[|]"), Args = [Head, Tail] -> - terminals(Tail, terminal(Head), Prod) - ; - Prod = nonterminal(functor(Atom, Args, Ctxt)) - ). + ( if Atom = atom(","), Args = [Arg1, Arg2] then + term_to_prod(Arg1, Left), + term_to_prod(Arg2, Right), + Prod = (Left, Right) + else if Atom = atom(";"), Args = [Arg1, Arg2] then + term_to_prod(Arg1, Left), + term_to_prod(Arg2, Right), + Prod = (Left; Right) + else if Atom = atom("{}"), Args = [Goal] then + Prod = action(Goal) + else if Atom = atom("{}"), Args = [Goal | Goals] then + list.foldl( + (pred(G::in, Left::in, (Left, action(G))::out) is det), + Goals, action(Goal), Prod) + else if Atom = atom("[]"), Args = [] then + Prod = [] + else if Atom = atom("[|]"), Args = [Head, Tail] then + terminals(Tail, terminal(Head), Prod) + else + Prod = nonterminal(functor(Atom, Args, Ctxt)) + ). -:- pred terminals(term, prod, prod). -:- mode terminals(in, in, out) is semidet. +:- pred terminals(term::in, prod::in, prod::out) is semidet. terminals(functor(Atom, Args, _), Prod0, Prod) :- - ( Atom = atom("[]"), Args = [] -> - Prod = Prod0 - ; Atom = atom("[|]"), Args = [Head, Tail] -> - terminals(Tail, (Prod0, terminal(Head)), Prod) - ; - fail - ). + ( if Atom = atom("[]"), Args = [] then + Prod = Prod0 + else if Atom = atom("[|]"), Args = [Head, Tail] then + terminals(Tail, (Prod0, terminal(Head)), Prod) + else + fail + ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% add_clause(Clauses0, Id, Clause, Clauses) :- - ( map.search(Clauses0, Id, These0) -> - These = [Clause|These0] - ; - These = [Clause] - ), - map.set(Id, These, Clauses0, Clauses). + ( if map.search(Clauses0, Id, These0) then + These = [Clause | These0] + else + These = [Clause] + ), + map.set(Id, These, Clauses0, Clauses). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% construct_grammar(Start, AllClauses, XForms, Grammar) :- - map.to_assoc_list(AllClauses, ClauseList), - Nont0 = 1, - start_rule(Start, StartRule), - map.from_assoc_list([0 - StartRule], Rules0), - map.init(ClauseIndex0), - map.init(First0), - map.init(Follow0), - Grammar0 = grammar(Rules0, AllClauses, XForms, Nont0, ClauseIndex0, - First0, Follow0), - list.foldl(transform_clause_list, ClauseList, Grammar0, Grammar1), - compute_first0(Grammar1, Grammar2), - compute_follow0(Grammar2, Grammar3), - Grammar3 = grammar(Rules3, AllClauses3, XForms3, Nont3, ClauseIndex3, - First3, Follow3), - - % Keep the nonterminals in reverse sorted order - % for efficient processing in lalr.m - map.map_values((pred(_K::in, V0::in, V::out) is det :- - list.sort(V0, V1), - list.reverse(V1, V) - ), ClauseIndex3, ClauseIndex4), - Grammar = grammar(Rules3, AllClauses3, XForms3, Nont3, ClauseIndex4, - First3, Follow3). + map.to_assoc_list(AllClauses, ClauseList), + Nont0 = 1, + start_rule(Start, StartRule), + map.from_assoc_list([0 - StartRule], Rules0), + map.init(ClauseIndex0), + map.init(First0), + map.init(Follow0), + Grammar0 = grammar(Rules0, AllClauses, XForms, Nont0, ClauseIndex0, + First0, Follow0), + list.foldl(transform_clause_list, ClauseList, Grammar0, Grammar1), + compute_first0(Grammar1, Grammar2), + compute_follow0(Grammar2, Grammar3), + Grammar3 = grammar(Rules3, AllClauses3, XForms3, Nont3, ClauseIndex3, + First3, Follow3), + + % Keep the nonterminals in reverse sorted order + % for efficient processing in lalr.m + map.map_values( + ( pred(_K::in, V0::in, V::out) is det :- + list.sort(V0, V1), + list.reverse(V1, V) + ), ClauseIndex3, ClauseIndex4), + Grammar = grammar(Rules3, AllClauses3, XForms3, Nont3, ClauseIndex4, + First3, Follow3). -:- pred start_rule(nonterminal, rule). -:- mode start_rule(in, out) is det. +:- pred start_rule(nonterminal::in, (rule)::out) is det. start_rule(Id, Rule) :- - ( - Id = Name/Arity - ; - Id = start, - error("epsilon start rule") - ), - varset.init(VarSet0), - varset.new_vars(Arity, Vars, VarSet0, VarSet1), - list.foldl((pred(V::in, VS0::in, VS::out) is det :- - term.var_to_int(V, I), - string.format("V%d", [i(I)], N), - varset.name_var(V, N, VS0, VS) - ), Vars, VarSet1, VarSet), - term.var_list_to_term_list(Vars, Args), - Context = context("foobie", 1), - string.append(Name, "'", NewName), - NewId = start, - Head = functor(atom(NewName), Args, Context), - Body = array([nonterminal(Id)]), - Body1 = [nonterminal(functor(atom(Name), Args, Context))], - Rule = rule(NewId, Head, Body, Body1, [], VarSet, Context). + ( + Id = Name/Arity + ; + Id = start, + error("epsilon start rule") + ), + varset.init(VarSet0), + varset.new_vars(Arity, Vars, VarSet0, VarSet1), + list.foldl( + (pred(V::in, VS0::in, VS::out) is det :- + term.var_to_int(V, I), + string.format("V%d", [i(I)], N), + varset.name_var(V, N, VS0, VS) + ), Vars, VarSet1, VarSet), + term.var_list_to_term_list(Vars, Args), + Context = context("foobie", 1), + string.append(Name, "'", NewName), + NewId = start, + Head = functor(atom(NewName), Args, Context), + Body = array([nonterminal(Id)]), + Body1 = [nonterminal(functor(atom(Name), Args, Context))], + Rule = rule(NewId, Head, Body, Body1, [], VarSet, Context). -:- pred transform_clause_list(pair(nonterminal, list(clause)), - grammar, grammar). -:- mode transform_clause_list(in, in, out) is det. +:- pred transform_clause_list(pair(nonterminal, list(clause))::in, + grammar::in, grammar::out) is det. transform_clause_list(Id - Clauses, !Grammar) :- - list.foldl(transform_clause(Id), Clauses, !Grammar). + list.foldl(transform_clause(Id), Clauses, !Grammar). -:- pred transform_clause(nonterminal, clause, grammar, grammar). -:- mode transform_clause(in, in, in, out) is det. +:- pred transform_clause(nonterminal::in, clause::in, + grammar::in, grammar::out) is det. transform_clause(Id, Clause, !Grammar) :- - Clause = clause(Head, Prod, Varset, Context), - solutions(transform_prod(Prod), Bodies), - list.foldl(add_rule(Id, Head, Varset, Context), Bodies, !Grammar). + Clause = clause(Head, Prod, Varset, Context), + solutions(transform_prod(Prod), Bodies), + list.foldl(add_rule(Id, Head, Varset, Context), Bodies, !Grammar). -:- pred add_rule(nonterminal, term, varset, context, - pair(list(bodyterm), list(term)), grammar, grammar). -:- mode add_rule(in, in, in, in, in, in, out) is det. +:- pred add_rule(nonterminal::in, term::in, varset::in, context::in, + pair(list(bodyterm), list(term))::in, grammar::in, grammar::out) is det. add_rule(Id, Head, Varset, Context, BodyTerms - Actions, !Grammar) :- - !.Grammar = grammar(Rules0, C, Xfs, Nont0, ClauseIndex0, F, L), - list.map((pred(BodyTerm::in, BodyId::out) is det :- - ( - BodyTerm = terminal(Term), - ( Term = functor(atom(Name), Args, _) -> - length(Args, Arity), - BId0 = Name/Arity - ; - error("add_rule: bad body term") - ), - BodyId = terminal(BId0) - ; - BodyTerm = nonterminal(Term), - ( Term = functor(atom(Name), Args, _) -> - length(Args, Arity), - BId0 = Name/Arity - ; - error("add_rule: bad body term") - ), - BodyId = nonterminal(BId0) - ) - ), BodyTerms, BodyIds), - Rule = rule(Id, Head, array(BodyIds), BodyTerms, Actions, - Varset, Context), - add_rule(Rules0, Nont0, Rule, Rules), - Nont = Nont0 + 1, - ( map.search(ClauseIndex0, Id, Prods0) -> - Prods = [Nont0|Prods0] - ; - Prods = [Nont0] - ), - map.set(Id, Prods, ClauseIndex0, ClauseIndex), - !:Grammar = grammar(Rules, C, Xfs, Nont, ClauseIndex, F, L). + !.Grammar = grammar(Rules0, C, Xfs, Nont0, ClauseIndex0, F, L), + list.map( + ( pred(BodyTerm::in, BodyId::out) is det :- + ( + BodyTerm = terminal(Term), + ( if Term = functor(atom(Name), Args, _) then + length(Args, Arity), + BId0 = Name/Arity + else + error("add_rule: bad body term") + ), + BodyId = terminal(BId0) + ; + BodyTerm = nonterminal(Term), + ( if Term = functor(atom(Name), Args, _) then + length(Args, Arity), + BId0 = Name/Arity + else + error("add_rule: bad body term") + ), + BodyId = nonterminal(BId0) + ) + ), BodyTerms, BodyIds), + Rule = rule(Id, Head, array(BodyIds), BodyTerms, Actions, Varset, Context), + map.set(Nont0, Rule, Rules0, Rules), + Nont = Nont0 + 1, + ( if map.search(ClauseIndex0, Id, Prods0) then + Prods = [Nont0 | Prods0] + else + Prods = [Nont0] + ), + map.set(Id, Prods, ClauseIndex0, ClauseIndex), + !:Grammar = grammar(Rules, C, Xfs, Nont, ClauseIndex, F, L). -:- pred transform_prod(prod, pair(list(bodyterm), list(term))). -:- mode transform_prod(in, out) is multi. +:- pred transform_prod(prod::in, pair(list(bodyterm), list(term))::out) + is multi. transform_prod(terminal(Term), [terminal(Term)] - []). transform_prod(nonterminal(Term), [nonterminal(Term)] - []). transform_prod(action(Term), [] - [Term]). transform_prod((ProdA, ProdB), Body - Actions) :- - transform_prod(ProdA, BodyA - ActionsA), - transform_prod(ProdB, BodyB - ActionsB), - list.append(BodyA, BodyB, Body), - list.append(ActionsA, ActionsB, Actions). + transform_prod(ProdA, BodyA - ActionsA), + transform_prod(ProdB, BodyB - ActionsB), + list.append(BodyA, BodyB, Body), + list.append(ActionsA, ActionsB, Actions). transform_prod((ProdA ; ProdB), Result) :- - ( - transform_prod(ProdA, Result) - ; - transform_prod(ProdB, Result) - ). + ( + transform_prod(ProdA, Result) + ; + transform_prod(ProdB, Result) + ). transform_prod([], [] - []). terminal(Term) = Terminal :- - ( - Term = functor(atom(Name), Args, _), - length(Args, Arity) - -> - Terminal = Name / Arity - ; - error("terminal: bad term") - ). + ( if + Term = functor(atom(Name), Args, _), + length(Args, Arity) + then + Terminal = Name / Arity + else + error("terminal: bad term") + ). nonterminal(Term) = Terminal :- - ( - Term = functor(atom(Name), Args, _), - length(Args, Arity) - -> - Terminal = Name / Arity - ; - error("nonterminal: bad term") - ). + ( if + Term = functor(atom(Name), Args, _), + length(Args, Arity) + then + Terminal = Name / Arity + else + error("nonterminal: bad term") + ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% - % The computation of the first sets is directly from - % the dragon book. - -:- pred compute_first0(grammar, grammar). -:- mode compute_first0(in, out) is det. + % The computation of the first sets is directly from the dragon book. + % +:- pred compute_first0(grammar::in, grammar::out) is det. compute_first0(Grammar0, Grammar) :- - Grammar0 = grammar(Rules, Clauses, Xfs, Nont, Index, _, Follow), - compute_first(Rules, First), - Grammar = grammar(Rules, Clauses, Xfs, Nont, Index, First, Follow). + Grammar0 = grammar(Rules, Clauses, Xfs, Nont, Index, _, Follow), + compute_first(Rules, First), + Grammar = grammar(Rules, Clauses, Xfs, Nont, Index, First, Follow). :- type first_stuff - ---> stuff( - bool, % Changed? - list(nonterminal), % Nonterminals - rules, - first - ). + ---> first_stuff( + bool, % Changed? + list(nonterminal), % Nonterminals + rules, + first + ). compute_first(Rules, First) :- - collect_nonterminals(Rules, Nonterminals), - map.init(First0), - Stuff0 = stuff(no, Nonterminals, Rules, First0), - until((pred(Stuff1::in, Stuff3::out) is det :- - Stuff1 = stuff(_, N1, R1, F1), - Stuff2 = stuff(no, N1, R1, F1), - map.foldl(compute_first, Rules, Stuff2, Stuff3) - ), - (pred(StuffN::in) is semidet :- - StuffN = stuff(no, _, _, _) - ), Stuff0, Stuff), - Stuff = stuff(_, _, _, First). + collect_nonterminals(Rules, Nonterminals), + map.init(First0), + Stuff0 = first_stuff(no, Nonterminals, Rules, First0), + until( + ( pred(Stuff1::in, Stuff3::out) is det :- + Stuff1 = first_stuff(_, N1, R1, F1), + Stuff2 = first_stuff(no, N1, R1, F1), + map.foldl(compute_first, Rules, Stuff2, Stuff3) + ), + ( pred(StuffN::in) is semidet :- + StuffN = first_stuff(no, _, _, _) + ), Stuff0, Stuff), + Stuff = first_stuff(_, _, _, First). -:- pred compute_first(int, (rule), first_stuff, first_stuff). -:- mode compute_first(in, in, in, out) is det. +:- pred compute_first(int::in, (rule)::in, first_stuff::in, first_stuff::out) + is det. compute_first(_RuleNum, Rule, Stuff0, Stuff) :- - Rule = rule(Id, _Head, Elems, _Body, _Actions, _Varset, _Context), - array.max(Elems, Max), - ( Max >= 0 -> - % If there are literals in the body of the - % rule, then compute the first set that derives - % from what we currently know... - Stuff0 = stuff(_, _, _, TmpFirst), - set.init(Emp), - compute_first(0, Max, Elems, TmpFirst, Emp, ComputedFirst) - ; - % There were no literals in the body of the rule, - % so it was an epsilon rule. - ComputedFirst = set.make_singleton_set(epsilon) - ), - % Add the computed first set to what we currently - % know, noting whether or not anything has changed. - Stuff0 = stuff(Ch0, Ns, Rs, First0), - ( - search(First0, Id, ThisFirst0) - -> - difference(ComputedFirst, ThisFirst0, NewFirst), - union(ThisFirst0, NewFirst, ThisFirst), - ( empty(NewFirst) -> - Ch1 = Ch0 - ; - Ch1 = yes - ) - ; - ThisFirst = ComputedFirst, - Ch1 = yes - ), - map.set(Id, ThisFirst, First0, First1), - Stuff = stuff(Ch1, Ns, Rs, First1). + Rule = rule(Id, _Head, Elems, _Body, _Actions, _Varset, _Context), + array.max(Elems, Max), + ( if Max >= 0 then + % If there are literals in the body of the rule, then compute + % the first set that derives from what we currently know... + Stuff0 = first_stuff(_, _, _, TmpFirst), + set.init(Emp), + compute_first(0, Max, Elems, TmpFirst, Emp, ComputedFirst) + else + % There were no literals in the body of the rule, + % so it was an epsilon rule. + ComputedFirst = set.make_singleton_set(epsilon) + ), + % Add the computed first set to what we currently know, noting + % whether or not anything has changed. + Stuff0 = first_stuff(Ch0, Ns, Rs, First0), + ( if search(First0, Id, ThisFirst0) then + difference(ComputedFirst, ThisFirst0, NewFirst), + union(ThisFirst0, NewFirst, ThisFirst), + ( if set.is_empty(NewFirst) then + Ch1 = Ch0 + else + Ch1 = yes + ) + else + ThisFirst = ComputedFirst, + Ch1 = yes + ), + map.set(Id, ThisFirst, First0, First1), + Stuff = first_stuff(Ch1, Ns, Rs, First1). - - % Compute the first set directly from what we currently - % know (using rule 3 on p189 of the dragon book): - % iterate over the body until we get to - % - the end - % - an element about which we know nothing, - % - a terminal - % - a first set for a nonterminal that does not - % contain epsilon - -:- pred compute_first(int, int, symbols, first, set(terminal), set(terminal)). -:- mode compute_first(in, in, in, in, in, out) is det. + % Compute the first set directly from what we currently + % know (using rule 3 on p189 of the dragon book): + % iterate over the body until we get to + % - the end + % - an element about which we know nothing, + % - a terminal + % - a first set for a nonterminal that does not + % contain epsilon + % +:- pred compute_first(int::in, int::in, symbols::in, first::in, + set(terminal)::in, set(terminal)::out) is det. compute_first(I, IMax, Elems, First, Set0, Set) :- - ( I =< IMax -> - array.lookup(Elems, I, Elem), - ( - % If we get to a terminal, then we add it - % to the first set, and remove epsilon (if - % it was there in the first place), since - % this rule is certainly not nullable. - Elem = terminal(Id), - set.insert(Id, Set0, Set1), - set.difference(Set1, set.make_singleton_set(epsilon), - Set) - ; - Elem = nonterminal(Id), - ( map.search(First, Id, Set1) -> - % If we know some information about - % the nonterminal, then add it to - % what we already know. If it is - % not nullable, then this rule is - % not nullable, and we're done. If - % it is nullable, then we look at - % the next literal in the body. - set.union(Set0, Set1, Set2), - ( set.member(epsilon, Set1) -> - compute_first(I + 1, IMax, Elems, First, - Set2, Set) - ; - set.difference(Set2, - set.make_singleton_set(epsilon), Set) - ) - ; - % If we don't know anything about - % this nonterminal, then stop here. - Set = Set0 - ) - ) - ; - Set = Set0 - ). + ( if I =< IMax then + array.lookup(Elems, I, Elem), + ( + Elem = terminal(Id), + % If we get to a terminal, then we add it to the first set, + % and remove epsilon (if it was there in the first place), since + % this rule is certainly not nullable. + set.insert(Id, Set0, Set1), + set.difference(Set1, set.make_singleton_set(epsilon), Set) + ; + Elem = nonterminal(Id), + ( if map.search(First, Id, Set1) then + % If we know some information about the nonterminal, + % then add it to what we already know. If it is not nullable, + % then this rule is not nullable, and we are done. + % If it is nullable, then we look at the next literal + % in the body. + set.union(Set0, Set1, Set2), + ( if set.member(epsilon, Set1) then + compute_first(I + 1, IMax, Elems, First, Set2, Set) + else + set.difference(Set2, set.make_singleton_set(epsilon), Set) + ) + else + % If we don't know anything about this nonterminal, + % then stop here. + Set = Set0 + ) + ) + else + Set = Set0 + ). -:- pred collect_terminals(rules, set(terminal)). -:- mode collect_terminals(in, out) is det. +:- pred collect_terminals(rules::in, set(terminal)::out) is det. collect_terminals(Rules, Terminals) :- - map.foldl((pred(_RN::in, Rule::in, Ts0::in, Ts::out) is det :- - Rule = rule(_Id, _Head, Elems, _, _, _, _), - Ts = array.foldl((func(Elem, Ts1) = Ts2 :- - ( - Elem = terminal(Id), - Ts2 = [Id|Ts1] - ; - Elem = nonterminal(_Id_), - Ts2 = Ts1 - ) - ), Elems, Ts0) - ), Rules, [], TerminalsList), - set.list_to_set(TerminalsList, Terminals). + map.foldl( + ( pred(_RN::in, Rule::in, Ts0::in, Ts::out) is det :- + Rule = rule(_Id, _Head, Elems, _, _, _, _), + array.foldl( + ( pred(Elem::in, Ts1::in, Ts2::out) is det :- + ( + Elem = terminal(Id), + Ts2 = [Id | Ts1] + ; + Elem = nonterminal(_Id_), + Ts2 = Ts1 + ) + ), Elems, Ts0, Ts) + ), Rules, [], TerminalsList), + set.list_to_set(TerminalsList, Terminals). -:- pred collect_nonterminals(rules, list(nonterminal)). -:- mode collect_nonterminals(in, out) is det. +:- pred collect_nonterminals(rules::in, list(nonterminal)::out) is det. collect_nonterminals(Rules, Nonterminals) :- - map.foldl((pred(_RN ::in, Rule::in, Ts0::in, Ts::out) is det :- - Rule = rule(Id, _Head, _Elems, _, _, _Varset, _Context), - Ts = [Id|Ts0] - ), Rules, [], NonterminalsList), - set.list_to_set(NonterminalsList, Nonterminals0), - set.to_sorted_list(Nonterminals0, Nonterminals). + map.foldl( + ( pred(_RN ::in, Rule::in, Ts0::in, Ts::out) is det :- + Rule = rule(Id, _Head, _Elems, _, _, _Varset, _Context), + Ts = [Id | Ts0] + ), Rules, [], NonterminalsList), + set.list_to_set(NonterminalsList, Nonterminals0), + set.to_sorted_list(Nonterminals0, Nonterminals). - % YYY This probably belongs in the library somewhere. -:- pred while(pred(T), pred(T, T), T, T). -:- mode while(pred(in) is semidet, pred(in, out) is det, in, out) is det. + % YYY This probably belongs in the library somewhere. + % +:- pred while(pred(T)::in(pred(in) is semidet), + pred(T, T)::in(pred(in, out) is det), T::in, T::out) is det. while(Cond, Body, Acc0, Acc) :- - ( call(Cond, Acc0) -> - call(Body, Acc0, Acc1), - while(Cond, Body, Acc1, Acc) - ; - Acc = Acc0 - ). + ( if call(Cond, Acc0) then + call(Body, Acc0, Acc1), + while(Cond, Body, Acc1, Acc) + else + Acc = Acc0 + ). - % YYY This probably belongs in the library somewhere. -:- pred until(pred(T, T), pred(T), T, T). -:- mode until(pred(in, out) is det, pred(in) is semidet, in, out) is det. + % YYY This probably belongs in the library somewhere. + % +:- pred until(pred(T, T)::in(pred(in, out) is det), + pred(T)::in(pred(in) is semidet), T::in, T::out) is det. until(Body, Cond, Acc0, Acc) :- - call(Body, Acc0, Acc1), - ( call(Cond, Acc1) -> - Acc = Acc1 - ; - until(Body, Cond, Acc1, Acc) - ). + call(Body, Acc0, Acc1), + ( if call(Cond, Acc1) then + Acc = Acc1 + else + until(Body, Cond, Acc1, Acc) + ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% - % The computation of the follow sets is directly from - % the dragon book. - -:- pred compute_follow0(grammar, grammar). -:- mode compute_follow0(in, out) is det. + % The computation of the follow sets is directly from the dragon book. + % +:- pred compute_follow0(grammar::in, grammar::out) is det. compute_follow0(Grammar0, Grammar) :- - Grammar0 = grammar(Rules, Clauses, Xfs, Nont, Index, First, _), - compute_follow(Rules, start, ($), First, Follow), - Grammar = grammar(Rules, Clauses, Xfs, Nont, Index, First, Follow). + Grammar0 = grammar(Rules, Clauses, Xfs, Nont, Index, First, _), + compute_follow(Rules, start, ($), First, Follow), + Grammar = grammar(Rules, Clauses, Xfs, Nont, Index, First, Follow). :- type follow_stuff - ---> stuff( - bool, % Changed? - list(nonterminal), % Nonterminals - rules, - first, - follow - ). + ---> follow_stuff( + bool, % Changed? + list(nonterminal), % Nonterminals + rules, + first, + follow + ). compute_follow(Rules, Start, EOF, First, Follow) :- - map.init(Follow0), - % Rule 1 - map.set(Start, set.make_singleton_set(EOF), Follow0, Follow1), - collect_nonterminals(Rules, Ns), - Stuff0 = stuff(no, Ns, Rules, First, Follow1), - until((pred(Stuff1::in, Stuff3::out) is det :- - Stuff1 = stuff(_, N1, R1, Fi1, Fo1), - Stuff2 = stuff(no, N1, R1, Fi1, Fo1), - foldl(compute_follow, Rules, Stuff2, Stuff3) - ), - (pred(StuffN::in) is semidet :- - StuffN = stuff(no, _, _, _, _) - ), Stuff0, Stuff), - Stuff = stuff(_, _, _, _, Follow). + map.init(Follow0), + % Rule 1 + map.set(Start, set.make_singleton_set(EOF), Follow0, Follow1), + collect_nonterminals(Rules, Ns), + Stuff0 = follow_stuff(no, Ns, Rules, First, Follow1), + until( + ( pred(Stuff1::in, Stuff3::out) is det :- + Stuff1 = follow_stuff(_, N1, R1, Fi1, Fo1), + Stuff2 = follow_stuff(no, N1, R1, Fi1, Fo1), + foldl(compute_follow, Rules, Stuff2, Stuff3) + ), + ( pred(StuffN::in) is semidet :- + StuffN = follow_stuff(no, _, _, _, _) + ), + Stuff0, Stuff), + Stuff = follow_stuff(_, _, _, _, Follow). -:- pred compute_follow(int, (rule), follow_stuff, follow_stuff). -:- mode compute_follow(in, in, in, out) is det. +:- pred compute_follow(int::in, (rule)::in, + follow_stuff::in, follow_stuff::out) is det. compute_follow(_RuleNum, Rule, Stuff0, Stuff) :- - Rule = rule(Id, _Head, Elems, _, _, _Varset, _Context), - Stuff0 = stuff(_, _, _, First, _), - array.max(Elems, Max), - % Apply Rule 2 - compute_follow2(0, Max, First, Elems, Stuff0, Stuff1), - compute_follow3(Max, First, Id, Elems, Stuff1, Stuff). + Rule = rule(Id, _Head, Elems, _, _, _Varset, _Context), + Stuff0 = follow_stuff(_, _, _, First, _), + array.max(Elems, Max), + % Apply Rule 2 + compute_follow2(0, Max, First, Elems, Stuff0, Stuff1), + compute_follow3(Max, First, Id, Elems, Stuff1, Stuff). -:- pred compute_follow2(int, int, first, symbols, follow_stuff, follow_stuff). -:- mode compute_follow2(in, in, in, in, in, out) is det. +:- pred compute_follow2(int::in, int::in, first::in, symbols::in, + follow_stuff::in, follow_stuff::out) is det. compute_follow2(I, IMax, First, Elems, Stuff0, Stuff) :- - ( I =< IMax -> - lookup(Elems, I, Elem), - ( Elem = nonterminal(Id) -> - IdFollow0 = first(First, Elems, I + 1), - difference(IdFollow0, set.make_singleton_set(epsilon), - IdFollow), - add_follow(Id, IdFollow, Stuff0, Stuff1) - ; - Stuff1 = Stuff0 - ), - compute_follow2(I + 1, IMax, First, Elems, Stuff1, Stuff) - ; - Stuff = Stuff0 - ). + ( if I =< IMax then + lookup(Elems, I, Elem), + ( if Elem = nonterminal(Id) then + IdFollow0 = first(First, Elems, I + 1), + difference(IdFollow0, set.make_singleton_set(epsilon), IdFollow), + add_follow(Id, IdFollow, Stuff0, Stuff1) + else + Stuff1 = Stuff0 + ), + compute_follow2(I + 1, IMax, First, Elems, Stuff1, Stuff) + else + Stuff = Stuff0 + ). -:- pred compute_follow3(int, first, nonterminal, symbols, - follow_stuff, follow_stuff). -:- mode compute_follow3(in, in, in, in, in, out) is det. +:- pred compute_follow3(int::in, first::in, nonterminal::in, symbols::in, + follow_stuff::in, follow_stuff::out) is det. compute_follow3(I, First, MyId, Elems, Stuff0, Stuff) :- - ( I >= 0 -> - array.lookup(Elems, I, Elem), - ( Elem = nonterminal(Id) -> - get_follow(MyId, MyFollow, Stuff0, _), - add_follow(Id, MyFollow, Stuff0, Stuff1), - map.lookup(First, Id, IdFirst), - ( set.member(epsilon, IdFirst) -> - compute_follow3(I - 1, First, MyId, Elems, - Stuff1, Stuff) - ; - Stuff = Stuff1 - ) - ; - Stuff = Stuff0 - ) - ; - Stuff = Stuff0 - ). + ( if I >= 0 then + array.lookup(Elems, I, Elem), + ( if Elem = nonterminal(Id) then + get_follow(MyId, MyFollow, Stuff0, _), + add_follow(Id, MyFollow, Stuff0, Stuff1), + map.lookup(First, Id, IdFirst), + ( if set.member(epsilon, IdFirst) then + compute_follow3(I - 1, First, MyId, Elems, Stuff1, Stuff) + else + Stuff = Stuff1 + ) + else + Stuff = Stuff0 + ) + else + Stuff = Stuff0 + ). -:- pred get_follow(nonterminal, set(terminal), follow_stuff, follow_stuff). -:- mode get_follow(in, out, in, out) is det. +:- pred get_follow(nonterminal::in, set(terminal)::out, + follow_stuff::in, follow_stuff::out) is det. get_follow(Id, IdFollow, Stuff, Stuff) :- - Stuff = stuff(_, _, _, _, Follow), - ( search(Follow, Id, IdFollow0) -> - IdFollow = IdFollow0 - ; - set.init(IdFollow) - ). + Stuff = follow_stuff(_, _, _, _, Follow), + ( if search(Follow, Id, IdFollow0) then + IdFollow = IdFollow0 + else + set.init(IdFollow) + ). :- pred add_follow(nonterminal, set(terminal), follow_stuff, follow_stuff). :- mode add_follow(in, in, in, out) is det. add_follow(Id, IdFollow0, Stuff0, Stuff) :- - Stuff0 = stuff(Ch0, Ns, Rs, Fs, Follow0), - ( map.search(Follow0, Id, OldFollow) -> - difference(IdFollow0, OldFollow, NewFollow), - ( empty(NewFollow) -> - IdFollow = OldFollow, - Ch = Ch0 - ; - union(OldFollow, NewFollow, IdFollow), - Ch = yes - ) - ; - IdFollow = IdFollow0, - Ch = yes - ), - map.set(Id, IdFollow, Follow0, Follow), - Stuff = stuff(Ch, Ns, Rs, Fs, Follow). + Stuff0 = follow_stuff(Ch0, Ns, Rs, Fs, Follow0), + ( if map.search(Follow0, Id, OldFollow) then + difference(IdFollow0, OldFollow, NewFollow), + ( if set.is_empty(NewFollow) then + IdFollow = OldFollow, + Ch = Ch0 + else + union(OldFollow, NewFollow, IdFollow), + Ch = yes + ) + else + IdFollow = IdFollow0, + Ch = yes + ), + map.set(Id, IdFollow, Follow0, Follow), + Stuff = follow_stuff(Ch, Ns, Rs, Fs, Follow). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% first(First, Elems, I) = FirstI :- - array.max(Elems, Max), - ( I =< Max -> - array.lookup(Elems, I, Elem), - ( - Elem = terminal(Id), - FirstI = set.make_singleton_set(Id) - ; - Elem = nonterminal(Id), - map.lookup(First, Id, FirstI0), - ( set.member(epsilon, FirstI0) -> - RestFirst = first(First, Elems, I+1), - set.union(FirstI0, RestFirst, FirstI) - ; - FirstI = FirstI0 - ) - ) - ; - FirstI = set.make_singleton_set(epsilon) - ). + array.max(Elems, Max), + ( if I =< Max then + array.lookup(Elems, I, Elem), + ( + Elem = terminal(Id), + FirstI = set.make_singleton_set(Id) + ; + Elem = nonterminal(Id), + map.lookup(First, Id, FirstI0), + ( if set.member(epsilon, FirstI0) then + RestFirst = first(First, Elems, I+1), + set.union(FirstI0, RestFirst, FirstI) + else + FirstI = FirstI0 + ) + ) + else + FirstI = set.make_singleton_set(epsilon) + ). -%------------------------------------------------------------------------------% - -:- pred add_rule(rules, int, rule, rules). -:- mode add_rule(in, in, in, out) is det. - -add_rule(Rules0, Num, Rule, Rules) :- - map.set(Num, Rule, Rules0, Rules). - -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% diff --git a/extras/moose/lalr.m b/extras/moose/lalr.m index 2a3075eba..b48766ff1 100644 --- a/extras/moose/lalr.m +++ b/extras/moose/lalr.m @@ -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). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% diff --git a/extras/moose/mercury_syntax.m b/extras/moose/mercury_syntax.m index d9363c689..549b785e4 100644 --- a/extras/moose/mercury_syntax.m +++ b/extras/moose/mercury_syntax.m @@ -1,8 +1,10 @@ -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sw=4 et +%---------------------------------------------------------------------------% % Copyright (C) 1998-2000, 2003, 2006 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 mercury_syntax. :- interface. @@ -12,76 +14,68 @@ :- import_module term. :- import_module varset. -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- type (module) == list(element). - % Element is a type for pieces of a mercury module. + % Element is a type for pieces of a mercury module. :- type element - ---> pred(term, varset) % Pred declarations - ; func(term, varset) % Func declarations - ; type(type, varset) % Type declarations - ; mode(term, varset) % Mode declarations - % (both predicate modes and new modes) - ; inst(term, varset) % Inst declarations - ; clause(term, goal, varset) % Program clauses - ; dcg_clause(term, goal, varset) - % DCG clauses - ; class(term, varset) % Class declarations - ; instance(term, varset) % Instance declarations - ; misc(term, varset) % Anything else - . + ---> pred(term, varset) % Pred declarations + ; func(term, varset) % Func declarations + ; type(type, varset) % Type declarations + ; mode(term, varset) % Mode declarations + % (both predicate modes and new modes) + ; inst(term, varset) % Inst declarations + ; clause(term, goal, varset) % Program clauses + ; dcg_clause(term, goal, varset) % DCG clauses + ; class(term, varset) % Class declarations + ; instance(term, varset) % Instance declarations + ; misc(term, varset). % Anything else :- type module_result - ---> module(module, list(module_error)). + ---> module(module, list(module_error)). :- type module_error - ---> error(string, int). + ---> error(string, int). -:- pred read_module(module_result, io, io). -:- mode read_module(out, di, uo) is det. +:- pred read_module(module_result::out, io::di, io::uo) is det. :- type lines - ---> lines - ; nolines. + ---> lines + ; nolines. -:- pred write_element(lines, element, io, io). -:- mode write_element(in, in, di, uo) is det. +:- pred write_element(lines::in, element::in, io::di, io::uo) is det. -:- pred write_module(lines, (module), io, io). -:- mode write_module(in, in, di, uo) is det. +:- pred write_module(lines::in, (module)::in, io::di, io::uo) is det. :- type (type) - ---> abstr(term) - ; equiv(term, term) - ; disj(term, list(term)). + ---> abstr(term) + ; equiv(term, term) + ; disj(term, list(term)). -:- pred term_to_type(term, (type)). -:- mode term_to_type(in, out) is semidet. +:- pred term_to_type(term::in, (type)::out) is semidet. :- type goal - ---> conj(list(goal)) - ; disj(list(goal)) - ; ite(goal, goal, goal) - ; call(term) - ; (=(term, term, context)) - ; not(goal) - ; exists(vars, goal) - ; forall(vars, goal) - % (goal => goal) % XXX conflicts with type classes - ; (goal <= goal) - ; (goal <=> goal). + ---> conj(list(goal)) + ; disj(list(goal)) + ; ite(goal, goal, goal) + ; call(term) + ; (=(term, term, context)) + ; not(goal) + ; exists(vars, goal) + ; forall(vars, goal) + % (goal => goal) % XXX conflicts with type classes + ; (goal <= goal) + ; (goal <=> goal). -:- pred term_to_goal(term, goal). -:- mode term_to_goal(in, out) is semidet. +:- pred term_to_goal(term::in, goal::out) is semidet. -:- pred write_goal(varset, goal, io, io). -:- mode write_goal(in, in, di, uo) is det. +:- pred write_goal(varset::in, goal::in, io::di, io::uo) is det. :- type vars == list(var). -%------------------------------------------------------------------------------% -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- implementation. @@ -91,589 +85,545 @@ :- import_module string. :- import_module term_io. -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% read_module(Result, !IO) :- - read_module([], [], Result0, !IO), - Result0 = module(Module0, Errors0), - list.reverse(Module0, Module), - list.reverse(Errors0, Errors), - Result = module(Module, Errors). + read_module([], [], Result0, !IO), + Result0 = module(Module0, Errors0), + list.reverse(Module0, Module), + list.reverse(Errors0, Errors), + Result = module(Module, Errors). :- type element_result - ---> element(element) - ; eof - ; error(string, int). + ---> element(element) + ; eof + ; error(string, int). -:- pred read_module(module, list(module_error), module_result, - io, io). -:- mode read_module(in, in, out, di, uo) is det. +:- pred read_module((module)::in, list(module_error)::in, module_result::out, + io::di, io::uo) is det. read_module(Module, Errors, Result, !IO) :- - read_element(Result0, !IO), - ( - Result0 = eof, - Result = module(Module, Errors) - ; - Result0 = element(Element), - read_module([Element | Module], Errors, Result, !IO) - ; - Result0 = error(Msg, Line), - read_module(Module, [error(Msg, Line) | Errors], Result, !IO) - ). + read_element(Result0, !IO), + ( + Result0 = eof, + Result = module(Module, Errors) + ; + Result0 = element(Element), + read_module([Element | Module], Errors, Result, !IO) + ; + Result0 = error(Msg, Line), + read_module(Module, [error(Msg, Line) | Errors], Result, !IO) + ). -:- pred read_element(element_result, io, io). -:- mode read_element(out, di, uo) is det. +:- pred read_element(element_result::out, io::di, io::uo) is det. read_element(Result, !IO) :- - read_term(Result0, !IO), - ( - Result0 = eof, - Result = eof - ; - Result0 = error(Msg, Line), - Result = error(Msg, Line) - ; - Result0 = term(VarSet, Term), - ( classify(Term, VarSet, Element0) -> - Element = Element0 - ; - Element = misc(Term, VarSet) - ), - Result = element(Element) - ). + read_term(Result0, !IO), + ( + Result0 = eof, + Result = eof + ; + Result0 = error(Msg, Line), + Result = error(Msg, Line) + ; + Result0 = term(VarSet, Term), + ( if classify(Term, VarSet, Element0) then + Element = Element0 + else + Element = misc(Term, VarSet) + ), + Result = element(Element) + ). -:- pred classify(term, varset, element). -:- mode classify(in, in, out) is semidet. +:- pred classify(term::in, varset::in, element::out) is semidet. classify(Term, VarSet, Element) :- - Term = functor(atom(Atom), Args, _), - ( Atom = ":-" -> ( - Args = [functor(atom("pred"), [PredDecl], _)], - Element = pred(PredDecl, VarSet) - ; - Args = [functor(atom("func"), [FuncDecl], _)], - Element = func(FuncDecl, VarSet) - ; - Args = [functor(atom("mode"), [ModeDecl], _)], - Element = mode(ModeDecl, VarSet) - ; - Args = [functor(atom("type"), [TypeTerm], _)], - ( mercury_syntax.term_to_type(TypeTerm, TypeDecl) -> - Element = type(TypeDecl, VarSet) - ; - Element = misc(Term, VarSet) - ) - ; - Args = [functor(atom("inst"), [InstDecl], _)], - Element = inst(InstDecl, VarSet) - ; - Args = [functor(atom("class"), [ClassDecl], _)], - Element = class(ClassDecl, VarSet) - ; - Args = [functor(atom("instance"), [InstanceDecl], _)], - Element = instance(InstanceDecl, VarSet) - ; - Args = [Head, Body], - ( term_to_goal(Body, Goal) -> - Element = clause(Head, Goal, VarSet) - ; - Element = misc(Term, VarSet) - ) - ) ; Atom = "-->" -> - Args = [Head, Body], - ( term_to_goal(Body, Goal) -> - Element = dcg_clause(Head, Goal, VarSet) - ; - Element = misc(Term, VarSet) - ) - ; - Element = misc(Term, VarSet) - ). + Term = functor(atom(Atom), Args, _), + ( if Atom = ":-" then + ( + Args = [functor(atom("pred"), [PredDecl], _)], + Element = pred(PredDecl, VarSet) + ; + Args = [functor(atom("func"), [FuncDecl], _)], + Element = func(FuncDecl, VarSet) + ; + Args = [functor(atom("mode"), [ModeDecl], _)], + Element = mode(ModeDecl, VarSet) + ; + Args = [functor(atom("type"), [TypeTerm], _)], + ( if mercury_syntax.term_to_type(TypeTerm, TypeDecl) then + Element = type(TypeDecl, VarSet) + else + Element = misc(Term, VarSet) + ) + ; + Args = [functor(atom("inst"), [InstDecl], _)], + Element = inst(InstDecl, VarSet) + ; + Args = [functor(atom("class"), [ClassDecl], _)], + Element = class(ClassDecl, VarSet) + ; + Args = [functor(atom("instance"), [InstanceDecl], _)], + Element = instance(InstanceDecl, VarSet) + ; + Args = [Head, Body], + ( if term_to_goal(Body, Goal) then + Element = clause(Head, Goal, VarSet) + else + Element = misc(Term, VarSet) + ) + ) + else if Atom = "-->" then + Args = [Head, Body], + ( if term_to_goal(Body, Goal) then + Element = dcg_clause(Head, Goal, VarSet) + else + Element = misc(Term, VarSet) + ) + else + Element = misc(Term, VarSet) + ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% write_module(_Lines, [], !IO). write_module(Lines, [Element | Module], !IO) :- - write_element(Lines, Element, !IO), - io.nl(!IO), - write_module(Lines, Module, !IO). + write_element(Lines, Element, !IO), + io.nl(!IO), + write_module(Lines, Module, !IO). write_element(Lines, pred(PredDecl, VarSet), !IO) :- - cons_decl("pred", PredDecl, Term), - write_term(Lines, 0, VarSet, Term, !IO), - dot_nl(!IO). + cons_decl("pred", PredDecl, Term), + write_term(Lines, 0, VarSet, Term, !IO), + dot_nl(!IO). write_element(Lines, func(FuncDecl, VarSet), !IO) :- - cons_decl("func", FuncDecl, Term), - write_term(Lines, 0, VarSet, Term, !IO), - dot_nl(!IO). + cons_decl("func", FuncDecl, Term), + write_term(Lines, 0, VarSet, Term, !IO), + dot_nl(!IO). write_element(Lines, type(TypeDecl, VarSet), !IO) :- - ( - TypeDecl = abstr(AbstrTerm), - cons_decl("type", AbstrTerm, Term), - write_term(Lines, 0, VarSet, Term, !IO) - ; - TypeDecl = equiv(Head, Body), - get_context(Head, Context), - EqivTerm = functor(atom("=="), [Head, Body], Context), - cons_decl("type", EqivTerm, Term), - write_term(Lines, 0, VarSet, Term, !IO) - ; - TypeDecl = disj(Head, Body), - get_context(Head, Context), - cons_type_body(Body, BodyTerm), - DeclTerm = functor(atom("--->"), [Head, BodyTerm], Context), - cons_decl("type", DeclTerm, Term), - write_term(Lines, 0, VarSet, Term, !IO) - ), - dot_nl(!IO). + ( + TypeDecl = abstr(AbstrTerm), + cons_decl("type", AbstrTerm, Term), + write_term(Lines, 0, VarSet, Term, !IO) + ; + TypeDecl = equiv(Head, Body), + get_context(Head, Context), + EqivTerm = functor(atom("=="), [Head, Body], Context), + cons_decl("type", EqivTerm, Term), + write_term(Lines, 0, VarSet, Term, !IO) + ; + TypeDecl = disj(Head, Body), + get_context(Head, Context), + cons_type_body(Body, BodyTerm), + DeclTerm = functor(atom("--->"), [Head, BodyTerm], Context), + cons_decl("type", DeclTerm, Term), + write_term(Lines, 0, VarSet, Term, !IO) + ), + dot_nl(!IO). write_element(Lines, mode(ModeDecl, VarSet), !IO) :- - cons_decl("mode", ModeDecl, Term), - write_term(Lines, 0, VarSet, Term, !IO), - dot_nl(!IO). + cons_decl("mode", ModeDecl, Term), + write_term(Lines, 0, VarSet, Term, !IO), + dot_nl(!IO). write_element(Lines, inst(InstDecl, VarSet), !IO) :- - cons_decl("inst", InstDecl, Term), - write_term(Lines, 0, VarSet, Term, !IO), - dot_nl(!IO). + cons_decl("inst", InstDecl, Term), + write_term(Lines, 0, VarSet, Term, !IO), + dot_nl(!IO). write_element(Lines, class(ClassDecl, VarSet), !IO) :- - cons_decl("class", ClassDecl, Term), - write_term(Lines, 0, VarSet, Term, !IO), - dot_nl(!IO). + cons_decl("class", ClassDecl, Term), + write_term(Lines, 0, VarSet, Term, !IO), + dot_nl(!IO). write_element(Lines, instance(InstanceDecl, VarSet), !IO) :- - cons_decl("instance", InstanceDecl, Term), - write_term(Lines, 0, VarSet, Term, !IO), - dot_nl(!IO). + cons_decl("instance", InstanceDecl, Term), + write_term(Lines, 0, VarSet, Term, !IO), + dot_nl(!IO). write_element(Lines, misc(Term, VarSet), !IO) :- - write_term(Lines, 0, VarSet, Term, !IO), - dot_nl(!IO). + write_term(Lines, 0, VarSet, Term, !IO), + dot_nl(!IO). write_element(Lines, clause(Head, Goal, VarSet), !IO) :- - write_term(Lines, 0, VarSet, Head, !IO), - io.write_string(" :-\n", !IO), - write_goal(Lines, 1, normal, Goal, VarSet, !IO), - dot_nl(!IO). + write_term(Lines, 0, VarSet, Head, !IO), + io.write_string(" :-\n", !IO), + write_goal(Lines, 1, normal, Goal, VarSet, !IO), + dot_nl(!IO). write_element(Lines, dcg_clause(Head, Goal, VarSet), !IO) :- - write_term(Lines, 0, VarSet, Head, !IO), - io.write_string(" -->\n", !IO), - write_goal(Lines, 1, dcg, Goal, VarSet, !IO), - dot_nl(!IO). + write_term(Lines, 0, VarSet, Head, !IO), + io.write_string(" -->\n", !IO), + write_goal(Lines, 1, dcg, Goal, VarSet, !IO), + dot_nl(!IO). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- type goal_type - ---> normal - ; dcg. + ---> normal + ; dcg. -:- pred term_to_disj(term, list(term)). -:- mode term_to_disj(in, out) is semidet. +:- pred term_to_disj(term::in, list(term)::out) is semidet. -term_to_disj(functor(atom(";"), [Head,Term], _), [Head|Tail]) :- - ( term_to_disj(Term, Tail0) -> - Tail = Tail0 - ; - Tail = [Term] - ). +term_to_disj(functor(atom(";"), [Head, Term], _), [Head | Tail]) :- + ( if term_to_disj(Term, Tail0) then + Tail = Tail0 + else + Tail = [Term] + ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred cons_decl(string, term, term). -:- mode cons_decl(in, in, out) is det. +:- pred cons_decl(string::in, term::in, term::out) is det. cons_decl(Atom, DeclTerm, Term) :- - get_context(DeclTerm, Context), - Term = functor(atom(":-"), - [functor(atom(Atom), [DeclTerm], Context)], - Context). + get_context(DeclTerm, Context), + Term = functor(atom(":-"), + [functor(atom(Atom), [DeclTerm], Context)], + Context). -:- pred get_context(term, context). -:- mode get_context(in, out) is det. +:- pred get_context(term::in, context::out) is det. get_context(variable(_, Context), Context). get_context(functor(_, _, Context), Context). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_ind(int, io, io). -:- mode write_ind(in, di, uo) is det. +:- pred write_ind(int::in, io::di, io::uo) is det. write_ind(N, !IO) :- - ( N > 0 -> - io.write_string(" ", !IO), - write_ind(N - 1, !IO) - ; - true - ). + ( if N > 0 then + io.write_string(" ", !IO), + write_ind(N - 1, !IO) + else + true + ). -:- pred dot_nl(io, io). -:- mode dot_nl(di, uo) is det. +:- pred dot_nl(io::di, io::uo) is det. -dot_nl(!IO) :- io.write_string(".\n", !IO). +dot_nl(!IO) :- + io.write_string(".\n", !IO). -:- pred write_term(lines, int, varset, term, io, io). -:- mode write_term(in, in, in, in, di, uo) is det. +:- pred write_term(lines::in, int::in, varset::in, term::in, + io::di, io::uo) is det. write_term(lines, Ind, VarSet, Term, !IO) :- - get_context(Term, context(File, Line)), - ( File = "", Line = 0 -> - true - ; - io.format("#%d\n", [i(Line)], !IO) - ), - write_ind(Ind, !IO), - write_term(VarSet, Term, !IO). + get_context(Term, context(File, Line)), + ( if File = "", Line = 0 then + true + else + io.format("#%d\n", [i(Line)], !IO) + ), + write_ind(Ind, !IO), + write_term(VarSet, Term, !IO). write_term(nolines, Ind, VarSet, Term, !IO) :- - write_ind(Ind, !IO), - write_term(VarSet, Term, !IO). + write_ind(Ind, !IO), + write_term(VarSet, Term, !IO). -%------------------------------------------------------------------------------% -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% term_to_type(functor(atom(Atom), Args, Context), Type) :- - ( - Atom = "==", - Args = [Head0, Body0] - -> - Type = equiv(Head0, Body0) - ; - Atom = "--->", - Args = [Head1, Body1] - -> - ( term_to_disj(Body1, Terms0) -> - Terms = Terms0 - ; - Terms = [Body1] - ), - Type = disj(Head1, Terms) - ; - Type = abstr(functor(atom(Atom), Args, Context)) - ). + ( if + Atom = "==", + Args = [Head0, Body0] + then + Type = equiv(Head0, Body0) + else if + Atom = "--->", + Args = [Head1, Body1] + then + ( if term_to_disj(Body1, Terms0) then + Terms = Terms0 + else + Terms = [Body1] + ), + Type = disj(Head1, Terms) + else + Type = abstr(functor(atom(Atom), Args, Context)) + ). -:- pred cons_type_body(list(term), term). -:- mode cons_type_body(in, out) is det. +:- pred cons_type_body(list(term)::in, term::out) is det. cons_type_body([], _) :- - error("cons_type_body: no disjuncts"). + error("cons_type_body: no disjuncts"). cons_type_body([E], E). -cons_type_body([E|Es], T) :- - Es = [_|_], - cons_type_body(Es, T0), - get_context(E, Context), - T = functor(atom(";"), [E, T0], Context). +cons_type_body([E | Es], T) :- + Es = [_ | _], + cons_type_body(Es, T0), + get_context(E, Context), + T = functor(atom(";"), [E, T0], Context). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% term_to_goal(functor(atom(Atom), Args, Context), Goal) :- - ( term_to_goal0(Atom, Args, Context, Goal0) -> - Goal = Goal0 - ; - Goal = call(functor(atom(Atom), Args, Context)) - ). + ( if term_to_goal0(Atom, Args, Context, Goal0) then + Goal = Goal0 + else + Goal = call(functor(atom(Atom), Args, Context)) + ). -:- pred term_to_goal0(string, list(term), context, goal). -:- mode term_to_goal0(in, in, in, out) is semidet. +:- pred term_to_goal0(string::in, list(term)::in, context::in, goal::out) + is semidet. term_to_goal0("true", [], _, conj([])). term_to_goal0("fail", [], _, disj([])). - -term_to_goal0(",", [A, B], _, conj([GoalA|Conj])) :- - term_to_goal(A, GoalA), - term_to_goal(B, GoalB), - ( GoalB = conj(Conj0) -> - Conj = Conj0 - ; - Conj = [GoalB] - ). - +term_to_goal0(",", [A, B], _, conj([GoalA | Conj])) :- + term_to_goal(A, GoalA), + term_to_goal(B, GoalB), + ( GoalB = conj(Conj0) -> + Conj = Conj0 + ; + Conj = [GoalB] + ). term_to_goal0(";", [A, B], _, Goal) :- - ( A = functor(atom("->"), [IfTerm, ThenTerm], _) -> - term_to_goal(IfTerm, If), - term_to_goal(ThenTerm, Then), - term_to_goal(B, Else), - Goal = ite(If, Then, Else) - ; - term_to_goal(A, GoalA), - term_to_goal(B, GoalB), - ( GoalB = disj(Disj0) -> - Goal = disj([GoalA|Disj0]) - ; - Goal = disj([GoalA, GoalB]) - ) - ). - -term_to_goal0("else", [functor(atom("if"), [IfThenTerm], _), ElseTerm], _, - Goal) :- - IfThenTerm = functor(atom("then"), [IfTerm, ThenTerm], _), - term_to_goal(IfTerm, If), - term_to_goal(ThenTerm, Then), - term_to_goal(ElseTerm, Else), - Goal = ite(If, Then, Else). - + ( if A = functor(atom("->"), [IfTerm, ThenTerm], _) then + term_to_goal(IfTerm, If), + term_to_goal(ThenTerm, Then), + term_to_goal(B, Else), + Goal = ite(If, Then, Else) + else + term_to_goal(A, GoalA), + term_to_goal(B, GoalB), + ( if GoalB = disj(Disj0) then + Goal = disj([GoalA | Disj0]) + else + Goal = disj([GoalA, GoalB]) + ) + ). +term_to_goal0("else", [functor(atom("if"), [IfThenTerm], _), ElseTerm], _, + Goal) :- + IfThenTerm = functor(atom("then"), [IfTerm, ThenTerm], _), + term_to_goal(IfTerm, If), + term_to_goal(ThenTerm, Then), + term_to_goal(ElseTerm, Else), + Goal = ite(If, Then, Else). term_to_goal0("=", [A, B], Context, =(A, B, Context)). - term_to_goal0("not", [A], _, not(Goal)) :- - term_to_goal(A, Goal). - + term_to_goal(A, Goal). term_to_goal0("\\+", [A], _, not(Goal)) :- - term_to_goal(A, Goal). - + term_to_goal(A, Goal). term_to_goal0("some", [VarsTerm, GoalTerm], _, exists(Vars, Goal)) :- - vars(VarsTerm, Vars0), - sort_and_remove_dups(Vars0, Vars), - term_to_goal(GoalTerm, Goal). - + vars(VarsTerm, Vars0), + sort_and_remove_dups(Vars0, Vars), + term_to_goal(GoalTerm, Goal). term_to_goal0("all", [VarsTerm, GoalTerm], _, forall(Vars, Goal)) :- - vars(VarsTerm, Vars0), - sort_and_remove_dups(Vars0, Vars), - term_to_goal(GoalTerm, Goal). - -/* -term_to_goal0("=>", [A, B], _, (GoalA => GoalB)) :- - term_to_goal(A, GoalA), - term_to_goal(B, GoalB). -*/ - + vars(VarsTerm, Vars0), + sort_and_remove_dups(Vars0, Vars), + term_to_goal(GoalTerm, Goal). +% term_to_goal0("=>", [A, B], _, (GoalA => GoalB)) :- +% term_to_goal(A, GoalA), +% term_to_goal(B, GoalB). term_to_goal0("<=", [A, B], _, (GoalA <= GoalB)) :- - term_to_goal(A, GoalA), - term_to_goal(B, GoalB). - + term_to_goal(A, GoalA), + term_to_goal(B, GoalB). term_to_goal0("<=>", [A, B], _, (GoalA <=> GoalB)) :- - term_to_goal(A, GoalA), - term_to_goal(B, GoalB). + term_to_goal(A, GoalA), + term_to_goal(B, GoalB). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% write_goal(VarSet, Goal, !IO) :- - write_goal(nolines, 1, normal, Goal, VarSet, !IO). + write_goal(nolines, 1, normal, Goal, VarSet, !IO). -:- pred write_goal(lines, int, goal_type, goal, varset, io, io). -:- mode write_goal(in, in, in, in, in, di, uo) is det. +:- pred write_goal(lines::in, int::in, goal_type::in, goal::in, varset::in, + io::di, io::uo) is det. write_goal(Lines, Ind, _GoalType, call(Term), VarSet, !IO) :- - write_term(Lines, Ind, VarSet, Term, !IO). - + write_term(Lines, Ind, VarSet, Term, !IO). write_goal(Lines, Ind, GoalType, =(LHS, RHS, Context), VarSet, !IO) :- - UnifyTerm = functor(atom("="), [LHS, RHS], Context), - ( - GoalType = dcg, - Term = functor(atom("{}"), [UnifyTerm], Context) - ; - GoalType = normal, - Term = UnifyTerm - ), - write_term(Lines, Ind, VarSet, Term, !IO). - + UnifyTerm = functor(atom("="), [LHS, RHS], Context), + ( + GoalType = dcg, + Term = functor(atom("{}"), [UnifyTerm], Context) + ; + GoalType = normal, + Term = UnifyTerm + ), + write_term(Lines, Ind, VarSet, Term, !IO). write_goal(Lines, Ind, GoalType, conj(Goals), VarSet, !IO) :- - write_conj(Lines, Ind, GoalType, Goals, VarSet, !IO). - + write_conj(Lines, Ind, GoalType, Goals, VarSet, !IO). write_goal(Lines, Ind, GoalType, disj(Goals), VarSet, !IO) :- - write_disj(Lines, Ind, GoalType, Goals, VarSet, !IO). - + write_disj(Lines, Ind, GoalType, Goals, VarSet, !IO). write_goal(Lines, Ind, GoalType, ite(If, Then, Else0), VarSet, !IO) :- - collect_ite(Else0, IfThens0, Else), - write_ite(Lines, Ind, GoalType, [If - Then | IfThens0], Else, VarSet, - !IO). - + collect_ite(Else0, IfThens0, Else), + write_ite(Lines, Ind, GoalType, [If - Then | IfThens0], Else, VarSet, !IO). write_goal(Lines, Ind, GoalType, not(Goal), VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("not (\n", !IO), - write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(")", !IO). - + write_ind(Ind, !IO), + io.write_string("not (\n", !IO), + write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(")", !IO). write_goal(Lines, Ind, GoalType, exists(Vars, Goal), VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("some [", !IO), - write_vars(Vars, VarSet, !IO), - io.write_string("] (\n", !IO), - write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(")", !IO). - + write_ind(Ind, !IO), + io.write_string("some [", !IO), + write_vars(Vars, VarSet, !IO), + io.write_string("] (\n", !IO), + write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(")", !IO). write_goal(Lines, Ind, GoalType, forall(Vars, Goal), VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("all [", !IO), - write_vars(Vars, VarSet, !IO), - io.write_string("] (\n", !IO), - write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(")", !IO). - -/* -write_goal(Lines, Ind, GoalType, (A => B), VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("((\n", !IO), - write_goal(Lines, Ind, GoalType, A, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(") => (\n", !IO), - write_goal(Lines, Ind, GoalType, A, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string("))", !IO). -*/ - + write_ind(Ind, !IO), + io.write_string("all [", !IO), + write_vars(Vars, VarSet, !IO), + io.write_string("] (\n", !IO), + write_goal(Lines, Ind + 1, GoalType, Goal, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(")", !IO). +% write_goal(Lines, Ind, GoalType, (A => B), VarSet, !IO) :- +% write_ind(Ind, !IO), +% io.write_string("((\n", !IO), +% write_goal(Lines, Ind, GoalType, A, VarSet, !IO), +% io.nl(!IO), +% write_ind(Ind, !IO), +% io.write_string(") => (\n", !IO), +% write_goal(Lines, Ind, GoalType, A, VarSet, !IO), +% io.nl(!IO), +% write_ind(Ind, !IO), +% io.write_string("))", !IO). write_goal(Lines, Ind, GoalType, (A <= B), VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("((\n", !IO), - write_goal(Lines, Ind, GoalType, A, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(") <= (\n", !IO), - write_goal(Lines, Ind, GoalType, B, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string("))", !IO). - + write_ind(Ind, !IO), + io.write_string("((\n", !IO), + write_goal(Lines, Ind, GoalType, A, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(") <= (\n", !IO), + write_goal(Lines, Ind, GoalType, B, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string("))", !IO). write_goal(Lines, Ind, GoalType, (A <=> B), VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("((\n", !IO), - write_goal(Lines, Ind, GoalType, A, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(") <=> (\n", !IO), - write_goal(Lines, Ind, GoalType, B, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string("))", !IO). + write_ind(Ind, !IO), + io.write_string("((\n", !IO), + write_goal(Lines, Ind, GoalType, A, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(") <=> (\n", !IO), + write_goal(Lines, Ind, GoalType, B, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string("))", !IO). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_conj(lines, int, goal_type, list(goal), varset, - io, io). -:- mode write_conj(in, in, in, in, in, di, uo) is det. +:- pred write_conj(lines::in, int::in, goal_type::in, list(goal)::in, + varset::in, io::di, io::uo) is det. write_conj(_Lines, Ind, Type, [], _VarSet, !IO) :- - write_ind(Ind, !IO), - ( - Type = normal, - io.write_string("true", !IO) - ; - Type = dcg, - io.write_string("{ true }", !IO) - ). - + write_ind(Ind, !IO), + ( + Type = normal, + io.write_string("true", !IO) + ; + Type = dcg, + io.write_string("{ true }", !IO) + ). write_conj(Lines, Ind, Type, [Goal], VarSet, !IO) :- - write_goal(Lines, Ind, Type, Goal, VarSet, !IO). + write_goal(Lines, Ind, Type, Goal, VarSet, !IO). +write_conj(Lines, Ind, Type, [Goal | Goals], VarSet, !IO) :- + Goals = [_ | _], + write_goal(Lines, Ind, Type, Goal, VarSet, !IO), + io.write_string(",\n", !IO), + write_conj(Lines, Ind, Type, Goals, VarSet, !IO). -write_conj(Lines, Ind, Type, [Goal|Goals], VarSet, !IO) :- - Goals = [_|_], - write_goal(Lines, Ind, Type, Goal, VarSet, !IO), - io.write_string(",\n", !IO), - write_conj(Lines, Ind, Type, Goals, VarSet, !IO). +%---------------------------------------------------------------------------% -%------------------------------------------------------------------------------% - -:- pred write_disj(lines, int, goal_type, list(goal), varset, - io, io). -:- mode write_disj(in, in, in, in, in, di, uo) is det. +:- pred write_disj(lines::in, int::in, goal_type::in, list(goal)::in, + varset::in, io::di, io::uo) is det. write_disj(Lines, Ind, Type, Goals, VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("(\n", !IO), - write_disj0(Lines, Ind, Type, Goals, VarSet, !IO), io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(")", !IO). + write_ind(Ind, !IO), + io.write_string("(\n", !IO), + write_disj0(Lines, Ind, Type, Goals, VarSet, !IO), io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(")", !IO). -:- pred write_disj0(lines, int, goal_type, list(goal), varset, - io, io). -:- mode write_disj0(in, in, in, in, in, di, uo) is det. +:- pred write_disj0(lines::in, int::in, goal_type::in, list(goal)::in, + varset::in, io::di, io::uo) is det. write_disj0(_Lines, Ind, Type, [], _VarSet, !IO) :- - write_ind(Ind + 1, !IO), - ( - Type = normal, - io.write_string("fail", !IO) - ; - Type = dcg, - io.write_string("{ fail }", !IO) - ). - + write_ind(Ind + 1, !IO), + ( + Type = normal, + io.write_string("fail", !IO) + ; + Type = dcg, + io.write_string("{ fail }", !IO) + ). write_disj0(Lines, Ind, Type, [Goal], VarSet, !IO) :- - write_goal(Lines, Ind + 1, Type, Goal, VarSet, !IO), io.nl(!IO). - + write_goal(Lines, Ind + 1, Type, Goal, VarSet, !IO), io.nl(!IO). write_disj0(Lines, Ind, Type, [Goal | Goals], VarSet, !IO) :- - Goals = [_|_], - write_goal(Lines, Ind + 1, Type, Goal, VarSet, !IO), io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(";\n", !IO), - write_disj0(Lines, Ind, Type, Goals, VarSet, !IO). + Goals = [_ | _], + write_goal(Lines, Ind + 1, Type, Goal, VarSet, !IO), io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(";\n", !IO), + write_disj0(Lines, Ind, Type, Goals, VarSet, !IO). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred collect_ite(goal, list(pair(goal)), goal). -:- mode collect_ite(in, out, out) is det. +:- pred collect_ite(goal::in, list(pair(goal))::out, goal::out) is det. collect_ite(Goal0, IfThens, Else) :- - ( Goal0 = ite(If, Then, Else0) -> - IfThens = [If - Then|IfThens0], - collect_ite(Else0, IfThens0, Else) - ; - IfThens = [], - Else = Goal0 - ). + ( if Goal0 = ite(If, Then, Else0) then + collect_ite(Else0, IfThens0, Else), + IfThens = [If - Then | IfThens0] + else + IfThens = [], + Else = Goal0 + ). -:- pred write_ite(lines, int, goal_type, list(pair(goal)), goal, varset, - io, io). -:- mode write_ite(in, in, in, in, in, in, di, uo) is det. +:- pred write_ite(lines::in, int::in, goal_type::in, list(pair(goal))::in, + goal::in, varset::in, io::di, io::uo) is det. write_ite(Lines, Ind, Type, IfThens, Else, VarSet, !IO) :- - write_ind(Ind, !IO), - io.write_string("(\n", !IO), - write_ite0(Lines, Ind, Type, IfThens, VarSet, !IO), - write_ind(Ind, !IO), - io.write_string(";\n", !IO), - write_goal(Lines, Ind + 1, Type, Else, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(")", !IO). + write_ind(Ind, !IO), + io.write_string("(\n", !IO), + write_ite0(Lines, Ind, Type, IfThens, VarSet, !IO), + write_ind(Ind, !IO), + io.write_string(";\n", !IO), + write_goal(Lines, Ind + 1, Type, Else, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(")", !IO). -:- pred write_ite0(lines, int, goal_type, list(pair(goal)), varset, - io, io). -:- mode write_ite0(in, in, in, in, in, di, uo) is det. +:- pred write_ite0(lines::in, int::in, goal_type::in, list(pair(goal))::in, + varset::in, io::di, io::uo) is det. write_ite0(_Lines, _Ind, _Type, [], _VarSet, !IO) :- - error("no if-thens"). + error("no if-thens"). write_ite0(Lines, Ind, Type, [If - Then], VarSet, !IO) :- - write_goal(Lines, Ind + 1, Type, If, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string("->\n", !IO), - write_goal(Lines, Ind + 1, Type, Then, VarSet, !IO), - io.nl(!IO). + write_goal(Lines, Ind + 1, Type, If, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string("->\n", !IO), + write_goal(Lines, Ind + 1, Type, Then, VarSet, !IO), + io.nl(!IO). write_ite0(Lines, Ind, Type, [If - Then | Rest], VarSet, !IO) :- - Rest = [_|_], - write_goal(Lines, Ind + 1, Type, If, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string("->\n", !IO), - write_goal(Lines, Ind + 1, Type, Then, VarSet, !IO), - io.nl(!IO), - write_ind(Ind, !IO), - io.write_string(";\n", !IO), - write_ite0(Lines, Ind, Type, Rest, VarSet, !IO). + Rest = [_ | _], + write_goal(Lines, Ind + 1, Type, If, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string("->\n", !IO), + write_goal(Lines, Ind + 1, Type, Then, VarSet, !IO), + io.nl(!IO), + write_ind(Ind, !IO), + io.write_string(";\n", !IO), + write_ite0(Lines, Ind, Type, Rest, VarSet, !IO). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_vars(vars, varset, io, io). -:- mode write_vars(in, in, di, uo) is det. +:- pred write_vars(vars::in, varset::in, io::di, io::uo) is det. write_vars([], _, !IO). write_vars([V], VarSet, !IO) :- - term_io.write_variable(V, VarSet, !IO). + term_io.write_variable(V, VarSet, !IO). write_vars([V | Vs], VarSet, !IO) :- - Vs = [_|_], - term_io.write_variable(V, VarSet, !IO), - io.write_string(", ", !IO), - write_vars(Vs, VarSet, !IO). - + Vs = [_ | _], + term_io.write_variable(V, VarSet, !IO), + io.write_string(", ", !IO), + write_vars(Vs, VarSet, !IO). diff --git a/extras/moose/moose.m b/extras/moose/moose.m index e4dedb16b..f3b219b34 100644 --- a/extras/moose/moose.m +++ b/extras/moose/moose.m @@ -1,4 +1,6 @@ -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sw=4 et +%---------------------------------------------------------------------------% % Copyright (C) 1998-2004, 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. @@ -9,19 +11,19 @@ % There's scope for recoding much of this to use the more recent % additions to the language, if anyone feels like something to do. % -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- module moose. :- interface. :- import_module io. -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- pred main(io::di, io::uo) is det. -%----------------------------------------------------------------------------% -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- implementation. @@ -47,16 +49,18 @@ :- import_module term_io. :- import_module varset. -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% main(!IO) :- parse_options(MOptions, Args, !IO), ( MOptions = ok(Options), lookup_bool_option(Options, help, Help), - ( Help = yes -> + ( + Help = yes, help(!IO) ; + Help = no, main2(Options, Args, !IO) ) ; @@ -97,79 +101,90 @@ main2(Options, [Name0 | Names], !IO) :- io.error_message(Err, Msg), report_critical_error(Msg, !IO) ), - ( Names = [_|_] -> + ( + Names = [_ | _], main2(Options, Names, !IO) ; - true + Names = [] ). :- pred figure_out_names(string::in, string::out, string::out) is det. figure_out_names(Name0, InName, OutName) :- - ( string.remove_suffix(Name0, ".moo", Name1) -> + ( if string.remove_suffix(Name0, ".moo", Name1) then Name = Name1 - ; + else Name = Name0 ), string.append(Name, ".moo", InName), string.append(Name, ".m", OutName). :- type whereami - ---> (interface) ; (implementation) . + ---> (interface) ; (implementation). :- type parser ---> parser( - whereami, - nonterminal, % Starting nonterminal. - term, % EOF token. - string, % Token type name. - string, % Naming prefix (unused). - string, % Parser state input mode. - string % Parser state output mode. - ). + whereami, + nonterminal, % Starting nonterminal. + term, % EOF token. + string, % Token type name. + string, % Naming prefix (unused). + string, % Parser state input mode. + string % Parser state output mode. + ). :- pred process(options::in, io.state::di, io.state::uo) is det. process(Options, !IO) :- - lookup_bool_option(Options, verbose, Verbse), - ( Verbse = yes -> report_stats(!IO) ; true ), + lookup_bool_option(Options, verbose, Verbose), + ( + Verbose = yes, + report_stats(!IO) + ; + Verbose = no + ), read_module(Result, !IO), Result = module(Module, Errors), ( - Errors = [_|_], + Errors = [_ | _], io.stderr_stream(StdErr, !IO), - list.foldl((pred(Err::in, !.IO::di, !:IO::uo) is det :- - Err = error(Msg, Line), - io.format(StdErr, "%d: %s\n", [i(Line), s(Msg)], !IO) - ), Errors, !IO), + list.foldl( + ( pred(Err::in, !.IO::di, !:IO::uo) is det :- + Err = error(Msg, Line), + io.format(StdErr, "%d: %s\n", [i(Line), s(Msg)], !IO) + ), Errors, !IO), io.set_exit_status(1, !IO) ; Errors = [], get_moose_elements(Module, [], Remainder0, (implementation), - [], MParser, [], RuleDecls, [], ClauseList, - [], XFormList), + [], MParser, [], RuleDecls, [], ClauseList, [], XFormList), ( MParser = [], report_critical_error("error: no parse/6 declaration.", !IO) ; MParser = [Parser], list.reverse(Remainder0, Remainder), - process_2(Options, Remainder, Parser, - RuleDecls, ClauseList, XFormList, !IO) + process_2(Options, Remainder, Parser, RuleDecls, ClauseList, + XFormList, !IO) ; - MParser = [_,_|_], + MParser = [_, _ | _], report_critical_error("error: more than one parse/4 declaration.", !IO) ) ). -:- pred process_2(options, (module), parser, list(rule_decl), list(clause), - list(xform), io, io). -:- mode process_2(in, in, in, in, in, in, di, uo) is det. +:- pred process_2(options::in, (module)::in, parser::in, + list(rule_decl)::in, list(clause)::in, list(xform)::in, + io::di, io::uo) is det. process_2(Options, Module, Parser, Decls0, Clauses0, XFormList, !IO) :- - lookup_bool_option(Options, verbose, Verbse), - ( Verbse = yes -> report_stats(!IO) ; true ), + lookup_bool_option(Options, verbose, Verbose), + ( + Verbose = yes, + report_stats(!IO) + ; + Verbose = no + ), check_rule_decls(Decls0, Decls, DeclErrors), list.foldl(write_error, DeclErrors, !IO), @@ -177,7 +192,7 @@ process_2(Options, Module, Parser, Decls0, Clauses0, XFormList, !IO) :- check_clauses(Clauses0, Decls, Clauses, ClauseErrors), list.foldl(write_error, ClauseErrors, !IO), - Parser = parser(WhereAmI, StartId, EndTerm, TokenType, _Prefix, InAtom, + Parser = parser(WhereAmI, StartId, EndTerm, TokenType, _Prefix, InAtom, OutAtom), check_useless(StartId, Clauses, Decls, UselessErrors), @@ -186,27 +201,28 @@ process_2(Options, Module, Parser, Decls0, Clauses0, XFormList, !IO) :- check_inf_derivations(Clauses, Decls, InfErrors), list.foldl(write_error, InfErrors, !IO), - ( + ( if DeclErrors = [], ClauseErrors = [], UselessErrors = [], - InfErrors = [] - -> + InfErrors = [] + then write_module(nolines, Module, !IO), io.nl(!IO), map.lookup(Decls, StartId, StartDecl), write_parser(WhereAmI, StartId, StartDecl, TokenType, - InAtom, OutAtom, !IO), - write_action_type_class(WhereAmI, XFormList, Decls, - TokenType, InAtom, OutAtom, !IO), + InAtom, OutAtom, !IO), + write_action_type_class(WhereAmI, XFormList, Decls, TokenType, + InAtom, OutAtom, !IO), io.stderr_stream(StdErr, !IO), io.write_string(StdErr, "constructing grammar...\n", !IO), map.init(Xfns0), - list.foldl((pred(XForm::in, Xf0::in, Xf::out) is det :- - XForm = xform(XfNt, _), - map.det_insert(XfNt, XForm, Xf0, Xf) - ), XFormList, Xfns0, XForms), + list.foldl( + ( pred(XForm::in, Xf0::in, Xf::out) is det :- + XForm = xform(XfNt, _), + map.det_insert(XfNt, XForm, Xf0, Xf) + ), XFormList, Xfns0, XForms), construct_grammar(StartId, Clauses, XForms, Grammar), Grammar = grammar(Rules, _, Xfns, _, Index, First, _Follow), @@ -216,75 +232,70 @@ process_2(Options, Module, Parser, Decls0, Clauses0, XFormList, !IO) :- lr0items(Rules, Reaching, C, Gotos), io.write_string(StdErr, "determining lookaheads...\n", !IO), lookaheads(C, Gotos, Rules, First, Index, Lookaheads, !IO), - io.write_string(StdErr, "computing the action table...\n", - !IO), + io.write_string(StdErr, "computing the action table...\n", !IO), shifts(C, Rules, First, Reaching, Shifts), - actions(C, Rules, Lookaheads, Gotos, Shifts, States, + actions(C, Rules, Lookaheads, Gotos, Shifts, States, ActionTable, ActionErrs), list.foldl2( - (pred(Err::in, HasEs0::in, HasEs::out, !.IO::di, - !:IO::uo) is det :- - ( - Err = warning(Warning), - HasEs = HasEs0, + ( pred(Err::in, HasEs0::in, HasEs::out, !.IO::di, !:IO::uo) + is det :- ( - Warning = shiftreduce(_S, Rp), - io.write_string(StdErr, - "shift reduce conflict involving:\n\t", !IO), - write_rule(StdErr, Rp, Rules, !IO) + Err = warning(Warning), + HasEs = HasEs0, + ( + Warning = shiftreduce(_S, Rp), + io.write_string(StdErr, + "shift reduce conflict involving:\n\t", !IO), + write_rule(StdErr, Rp, Rules, !IO) + ) + ; + Err = error(Error), + HasEs = yes, + ( + Error = shiftshift(_, _), + io.write_string(StdErr, + "shift shift error.\n", !IO) + ; + Error = reducereduce(R0, R1), + io.write_string(StdErr, + "reduce reduce conflict involving:\n\t", !IO), + write_rule(StdErr, R0, Rules, !IO), + io.write_string(StdErr, "\t", !IO), + write_rule(StdErr, R1, Rules, !IO) + ; + Error = misc(Ac1, Ac2), + io.write_string(StdErr, + "misc conflict involving:\n\t", !IO), + io.write(StdErr, Ac1, !IO), + io.write_string(StdErr, "\n\t", !IO), + io.write(StdErr, Ac2, !IO), + io.write_string(StdErr, "\n", !IO) + ), + io.set_exit_status(1, !IO) ) - ; - Err = error(Error), - HasEs = yes, - ( - Error = shiftshift(_, _), - io.write_string(StdErr, - "shift shift error.\n", !IO) - ; - Error = reducereduce(R0, R1), - io.write_string(StdErr, - "reduce reduce conflict involving:\n\t", - !IO), - write_rule(StdErr, R0, Rules, !IO), - io.write_string(StdErr, "\t", !IO), - write_rule(StdErr, R1, Rules, !IO) - ; - Error = misc(Ac1, Ac2), - io.write_string(StdErr, - "misc conflict involving:\n\t", - !IO), - io.write(StdErr, Ac1, !IO), - io.write_string(StdErr, "\n\t", !IO), - io.write(StdErr, Ac2, !IO), - io.write_string(StdErr, "\n", !IO) - ), - io.set_exit_status(1, !IO) - ) - ), ActionErrs, no, _HasErrors, !IO), + ), ActionErrs, no, _HasErrors, !IO), write_action_table(ActionTable, TokenType, EndTerm, !IO), io.write_string(StdErr, "computing the goto table...\n", !IO), gotos(C, States, Gotos, GotoTable), write_goto_table(GotoTable, Decls, !IO), - write_reductions(Rules, ActionTable, TokenType, InAtom, + write_reductions(Rules, ActionTable, TokenType, InAtom, OutAtom, Xfns, !IO) - ; + else % XXX: What is this condition? Should an exception be thrown here?!? - true, io.set_exit_status(1, !IO) ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_action_type_class(whereami, list(xform), rule_decls, - string, string, string, io, io). -:- mode write_action_type_class(in, in, in, in, in, in, di, uo) is det. +:- pred write_action_type_class(whereami::in, list(xform)::in, rule_decls::in, + string::in, string::in, string::in, io::di, io::uo) is det. -write_action_type_class(Where, XForms, Decls, TokenType, InAtom, OutAtom, - !IO) :- +write_action_type_class(Where, XForms, Decls, TokenType, InAtom, OutAtom, + !IO) :- ( Where = (interface) -> io.write_string(":- interface.\n\n", !IO) ; - true + true ), io.format("\ :- typeclass parser_state(T) where [ @@ -294,46 +305,48 @@ write_action_type_class(Where, XForms, Decls, TokenType, InAtom, OutAtom, mode unget_token(in, %s) = %s is det\ ", [s(TokenType), s(InAtom), s(OutAtom), - s(TokenType), s(InAtom), s(OutAtom)], !IO - ), - ( not XForms = [] -> + s(TokenType), s(InAtom), s(OutAtom)], !IO), + ( + XForms = [_ | _], io.write_string(",\n", !IO) ; - true + XForms = [] ), - WriteIn = (pred(_Anything::in, !.IO::di, !:IO::uo) is det :- - io.write_string("in", !IO) - ), - WriteXForm = (pred(XForm::in, !.IO::di, !:IO::uo) is det :- - XForm = xform(NT, MethodName), - map.lookup(Decls, NT, RuleDecl), - RuleDecl = rule(_NT, Types, VarSet, _Context), - io.format("\tfunc %s(", [s(MethodName)], !IO), - io.write_list(Types, ", ", term_io.write_term(VarSet), !IO), - ( Types \= [] -> io.write_string(", ", !IO) ; true ), - io.write_string("T) = T,\n", !IO), + WriteIn = + ( pred(_Anything::in, !.IO::di, !:IO::uo) is det :- + io.write_string("in", !IO) + ), + WriteXForm = + ( pred(XForm::in, !.IO::di, !:IO::uo) is det :- + XForm = xform(NT, MethodName), + map.lookup(Decls, NT, RuleDecl), + RuleDecl = rule(_NT, Types, VarSet, _Context), + io.format("\tfunc %s(", [s(MethodName)], !IO), + io.write_list(Types, ", ", term_io.write_term(VarSet), !IO), + ( Types \= [] -> io.write_string(", ", !IO) ; true ), + io.write_string("T) = T,\n", !IO), - io.format("\tmode %s(", [s(MethodName)], !IO), - io.write_list(Types, ", ", WriteIn, !IO), - ( Types \= [] -> io.write_string(", ", !IO) ; true ), - io.format("%s) = %s is det", [s(InAtom), s(OutAtom)], !IO) - ), + io.format("\tmode %s(", [s(MethodName)], !IO), + io.write_list(Types, ", ", WriteIn, !IO), + ( Types \= [] -> io.write_string(", ", !IO) ; true ), + io.format("%s) = %s is det", [s(InAtom), s(OutAtom)], !IO) + ), io.write_list(XForms, ",\n", WriteXForm, !IO), io.write_string("\n].\n", !IO), - ( Where = (interface) -> + ( if Where = (interface) then io.write_string(":- implementation.\n\n", !IO) - ; - true + else + true ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_rule(output_stream, int, rules, io, io). -:- mode write_rule(in, in, in, di, uo) is det. +:- pred write_rule(output_stream::in, int::in, rules::in, + io::di, io::uo) is det. write_rule(Stream, RN, Rules, !IO) :- map.lookup(Rules, RN, Rule), - io.write_int(Stream, RN, !IO), + io.write_int(Stream, RN, !IO), io.write_string(Stream, ": ", !IO), Rule = rule(NT, _, Syms, _, _, _, _), io.write(Stream, NT, !IO), @@ -341,73 +354,74 @@ write_rule(Stream, RN, Rules, !IO) :- write_syms(Stream, 0, 999, Syms, !IO), io.write_string(Stream, "\n", !IO). -:- pred write_syms(output_stream, int, int, symbols, io, io). -:- mode write_syms(in, in, in, in, di, uo) is det. +:- pred write_syms(output_stream::in, int::in, int::in, symbols::in, + io::di, io::uo) is det. write_syms(Stream, N, Dot, Syms, !IO) :- - ( N = Dot -> + ( if N = Dot then io.write_string(Stream, ". ", !IO) - ; + else true ), array.max(Syms, Max), - ( N =< Max -> + ( if N =< Max then array.lookup(Syms, N, Sym), io.write(Stream, Sym, !IO), io.write_string(Stream, " ", !IO), write_syms(Stream, N + 1, Dot, Syms, !IO) - ; - true + else + true ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred get_moose_elements((module), (module), (module), whereami, - list(parser), list(parser), list(rule_decl), list(rule_decl), - list(clause), list(clause), list(xform), list(xform)). -:- mode get_moose_elements(in, in, out, in, in, out, in, out, in, out, - in, out) is det. +:- pred get_moose_elements((module)::in, (module)::in, (module)::out, + whereami::in, list(parser)::in, list(parser)::out, + list(rule_decl)::in, list(rule_decl)::out, + list(clause)::in, list(clause)::out, list(xform)::in, list(xform)::out) + is det. -get_moose_elements([], !Remainder, _, !MParser, !RuleDecls, !Clauses, !Actions). -get_moose_elements([Element | Elements], !Remainder, !.WhereAmI, !MParser, - !RuleDecls, !Clauses, !Actions) :- - ( +get_moose_elements([], !Remainder, _, + !MParser, !RuleDecls, !Clauses, !Actions). +get_moose_elements([Element | Elements], !Remainder, !.WhereAmI, + !MParser, !RuleDecls, !Clauses, !Actions) :- + ( if Element = misc(ClauseTerm, ClauseVarSet), term_to_clause(ClauseTerm, ClauseVarSet, _, Clause) - -> + then list.append([Clause], !Clauses) - ; + else if Element = misc(MiscTerm0, _), interface_term(MiscTerm0) - -> + then !:WhereAmI = (interface), - list.append([Element], !Remainder) - ; + list.append([Element], !Remainder) + else if Element = misc(MiscTerm1, _), implementation_term(MiscTerm1) - -> + then !:WhereAmI = (implementation), list.append([Element], !Remainder) - ; + else if Element = misc(MiscTerm2, MiscVarSet2), rule_term(MiscTerm2, MiscVarSet2, RuleDecl) - -> + then list.append([RuleDecl], !RuleDecls) - ; + else if Element = misc(MiscTerm3, MiscVarSet3), parser_term(MiscTerm3, MiscVarSet3, !.WhereAmI, Parser) - -> + then list.append([Parser], !MParser) - ; + else if Element = misc(MiscTerm4, _), xform_term(MiscTerm4, XForm) - -> + then list.append([XForm], !Actions) - ; + else list.append([Element], !Remainder) ), - get_moose_elements(Elements, !Remainder, !.WhereAmI, !MParser, - !RuleDecls, !Clauses, !Actions). + get_moose_elements(Elements, !Remainder, !.WhereAmI, + !MParser, !RuleDecls, !Clauses, !Actions). :- pred interface_term(term::in) is semidet. @@ -418,8 +432,7 @@ interface_term(functor(atom(":-"), [functor(atom("interface"), [], _)], _)). implementation_term(functor(atom(":-"), [functor(atom("implementation"), [], _)], _)). -:- pred rule_term(term, varset, rule_decl). -:- mode rule_term(in, in, out) is semidet. +:- pred rule_term(term::in, varset::in, rule_decl::out) is semidet. rule_term(functor(atom(":-"), [functor(atom("rule"), [RuleTerm], _)], _), VarSet, Decl) :- @@ -427,8 +440,8 @@ rule_term(functor(atom(":-"), [functor(atom("rule"), [RuleTerm], _)], _), list.length(Args, Arity), Decl = rule(Name/Arity, Args, VarSet, Context). -:- pred parser_term(term, varset, whereami, parser). -:- mode parser_term(in, in, in, out) is semidet. +:- pred parser_term(term::in, varset::in, whereami::in, parser::out) + is semidet. parser_term(functor(atom(":-"), [functor(atom("parse"), Args, _)], _), _VarSet, WhereAmI, Decl) :- @@ -445,8 +458,7 @@ parser_term(functor(atom(":-"), [functor(atom("parse"), Args, _)], _), Decl = parser(WhereAmI, StartId, EndTerm, TokAtom, PrefixAtom, InAtom, OutAtom). -:- pred xform_term(term, xform). -:- mode xform_term(in, out) is semidet. +:- pred xform_term(term::in, xform::out) is semidet. xform_term(Term, XForm) :- Term = functor(atom(":-"), [ @@ -461,10 +473,9 @@ xform_term(Term, XForm) :- integer.to_int(ArityInteger, Arity), XForm = xform(Name/Arity, Pred). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred help(io, io). -:- mode help(di, uo) is det. +:- pred help(io::di, io::uo) is det. help(!IO) :- io.stderr_stream(StdErr, !IO), @@ -479,10 +490,10 @@ usage: moose file ... -a|--dump-rules dump the flattened rules ", !IO). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_action_table(actiontable, string, term, io, io). -:- mode write_action_table(in, in, in, di, uo) is det. +:- pred write_action_table(action_table::in, string::in, term::in, + io::di, io::uo) is det. write_action_table(Table, TT, End, !IO) :- io.format(":- inst state_no --->\n\t\t", [], !IO), @@ -500,10 +511,10 @@ write_action_table(Table, TT, End, !IO) :- ", [s(TT)], !IO), - map.foldl((pred(State::in, StateActions::in, !.IO::di, - !:IO::uo) is det :- - string.format("0x%x", [i(State)], SS), - io.format("\ + map.foldl( + ( pred(State::in, StateActions::in, !.IO::di, !:IO::uo) is det :- + string.format("0x%x", [i(State)], SS), + io.format("\ actions(%s, Tok, Action, Value) :- actions%s(Tok, Action, Value). @@ -511,42 +522,40 @@ actions(%s, Tok, Action, Value) :- :- mode actions%s(in, out, out(state_no)) is semidet. ", - [s(SS), s(SS), s(SS), s(TT), s(SS)], - !IO), - write_state_actions(SS, End, StateActions, !IO) - ), Table, !IO). + [s(SS), s(SS), s(SS), s(TT), s(SS)], !IO), + write_state_actions(SS, End, StateActions, !IO) + ), Table, !IO). -:- pred write_state_actions(string, term, map(terminal, action), - io, io). -:- mode write_state_actions(in, in, in, di, uo) is det. +:- pred write_state_actions(string::in, term::in, map(terminal, action)::in, + io::di, io::uo) is det. write_state_actions(SS, End, StateActions, !IO) :- string.format("actions%s", [s(SS)], Name), - map.foldl((pred(Terminal::in, Action::in, !.IO::di, !:IO::uo) is det :- - terminal_to_term(Terminal, End, Token), - term.context_init(Ctxt), - Term = functor(atom(Name), - [Token, - functor(atom(Kind), [], Ctxt), - int_to_decimal_term(Val, Ctxt)], Ctxt), - ( - Action = shift(Val), - Kind = "shift" - ; - Action = reduce(Val), - Kind = "reduce" - ; - Action = accept, - Kind = "accept", - Val = 0 - ), - varset.init(Varset), - term_io.write_term_nl(Varset, Term, !IO) - ), StateActions, !IO), + map.foldl( + ( pred(Terminal::in, Action::in, !.IO::di, !:IO::uo) is det :- + terminal_to_term(Terminal, End, Token), + term.context_init(Ctxt), + Term = functor(atom(Name), + [Token, + functor(atom(Kind), [], Ctxt), + int_to_decimal_term(Val, Ctxt)], Ctxt), + ( + Action = shift(Val), + Kind = "shift" + ; + Action = reduce(Val), + Kind = "reduce" + ; + Action = accept, + Kind = "accept", + Val = 0 + ), + varset.init(Varset), + term_io.write_term_nl(Varset, Term, !IO) + ), StateActions, !IO), io.nl(!IO). -:- pred terminal_to_term(terminal, term, term). -:- mode terminal_to_term(in, in, out) is det. +:- pred terminal_to_term(terminal::in, term::in, term::out) is det. terminal_to_term(epsilon, _, _) :- error("terminal_to_term: unexpected epsilon"). @@ -554,18 +563,19 @@ terminal_to_term(Name/Arity, _, Term) :- varset.init(V0), varset.new_vars(Arity, Vars, V0, _), term.context_init(Ctxt), - list.map((pred(Var::in, T::out) is det :- - T = variable(Var, Ctxt) - ), Vars, Args), + list.map( + ( pred(Var::in, T::out) is det :- + T = variable(Var, Ctxt) + ), Vars, Args), Term = functor(atom(Name), Args, Ctxt). terminal_to_term(($), End, End). terminal_to_term((*), _, _) :- error("terminal_to_term: unexpected hash"). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_goto_table(gototable, rule_decls, io, io). -:- mode write_goto_table(in, in, di, uo) is det. +:- pred write_goto_table(goto_table::in, rule_decls::in, io::di, io::uo) + is det. write_goto_table(Table, DeclTable, !IO) :- map.values(DeclTable, Decls), @@ -575,9 +585,10 @@ write_goto_table(Table, DeclTable, !IO) :- :- mode gotos(in(state_no), in, out(state_no)) is semidet. ", !IO), - WriteGotos = (pred(State::in, Actions::in, !.IO::di, !:IO::uo) is det :- - string.format("0x%x", [i(State)], SS), - io.format("\ + WriteGotos = + ( pred(State::in, Actions::in, !.IO::di, !:IO::uo) is det :- + string.format("0x%x", [i(State)], SS), + io.format("\ gotos(%s, NT, NS) :- gotos%s(NT, NS). @@ -585,25 +596,25 @@ gotos(%s, NT, NS) :- :- mode gotos%s(in, out(state_no)) is semidet. ", - [s(SS), s(SS), s(SS), s(SS)], !IO), - write_state_gotos(SS, Actions, !IO) - ), + [s(SS), s(SS), s(SS), s(SS)], !IO), + write_state_gotos(SS, Actions, !IO) + ), map.foldl(WriteGotos, Table, !IO). -:- pred write_nonterminal_type(list(rule_decl), io, io). -:- mode write_nonterminal_type(in, di, uo) is det. +:- pred write_nonterminal_type(list(rule_decl)::in, io::di, io::uo) is det. write_nonterminal_type(Ds, !IO) :- - list.map((pred(Decl::in, NTType::out) is det :- - Decl = rule(NT, Args, _VS, TC), - ( - NT = start, - error("write_nonterminal_type: start!") - ; - NT = Name/_Arity - ), - NTType = functor(atom(Name), Args, TC) - ), Ds, NTTypes), + list.map( + ( pred(Decl::in, NTType::out) is det :- + Decl = rule(NT, Args, _VS, TC), + ( + NT = start, + error("write_nonterminal_type: start!") + ; + NT = Name/_Arity + ), + NTType = functor(atom(Name), Args, TC) + ), Ds, NTTypes), term.context_init(Ctxt), varset.init(Varset), Type = disj(functor(atom("nonterminal"), [], Ctxt), NTTypes), @@ -611,23 +622,23 @@ write_nonterminal_type(Ds, !IO) :- write_element(nolines, Element, !IO), io.nl(!IO). -:- pred write_state_gotos(string, map(nonterminal, grammar.state), io, io). -:- mode write_state_gotos(in, in, di, uo) is det. +:- pred write_state_gotos(string::in, map(nonterminal, grammar.state)::in, + io::di, io::uo) is det. write_state_gotos(SS, StateActions, !IO) :- string.format("gotos%s", [s(SS)], Name), - map.foldl((pred(NT::in, NS::in, !.IO::di, !:IO::uo) is det :- - nonterminal_to_term(NT, Token), - term.context_init(Ctxt), - Term = functor(atom(Name), - [Token, int_to_decimal_term(NS, Ctxt)], Ctxt), - varset.init(Varset), - term_io.write_term_nl(Varset, Term, !IO) - ), StateActions, !IO), + map.foldl( + ( pred(NT::in, NS::in, !.IO::di, !:IO::uo) is det :- + nonterminal_to_term(NT, Token), + term.context_init(Ctxt), + Term = functor(atom(Name), + [Token, int_to_decimal_term(NS, Ctxt)], Ctxt), + varset.init(Varset), + term_io.write_term_nl(Varset, Term, !IO) + ), StateActions, !IO), io.nl(!IO). -:- pred nonterminal_to_term(nonterminal, term). -:- mode nonterminal_to_term(in, out) is det. +:- pred nonterminal_to_term(nonterminal::in, term::out) is det. nonterminal_to_term(start, _) :- error("nonterminal_to_term: unexpected start"). @@ -635,16 +646,16 @@ nonterminal_to_term(Name/Arity, Term) :- varset.init(V0), varset.new_vars(Arity, Vars, V0, _), term.context_init(Ctxt), - list.map((pred(Var::in, T::out) is det :- - T = variable(Var, Ctxt) - ), Vars, Args), + list.map( + ( pred(Var::in, T::out) is det :- + T = variable(Var, Ctxt) + ), Vars, Args), Term = functor(atom(Name), Args, Ctxt). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_parser(whereami, nonterminal, rule_decl, string, string, string, - io, io). -:- mode write_parser(in, in, in, in, in, in, di, uo) is det. +:- pred write_parser(whereami::in, nonterminal::in, rule_decl::in, string::in, + string::in, string::in, io::di, io::uo) is det. write_parser(Where, NT, Decl, _TT, InAtom, OutAtom, !IO) :- ( @@ -663,10 +674,10 @@ write_parser(Where, NT, Decl, _TT, InAtom, OutAtom, !IO) :- OkayType = functor(atom(StartName), DeclArgs, DeclCtxt), ErrorType = functor(atom("error"), [ functor(atom("string"), [], Ctxt)], Ctxt), - ( Where = (interface) -> + ( if Where = (interface) then io.write_string(":- interface.\n\n", !IO) - ; - true + else + true ), write_element(nolines, ParseResultType, !IO), io.nl(!IO), @@ -677,10 +688,10 @@ write_parser(Where, NT, Decl, _TT, InAtom, OutAtom, !IO) :- ", [s(InAtom), s(OutAtom)], !IO), - ( Where = (interface) -> + ( if Where = (interface) then io.write_string(":- implementation.\n\n", !IO) - ; - true + else + true ), io.format("\ :- import_module list. @@ -693,15 +704,15 @@ parse(Result, Toks0, Toks) :- parse(Toks0, Toks, St0, Sy0, Res) :- ( - St0 = [S0|_], + St0 = [S0 | _], get_token(Tok, Toks0, Toks1), - ( + ( actions(S0, Tok, What, Val) -> ( What = shift, - Sy1 = [t(Tok)|Sy0], - St1 = [Val|St0], + Sy1 = [t(Tok) | Sy0], + St1 = [Val | St0], parse(Toks1, Toks, St1, Sy1, Res) ; What = reduce, @@ -711,12 +722,11 @@ parse(Toks0, Toks, St0, Sy0, Res) :- ; What = accept, ( Sy0 = [n(", - [s(InAtom), s(OutAtom)], - !IO), - term_io.write_term(Varset, StartTerm, !IO), - io.write_string(")] -> + [s(InAtom), s(OutAtom)], !IO), + term_io.write_term(Varset, StartTerm, !IO), + io.write_string(")] -> Res = (", - !IO), + !IO), term_io.write_term(Varset, StartTerm, !IO), io.write_string("), Toks = Toks1 @@ -733,15 +743,15 @@ parse(Toks0, Toks, St0, Sy0, Res) :- error(""parse: state stack underflow"") ). ", - !IO). + !IO). -:- pred mkstartargs(int, list(term), list(term), varset, varset). -:- mode mkstartargs(in, in, out, in, out) is det. +:- pred mkstartargs(int::in, list(term)::in, list(term)::out, + varset::in, varset::out) is det. mkstartargs(N, !Terms, !Varset) :- - ( N =< 0 -> + ( if N =< 0 then true - ; + else string.format("V%d", [i(N)], VarName), varset.new_named_var(VarName, Var, !Varset), Term = term.variable(Var, context_init), @@ -749,11 +759,10 @@ mkstartargs(N, !Terms, !Varset) :- mkstartargs(N - 1, !Terms, !Varset) ). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred write_reductions(rules, actiontable, string, string, string, xforms, - io, io). -:- mode write_reductions(in, in, in, in, in, in, di, uo) is det. +:- pred write_reductions(rules::in, action_table::in, string::in, + string::in, string::in, xforms::in, io::di, io::uo) is det. write_reductions(Rules, Table, TT, InAtom, OutAtom, Xfns, !IO) :- io.format("\ @@ -766,8 +775,7 @@ write_reductions(Rules, Table, TT, InAtom, OutAtom, Xfns, !IO) :- ; t(%s). ", - [s(TT)], - !IO), + [s(TT)], !IO), io.format(" :- pred reduce(int, statestack, statestack, symbolstack, symbolstack, P, P) <= parser_state(P). @@ -778,10 +786,10 @@ reduce(RuleNum, States0, States, Symbols0, Symbols, Tokens0, Tokens) :- reduce0(RuleNum, States0, States1, Symbols0, Symbols1, Tokens0, Tokens1), ( - States1 = [State0|_States2], - Symbols1 = [n(Non)|_], + States1 = [State0 | _States2], + Symbols1 = [n(Non) | _], gotos(State0, Non, State1), - States3 = [State1|States1] + States3 = [State1 | States1] -> States = States3, Symbols = Symbols1, @@ -791,8 +799,7 @@ reduce(RuleNum, States0, States, Symbols0, Symbols, Tokens0, Tokens) :- ). ", - [s(InAtom), s(OutAtom)], - !IO), + [s(InAtom), s(OutAtom)], !IO), io.format("\ :- pred reduce0(int, statestack, statestack, symbolstack, symbolstack, P, P) <= parser_state(P). @@ -800,23 +807,20 @@ reduce(RuleNum, States0, States, Symbols0, Symbols, Tokens0, Tokens) :- in, out, %s, %s) is det. ", - [s(InAtom), s(OutAtom)], - !IO), - map.foldl((pred(Rn::in, Rule::in, !.IO::di, !:IO::uo) is det :- - ( Rn = 0 -> - - io.write_string("\ + [s(InAtom), s(OutAtom)], !IO), + map.foldl( + ( pred(Rn::in, Rule::in, !.IO::di, !:IO::uo) is det :- + ( if Rn = 0 then + io.write_string("\ reduce0(0x0, _, _, _, _, _, _) :- reduce0_error(0x0). ", - !IO) - - ; - - RedName = string.format("reduce0x%x", [i(Rn)]), - RnS = string.format("0x%x", [i(Rn)]), - io.format("\ + !IO) + else + RedName = string.format("reduce0x%x", [i(Rn)]), + RnS = string.format("0x%x", [i(Rn)]), + io.format("\ reduce0(%s, S0, S, T0, T, U0, U) :- %s(S0, S, T0, T, U0, U). @@ -824,105 +828,105 @@ reduce0(%s, S0, S, T0, T, U0, U) :- P, P) <= parser_state(P). :- mode %s(in(state_nos), out(state_nos), in, out, %s, %s) is det. ", - [s(RnS), s(RedName), s(RedName), s(RedName), - s(InAtom), s(OutAtom)], - !IO), - Rule = rule(RNt, Head, _, Body, Actions, Varset0, _C), - term.context_init(Ctxt), - varset.new_named_var("M_St0", St0v, Varset0, Varset1), - St0 = variable(St0v, Ctxt), - varset.new_named_var("M_St1", St1v, Varset1, Varset2), - St1 = variable(St1v, Ctxt), - varset.new_named_var("M_Sy0", Sy0v, Varset2, Varset3), - Sy0 = variable(Sy0v, Ctxt), - varset.new_named_var("M_Sy1", Sy1v, Varset3, Varset4), - Sy1 = variable(Sy1v, Ctxt), - varset.new_named_var("M_RedRes", Resv, Varset4, Varset5), - Res = variable(Resv, Ctxt), - ResS = functor(atom("n"), [variable(Resv, Ctxt)], Ctxt), - varset.new_named_var("M_D", Dv, Varset5, Varset6), - _D = variable(Dv, Ctxt), - varset.new_named_var("M_S", Sv, Varset6, Varset7), - _S = variable(Sv, Ctxt), - varset.new_named_var("M_St", Stv, Varset7, Varset8), - St = variable(Stv, Ctxt), - varset.new_named_var("M_Sy", Syv, Varset8, Varset9), - Sy = variable(Syv, Ctxt), - varset.new_named_var("M_Ts0", Ts0v, Varset9, Varset10), - Ts0 = variable(Ts0v, Ctxt), - varset.new_named_var("M_Ts", Tsv, Varset10, Varset11), - Ts = variable(Tsv, Ctxt), - string.format("reduction 0x%x failed!", [i(Rn)], Err), - mkstacks(Body, St1, Sts, Sy1, Sys, Varset11, Varset12), - Cond = functor(atom(","), [ - functor(atom("="), [St0, Sts], Ctxt), - functor(atom("="), [Sy0, Sys], Ctxt) - ], Ctxt), - Red = functor(atom("="), [Res, Head], Ctxt), - list.append(Actions, [Red], AllActions0), - list.reverse(AllActions0, AllActions), - ConsStack = functor(atom(","), [ - functor(atom("="), [Sy, functor(atom("[|]"), - [ResS, Sy1], Ctxt)], Ctxt), - functor(atom("="), [St, St1], Ctxt)], Ctxt), - mkactions(AllActions, ConsStack, Then0), - ( - map.search(Xfns, RNt, xform(_, XFormName)), - Head = functor(_, HeadArgs, _) - -> - list.append(HeadArgs, [Ts0], Then1Args), - XFTerm = functor(atom(XFormName), Then1Args, Ctxt) - ; - XFTerm = Ts0 - ), - Then1 = functor(atom("="), [Ts, XFTerm], Ctxt), - Then = functor(atom(","), [Then0, Then1], Ctxt), - BodyTerm = functor(atom(";"),[ - functor(atom("->"), [ - Cond, - Then - ], Ctxt), - functor(atom("error"), - [functor(string(Err), [], Ctxt)], - Ctxt - )], Ctxt), - ( term_to_goal(BodyTerm, Goal0) -> - Goal = Goal0 - ; - error("write_reductions: failed to convert goal") - ), - Clause = clause( - functor(atom(RedName), [St0, St, Sy0, Sy, Ts0, Ts], - Ctxt), - Goal, Varset12), - write_element(lines, Clause, !IO), - io.nl(!IO) - ) - ), Rules, !IO), - WriteReduceError = (pred(State::in, _::in, !.IO::di, !:IO::uo) is det :- - ( if not map.contains(Rules, State) - then + [s(RnS), s(RedName), s(RedName), s(RedName), + s(InAtom), s(OutAtom)], !IO), + Rule = rule(RNt, Head, _, Body, Actions, Varset0, _C), + term.context_init(Ctxt), + varset.new_named_var("M_St0", St0v, Varset0, Varset1), + St0 = variable(St0v, Ctxt), + varset.new_named_var("M_St1", St1v, Varset1, Varset2), + St1 = variable(St1v, Ctxt), + varset.new_named_var("M_Sy0", Sy0v, Varset2, Varset3), + Sy0 = variable(Sy0v, Ctxt), + varset.new_named_var("M_Sy1", Sy1v, Varset3, Varset4), + Sy1 = variable(Sy1v, Ctxt), + varset.new_named_var("M_RedRes", Resv, Varset4, Varset5), + Res = variable(Resv, Ctxt), + ResS = functor(atom("n"), [variable(Resv, Ctxt)], Ctxt), + varset.new_named_var("M_D", Dv, Varset5, Varset6), + _D = variable(Dv, Ctxt), + varset.new_named_var("M_S", Sv, Varset6, Varset7), + _S = variable(Sv, Ctxt), + varset.new_named_var("M_St", Stv, Varset7, Varset8), + St = variable(Stv, Ctxt), + varset.new_named_var("M_Sy", Syv, Varset8, Varset9), + Sy = variable(Syv, Ctxt), + varset.new_named_var("M_Ts0", Ts0v, Varset9, Varset10), + Ts0 = variable(Ts0v, Ctxt), + varset.new_named_var("M_Ts", Tsv, Varset10, Varset11), + Ts = variable(Tsv, Ctxt), + string.format("reduction 0x%x failed!", [i(Rn)], Err), + mkstacks(Body, St1, Sts, Sy1, Sys, Varset11, Varset12), + Cond = functor(atom(","), [ + functor(atom("="), [St0, Sts], Ctxt), + functor(atom("="), [Sy0, Sys], Ctxt) + ], Ctxt), + Red = functor(atom("="), [Res, Head], Ctxt), + list.append(Actions, [Red], AllActions0), + list.reverse(AllActions0, AllActions), + ConsStack = functor(atom(","), [ + functor(atom("="), [Sy, functor(atom("[|]"), + [ResS, Sy1], Ctxt)], Ctxt), + functor(atom("="), [St, St1], Ctxt)], Ctxt), + mkactions(AllActions, ConsStack, Then0), + ( if + map.search(Xfns, RNt, xform(_, XFormName)), + Head = functor(_, HeadArgs, _) + then + list.append(HeadArgs, [Ts0], Then1Args), + XFTerm = functor(atom(XFormName), Then1Args, Ctxt) + else + XFTerm = Ts0 + ), + Then1 = functor(atom("="), [Ts, XFTerm], Ctxt), + Then = functor(atom(","), [Then0, Then1], Ctxt), + BodyTerm = functor(atom(";"), [ + functor(atom("->"), [ + Cond, + Then + ], Ctxt), + functor(atom("error"), + [functor(string(Err), [], Ctxt)], + Ctxt + )], Ctxt), + ( if term_to_goal(BodyTerm, Goal0) then + Goal = Goal0 + else + error("write_reductions: failed to convert goal") + ), + Clause = clause( + functor(atom(RedName), [St0, St, Sy0, Sy, Ts0, Ts], Ctxt), + Goal, Varset12), + write_element(lines, Clause, !IO), + io.nl(!IO) + ) + ), Rules, !IO), + WriteReduceError = + ( pred(State::in, _::in, !.IO::di, !:IO::uo) is det :- + ( if map.contains(Rules, State) then + true + else io.format("\ reduce0(0x%x, _, _, _, _, _, _) :- reduce0_error(0x%x). -", - [i(State), i(State)], !IO) - else true - ) - ), +", + [i(State), i(State)], !IO) + ) + ), map.foldl(WriteReduceError, Table, !IO), - io.format("\ + io.write_string("\ :- pred reduce0_error(int). :- mode reduce0_error(in) is erroneous. reduce0_error(State) :- error(string.format(""reduce in state 0x%%x"", [i(State)])). -", [], !IO). +", + !IO). -:- pred mkstacks(list(bodyterm), term, term, term, term, varset, varset). -:- mode mkstacks(in, in, out, in, out, in, out) is det. +:- pred mkstacks(list(bodyterm)::in, term::in, term::out, term::in, term::out, + varset::in, varset::out) is det. mkstacks([], !St, !Sy, !VS). mkstacks([E0 | Es], !St, !Sy, !VS) :- @@ -939,8 +943,7 @@ mkstacks([E0 | Es], !St, !Sy, !VS) :- !:St = functor(atom("[|]"), [variable(U, Ctxt), !.St], Ctxt), mkstacks(Es, !St, !Sy, !VS). -:- pred mkactions(list(term), term, term). -:- mode mkactions(in, in, out) is det. +:- pred mkactions(list(term)::in, term::in, term::out) is det. mkactions([], !Term). mkactions([E | Es], !Term) :- @@ -948,14 +951,13 @@ mkactions([E | Es], !Term) :- !:Term = functor(atom(","), [E, !.Term], Ctxt), mkactions(Es, !Term). -%------------------------------------------------------------------------------% +%---------------------------------------------------------------------------% -:- pred sub(string, list(pair(string)), string). -:- mode sub(in, in, out) is det. +:- pred sub(string::in, list(pair(string))::in, string::out) is det. sub(Orig, Subs, Final) :- - list.foldl((pred(Sub::in, S0::in, S1::out) is det :- - Sub = From - To, - string.replace_all(S0, From, To, S1) - ), Subs, Orig, Final). - + list.foldl( + ( pred(Sub::in, S0::in, S1::out) is det :- + Sub = From - To, + string.replace_all(S0, From, To, S1) + ), Subs, Orig, Final). diff --git a/extras/moose/options.m b/extras/moose/options.m index 7826b6bb9..746997a6c 100644 --- a/extras/moose/options.m +++ b/extras/moose/options.m @@ -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. -%----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% diff --git a/extras/moose/tables.m b/extras/moose/tables.m index 3d7b1ab53..c2b37e74c 100644 --- a/extras/moose/tables.m +++ b/extras/moose/tables.m @@ -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). diff --git a/tests/valid_make_int/bug499.m b/tests/valid_make_int/bug499.m index 89b59d04b..6a659ef63 100644 --- a/tests/valid_make_int/bug499.m +++ b/tests/valid_make_int/bug499.m @@ -1,6 +1,6 @@ -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- module bug499. :- interface.