mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-08 10:23:03 +00:00
964 lines
32 KiB
Mathematica
964 lines
32 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% 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.
|
|
%
|
|
% Original author: Tom Conway <conway@cs.mu.oz.au>
|
|
% Extensions: Ralph Becket <rafe@cs.mu.oz.au>
|
|
%
|
|
% 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.
|
|
|
|
:- import_module check.
|
|
:- import_module grammar.
|
|
:- import_module lalr.
|
|
:- import_module mercury_syntax.
|
|
:- import_module options.
|
|
:- import_module tables.
|
|
|
|
:- import_module array.
|
|
:- import_module bool.
|
|
:- import_module getopt.
|
|
:- import_module int.
|
|
:- import_module integer.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- 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(!IO)
|
|
;
|
|
Help = no,
|
|
main2(Options, Args, !IO)
|
|
)
|
|
;
|
|
MOptions = error(String),
|
|
report_critical_error(String, !IO)
|
|
).
|
|
|
|
:- pred report_critical_error(string::in, io::di, io::uo) is det.
|
|
|
|
report_critical_error(Message, !IO) :-
|
|
io.stderr_stream(StdErr, !IO),
|
|
io.write_string(StdErr, Message, !IO),
|
|
io.nl(StdErr, !IO),
|
|
io.set_exit_status(1, !IO).
|
|
|
|
:- pred main2(options::in, list(string)::in, io::di, io::uo).
|
|
|
|
main2(_Options, [], !IO) :-
|
|
report_critical_error("no input files.", !IO),
|
|
help(!IO).
|
|
main2(Options, [Name0 | Names], !IO) :-
|
|
figure_out_names(Name0, InName, OutName),
|
|
io.see(InName, Res0, !IO),
|
|
(
|
|
Res0 = ok,
|
|
io.tell(OutName, Res1, !IO),
|
|
(
|
|
Res1 = ok,
|
|
process(Options, !IO),
|
|
io.told(!IO)
|
|
;
|
|
Res1 = error(Err),
|
|
io.error_message(Err, Msg),
|
|
report_critical_error(Msg, !IO)
|
|
)
|
|
;
|
|
Res0 = error(Err),
|
|
io.error_message(Err, Msg),
|
|
report_critical_error(Msg, !IO)
|
|
),
|
|
(
|
|
Names = [_ | _],
|
|
main2(Options, Names, !IO)
|
|
;
|
|
Names = []
|
|
).
|
|
|
|
:- pred figure_out_names(string::in, string::out, string::out) is det.
|
|
|
|
figure_out_names(Name0, InName, OutName) :-
|
|
( 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).
|
|
|
|
:- 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.
|
|
).
|
|
|
|
:- pred process(options::in, io.state::di, io.state::uo) is det.
|
|
|
|
process(Options, !IO) :-
|
|
lookup_bool_option(Options, verbose, Verbose),
|
|
(
|
|
Verbose = yes,
|
|
report_stats(!IO)
|
|
;
|
|
Verbose = no
|
|
),
|
|
read_module(Result, !IO),
|
|
Result = module(Module, 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),
|
|
io.set_exit_status(1, !IO)
|
|
;
|
|
Errors = [],
|
|
get_moose_elements(Module, [], Remainder0, (implementation),
|
|
[], 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)
|
|
;
|
|
MParser = [_, _ | _],
|
|
report_critical_error("error: more than one parse/4 declaration.",
|
|
!IO)
|
|
)
|
|
).
|
|
|
|
:- 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, Verbose),
|
|
(
|
|
Verbose = yes,
|
|
report_stats(!IO)
|
|
;
|
|
Verbose = no
|
|
),
|
|
|
|
check_rule_decls(Decls0, Decls, DeclErrors),
|
|
list.foldl(write_error, DeclErrors, !IO),
|
|
|
|
check_clauses(Clauses0, Decls, Clauses, ClauseErrors),
|
|
list.foldl(write_error, ClauseErrors, !IO),
|
|
|
|
Parser = parser(WhereAmI, StartId, EndTerm, TokenType, _Prefix, InAtom,
|
|
OutAtom),
|
|
|
|
check_useless(StartId, Clauses, Decls, UselessErrors),
|
|
list.foldl(write_error, UselessErrors, !IO),
|
|
|
|
check_inf_derivations(Clauses, Decls, InfErrors),
|
|
list.foldl(write_error, InfErrors, !IO),
|
|
|
|
( if
|
|
DeclErrors = [],
|
|
ClauseErrors = [],
|
|
UselessErrors = [],
|
|
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),
|
|
|
|
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),
|
|
|
|
construct_grammar(StartId, Clauses, XForms, Grammar),
|
|
Grammar = grammar(Rules, _, Xfns, _, Index, First, _Follow),
|
|
reaching(Rules, First, Reaching),
|
|
|
|
io.write_string(StdErr, "constructing lr(0) items...\n", !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),
|
|
shifts(C, Rules, First, Reaching, Shifts),
|
|
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,
|
|
(
|
|
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)
|
|
)
|
|
), 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,
|
|
OutAtom, Xfns, !IO)
|
|
else
|
|
% XXX: What is this condition? Should an exception be thrown here?!?
|
|
io.set_exit_status(1, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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) :-
|
|
( Where = (interface) ->
|
|
io.write_string(":- interface.\n\n", !IO)
|
|
;
|
|
true
|
|
),
|
|
io.format("\
|
|
:- typeclass parser_state(T) where [
|
|
pred get_token(%s, T, T),
|
|
mode get_token(out, %s, %s) is det,
|
|
func unget_token(%s, T) = T,
|
|
mode unget_token(in, %s) = %s is det\
|
|
",
|
|
[s(TokenType), s(InAtom), s(OutAtom),
|
|
s(TokenType), s(InAtom), s(OutAtom)], !IO),
|
|
(
|
|
XForms = [_ | _],
|
|
io.write_string(",\n", !IO)
|
|
;
|
|
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),
|
|
|
|
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),
|
|
( if Where = (interface) then
|
|
io.write_string(":- implementation.\n\n", !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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_string(Stream, ": ", !IO),
|
|
Rule = rule(NT, _, Syms, _, _, _, _),
|
|
io.write(Stream, NT, !IO),
|
|
io.write_string(Stream, " ->\t", !IO),
|
|
write_syms(Stream, 0, 999, Syms, !IO),
|
|
io.write_string(Stream, "\n", !IO).
|
|
|
|
:- 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) :-
|
|
( if N = Dot then
|
|
io.write_string(Stream, ". ", !IO)
|
|
else
|
|
true
|
|
),
|
|
array.max(Syms, 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)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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) :-
|
|
( 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)
|
|
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).
|
|
|
|
:- pred interface_term(term::in) is semidet.
|
|
|
|
interface_term(functor(atom(":-"), [functor(atom("interface"), [], _)], _)).
|
|
|
|
:- pred implementation_term(term::in) is semidet.
|
|
|
|
implementation_term(functor(atom(":-"),
|
|
[functor(atom("implementation"), [], _)], _)).
|
|
|
|
:- pred rule_term(term::in, varset::in, rule_decl::out) is semidet.
|
|
|
|
rule_term(functor(atom(":-"), [functor(atom("rule"), [RuleTerm], _)], _),
|
|
VarSet, Decl) :-
|
|
RuleTerm = functor(atom(Name), Args, Context),
|
|
list.length(Args, Arity),
|
|
Decl = rule(Name/Arity, Args, VarSet, Context).
|
|
|
|
:- pred parser_term(term::in, varset::in, whereami::in, parser::out)
|
|
is semidet.
|
|
|
|
parser_term(functor(atom(":-"), [functor(atom("parse"), Args, _)], _),
|
|
_VarSet, WhereAmI, Decl) :-
|
|
Args = [StartIdTerm, TokTerm, EndTerm, PrefixTerm, InAtomTerm,
|
|
OutAtomTerm],
|
|
StartIdTerm = functor(atom("/"), [functor(atom(Name), [], _),
|
|
functor(integer(base_10, ArityInteger, signed, size_word), _, _)], _),
|
|
integer.to_int(ArityInteger, Arity),
|
|
StartId = Name / Arity,
|
|
TokTerm = functor(atom(TokAtom), [], _),
|
|
PrefixTerm = functor(atom(PrefixAtom), [], _),
|
|
InAtomTerm = functor(atom(InAtom), [], _),
|
|
OutAtomTerm = functor(atom(OutAtom), [], _),
|
|
Decl = parser(WhereAmI, StartId, EndTerm, TokAtom, PrefixAtom, InAtom,
|
|
OutAtom).
|
|
|
|
:- pred xform_term(term::in, xform::out) is semidet.
|
|
|
|
xform_term(Term, XForm) :-
|
|
Term = functor(atom(":-"), [
|
|
functor(atom("action"), [
|
|
functor(atom("/"), [
|
|
functor(atom(Name), [], _),
|
|
functor(integer(base_10, ArityInteger, signed, size_word), _, _)
|
|
], _),
|
|
functor(atom(Pred), [], _)
|
|
], _)
|
|
], _),
|
|
integer.to_int(ArityInteger, Arity),
|
|
XForm = xform(Name/Arity, Pred).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred help(io::di, io::uo) is det.
|
|
|
|
help(!IO) :-
|
|
io.stderr_stream(StdErr, !IO),
|
|
io.write_string(StdErr, "\
|
|
usage: moose <options> file ...
|
|
-h|--help help
|
|
-a|--dump-action dump the action table
|
|
-f|--dump-first dump the FIRST sets
|
|
-a|--dump-follow dump the FOLLOW sets
|
|
-a|--dump-goto dump the goto table
|
|
-a|--dump-items dump the item sets
|
|
-a|--dump-rules dump the flattened rules
|
|
", !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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),
|
|
io.write_list(map.keys(Table), "\n\t;\t", io.write_int, !IO),
|
|
io.format(".\n:- inst state_nos == list_skel(state_no).\n\n", [], !IO),
|
|
io.format("\
|
|
:- type parsing_action
|
|
---> shift
|
|
; reduce
|
|
; accept.
|
|
|
|
:- pred actions(int, %s, parsing_action, int).
|
|
:- mode actions(in(state_no), in, out, out(state_no)) is semidet.
|
|
|
|
",
|
|
[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("\
|
|
actions(%s, Tok, Action, Value) :-
|
|
actions%s(Tok, Action, Value).
|
|
|
|
:- pred actions%s(%s, parsing_action, int).
|
|
:- 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).
|
|
|
|
:- 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),
|
|
io.nl(!IO).
|
|
|
|
:- pred terminal_to_term(terminal::in, term::in, term::out) is det.
|
|
|
|
terminal_to_term(epsilon, _, _) :-
|
|
error("terminal_to_term: unexpected epsilon").
|
|
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),
|
|
Term = functor(atom(Name), Args, Ctxt).
|
|
terminal_to_term(($), End, End).
|
|
terminal_to_term((*), _, _) :-
|
|
error("terminal_to_term: unexpected hash").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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),
|
|
write_nonterminal_type(Decls, !IO),
|
|
io.write_string("\
|
|
:- pred gotos(int, nonterminal, int).
|
|
:- 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("\
|
|
gotos(%s, NT, NS) :-
|
|
gotos%s(NT, NS).
|
|
|
|
:- pred gotos%s(nonterminal, int).
|
|
:- mode gotos%s(in, out(state_no)) is semidet.
|
|
|
|
",
|
|
[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)::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),
|
|
term.context_init(Ctxt),
|
|
varset.init(Varset),
|
|
Type = disj(functor(atom("nonterminal"), [], Ctxt), NTTypes),
|
|
Element = type(Type, Varset),
|
|
write_element(nolines, Element, !IO),
|
|
io.nl(!IO).
|
|
|
|
:- 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),
|
|
io.nl(!IO).
|
|
|
|
:- pred nonterminal_to_term(nonterminal::in, term::out) is det.
|
|
|
|
nonterminal_to_term(start, _) :-
|
|
error("nonterminal_to_term: unexpected start").
|
|
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),
|
|
Term = functor(atom(Name), Args, Ctxt).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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) :-
|
|
(
|
|
NT = StartName/StartArity
|
|
;
|
|
NT = start,
|
|
error("write_parser: start!")
|
|
),
|
|
Decl = rule(_, DeclArgs, DeclVarset, DeclCtxt),
|
|
varset.init(Varset0),
|
|
mkstartargs(StartArity, [], StartArgs, Varset0, Varset),
|
|
StartTerm = functor(atom(StartName), StartArgs, Ctxt),
|
|
term.context_init(Ctxt),
|
|
ParseResultType = type(disj(functor(atom("parse_result"), [], Ctxt),
|
|
[OkayType, ErrorType]), DeclVarset),
|
|
OkayType = functor(atom(StartName), DeclArgs, DeclCtxt),
|
|
ErrorType = functor(atom("error"), [
|
|
functor(atom("string"), [], Ctxt)], Ctxt),
|
|
( if Where = (interface) then
|
|
io.write_string(":- interface.\n\n", !IO)
|
|
else
|
|
true
|
|
),
|
|
write_element(nolines, ParseResultType, !IO),
|
|
io.nl(!IO),
|
|
io.format("\
|
|
:- pred parse(parse_result, P, P) <= parser_state(P).
|
|
:- mode parse(out, %s, %s) is det.
|
|
|
|
",
|
|
[s(InAtom), s(OutAtom)],
|
|
!IO),
|
|
( if Where = (interface) then
|
|
io.write_string(":- implementation.\n\n", !IO)
|
|
else
|
|
true
|
|
),
|
|
io.format("\
|
|
:- import_module list.
|
|
|
|
parse(Result, Toks0, Toks) :-
|
|
parse(Toks0, Toks, [0], [], Result).
|
|
|
|
:- pred parse(P, P, statestack, symbolstack, parse_result) <= parser_state(P).
|
|
:- mode parse(%s, %s, in(state_nos), in, out) is det.
|
|
|
|
parse(Toks0, Toks, St0, Sy0, Res) :-
|
|
(
|
|
St0 = [S0 | _],
|
|
get_token(Tok, Toks0, Toks1),
|
|
(
|
|
actions(S0, Tok, What, Val)
|
|
->
|
|
(
|
|
What = shift,
|
|
Sy1 = [t(Tok) | Sy0],
|
|
St1 = [Val | St0],
|
|
parse(Toks1, Toks, St1, Sy1, Res)
|
|
;
|
|
What = reduce,
|
|
Toks2 = unget_token(Tok, Toks1),
|
|
reduce(Val, St0, St1, Sy0, Sy1, Toks2, Toks3),
|
|
parse(Toks3, Toks, St1, Sy1, Res)
|
|
;
|
|
What = accept,
|
|
( Sy0 = [n(",
|
|
[s(InAtom), s(OutAtom)], !IO),
|
|
term_io.write_term(Varset, StartTerm, !IO),
|
|
io.write_string(")] ->
|
|
Res = (",
|
|
!IO),
|
|
term_io.write_term(Varset, StartTerm, !IO),
|
|
io.write_string("),
|
|
Toks = Toks1
|
|
;
|
|
error(""parse: internal accept error"")
|
|
)
|
|
)
|
|
;
|
|
Res = error(""parse error""),
|
|
Toks = unget_token(Tok, Toks1)
|
|
)
|
|
;
|
|
St0 = [],
|
|
error(""parse: state stack underflow"")
|
|
).
|
|
",
|
|
!IO).
|
|
|
|
:- pred mkstartargs(int::in, list(term)::in, list(term)::out,
|
|
varset::in, varset::out) is det.
|
|
|
|
mkstartargs(N, !Terms, !Varset) :-
|
|
( 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),
|
|
list.append([Term], !Terms),
|
|
mkstartargs(N - 1, !Terms, !Varset)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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("\
|
|
:- import_module require, std_util.
|
|
|
|
:- type statestack == list(int).
|
|
:- type symbolstack == list(stacksymbol).
|
|
:- type stacksymbol
|
|
---> n(nonterminal)
|
|
; t(%s).
|
|
|
|
",
|
|
[s(TT)], !IO),
|
|
io.format("
|
|
:- pred reduce(int, statestack, statestack,
|
|
symbolstack, symbolstack, P, P) <= parser_state(P).
|
|
:- mode reduce(in(state_no), in(state_nos), out(state_nos),
|
|
in, out, %s, %s) is det.
|
|
|
|
reduce(RuleNum, States0, States, Symbols0, Symbols, Tokens0, Tokens) :-
|
|
reduce0(RuleNum, States0, States1, Symbols0, Symbols1,
|
|
Tokens0, Tokens1),
|
|
(
|
|
States1 = [State0 | _States2],
|
|
Symbols1 = [n(Non) | _],
|
|
gotos(State0, Non, State1),
|
|
States3 = [State1 | States1]
|
|
->
|
|
States = States3,
|
|
Symbols = Symbols1,
|
|
Tokens = Tokens1
|
|
;
|
|
error(""reduce: reduction failed"")
|
|
).
|
|
|
|
",
|
|
[s(InAtom), s(OutAtom)], !IO),
|
|
io.format("\
|
|
:- pred reduce0(int, statestack, statestack,
|
|
symbolstack, symbolstack, P, P) <= parser_state(P).
|
|
:- mode reduce0(in(state_no), in(state_nos), out(state_nos),
|
|
in, out, %s, %s) is det.
|
|
|
|
",
|
|
[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)
|
|
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).
|
|
|
|
:- pred %s(statestack, statestack, symbolstack, symbolstack,
|
|
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),
|
|
( 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)
|
|
)
|
|
),
|
|
map.foldl(WriteReduceError, Table, !IO),
|
|
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).
|
|
|
|
:- 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) :-
|
|
varset.new_var(U, !VS),
|
|
term.context_init(Ctxt),
|
|
(
|
|
E0 = terminal(ET),
|
|
E = functor(atom("t"), [ET], Ctxt)
|
|
;
|
|
E0 = nonterminal(EN),
|
|
E = functor(atom("n"), [EN], Ctxt)
|
|
),
|
|
!:Sy = functor(atom("[|]"), [E, !.Sy], Ctxt),
|
|
!:St = functor(atom("[|]"), [variable(U, Ctxt), !.St], Ctxt),
|
|
mkstacks(Es, !St, !Sy, !VS).
|
|
|
|
:- pred mkactions(list(term)::in, term::in, term::out) is det.
|
|
|
|
mkactions([], !Term).
|
|
mkactions([E | Es], !Term) :-
|
|
term.context_init(Ctxt),
|
|
!:Term = functor(atom(","), [E, !.Term], Ctxt),
|
|
mkactions(Es, !Term).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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).
|