[m-dev.] for review: Add "moose" to extras.
Tyson Dowd
trd at cs.mu.OZ.AU
Fri May 19 17:03:19 AEST 2000
Hi,
Tom has written a parser generator for Mercury called "moose".
I recently used this to implement a parser for all of C, and it works
pretty well.
I added some code to generalize the "actions" -- each action now
generates a type class method in the parser_state type class.
One method must be provided in every parser_state, and that is the
"get_token" method. This way you can pass a parser state along that is
as complicated as you like, just make it an instance of the type
class. Also you can re-use the same parser with different instances of
parser_state to do different tasks.
Everything else is Tom's work. Outstanding issues before I commit:
- licensing (GPL I guess, but it's polite to ask first)
- finding out how much time Tom spent on this.
- is the TODO document up-to-date
If anyone feels like reviewing this:
There is no documentation and almost no comments in the code.
However most of it is similar to the LR parser stuff in the Dragon book.
There are some examples. I have a C parser that I will add to extras
soon, it will probably provide a pretty good example of what you can do
with this system. I don't intend to write documentation or add comments
to the code.
===================================================================
Estimated hours taken: 5 (+ unknown hours by Tom)
Add moose, the Mercury parser generator.
extras/moose/Mmakefile:
extras/moose/check.m:
extras/moose/grammar.m:
extras/moose/lalr.m:
extras/moose/mercury.m:
extras/moose/misc.m:
extras/moose/moose.m:
extras/moose/options.m:
extras/moose/tables.m:
Moose.
extras/moose/BUGS:
A list of known bugs.
extras/moose/TODO:
Things that still need to be done.
extras/moose/samples/Mmakefile:
extras/moose/samples/README:
extras/moose/samples/alpha.input:
extras/moose/samples/alpha.moo:
extras/moose/samples/cgram.moo:
extras/moose/samples/expr.input:
extras/moose/samples/expr.moo:
extras/moose/samples/small.moo:
extras/moose/samples/try_alpha.m:
extras/moose/samples/try_expr.m:
Some samples (which form the only real documentation for moose
at this time).
Index: BUGS
===================================================================
RCS file: BUGS
diff -N BUGS
--- /dev/null Tue May 16 14:50:59 2000
+++ BUGS Thu May 18 23:02:30 2000
@@ -0,0 +1,11 @@
+
+Doesn't give good error messages if :- action is used but the rule
+doesn't exist.
+
+Doesn't give good error messages for misplaced semicolons.
+
+ :- rule init_declarator(init_declarator).
+ init_declarator(init_declarator(D, Init)) --->
+ declarator(D) ; { Init = no }.
+
+
Index: Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null Tue May 16 14:50:59 2000
+++ Mmakefile Thu May 18 23:02:30 2000
@@ -0,0 +1,10 @@
+# GRADE = asm_fast.gc.debug
+# GRADE = asm_fast.gc.prof
+
+# MCFLAGS = -O6
+# MCFLAGS = --intermodule-optimization -O6
+
+default_target : moose
+
+depend : moose.depend
+
Index: TODO
===================================================================
RCS file: TODO
diff -N TODO
--- /dev/null Tue May 16 14:50:59 2000
+++ TODO Thu May 18 23:02:30 2000
@@ -0,0 +1,28 @@
+To make moose useful:
+ - use fact tables or at least split the action table into
+ separate shift and reduce tables so that the Mercury compiler
+ doesn't choke.
+
+ - construct canonical LR or LALR tables rather than SLR tables.
+
+Cosmetic improvements:
+ - handle errors in the input better by faking declarations for
+ undeclared productions; faking a clause for declared nonterminals
+ with no clauses ; faking declarations and a clause (eg A -> epsilon)
+ for nonterminals that get used but have no clauses and no
+ declaration.
+
+ - provide the ability to dump a list of the terminal symbols.
+
+ - make the various dumps go to files other than the .m file.
+
+Wish list:
+ - introduce new nonterminals for disjunctions in productions.
+ This is quite difficult because it requres correct computation
+ of the nonlocal variables of goals (including all the nasty
+ cases like pred expressions).
+
+ - Implement the groovey PDA algorithms suggested by Andrew.
+
+ - compile away the tables.
+
Index: check.m
===================================================================
RCS file: check.m
diff -N check.m
--- /dev/null Tue May 16 14:50:59 2000
+++ check.m Sat May 6 18:29:00 2000
@@ -0,0 +1,307 @@
+%------------------------------------------------------------------------------%
+%
+% file: check.m
+% 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.
+%
+% 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.
+
+:- import_module grammar.
+:- import_module io, list, string, term.
+
+:- type check: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_clauses(list(clause), rule_decls, clauses, list(check:error)).
+:- mode check_clauses(in, in, out, out) is det.
+
+:- pred check_useless(nonterminal, clauses, rule_decls, list(check:error)).
+:- mode check_useless(in, in, in, out) is det.
+
+:- pred check_inf_derivations(clauses, rule_decls, list(check:error)).
+:- mode check_inf_derivations(in, in, out) is det.
+
+ % write an error message to stderr.
+:- pred write_error(check:error, io__state, io__state).
+:- mode write_error(in, di, uo) is det.
+
+:- implementation.
+
+:- import_module misc.
+:- import_module map, require, set, std_util.
+
+%------------------------------------------------------------------------------%
+
+check_rule_decls(DeclList, Decls, Errors) :-
+ 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.
+
+check_rule_decls([], Decls, Decls, []).
+check_rule_decls([Decl|DeclList], Decls0, Decls, Errors) :-
+ Decl = rule(DeclId, _Args, _VarSet, DeclContext),
+ % Look to see if we already have a declaration for this rule.
+ ( search(Decls0, DeclId, PrevDecl) ->
+ PrevDecl = rule(_, _, _, PrevDeclContext),
+ id(DeclId, Name, Arity),
+ format("The previous declaration for %s/%d is here.",
+ [s(Name), i(Arity)], Msg0),
+ Err0 = error([Msg0], PrevDeclContext),
+ format("Duplicate declaration for %s/%d.",
+ [s(Name), i(Arity)], Msg1),
+ Err1 = error([Msg1], DeclContext),
+ Errors = [Err0, Err1|Errors0],
+ check_rule_decls(DeclList, Decls0, Decls, Errors0)
+ ;
+ set(Decls0, DeclId, Decl, Decls1),
+ check_rule_decls(DeclList, Decls1, Decls, Errors)
+ ).
+
+%------------------------------------------------------------------------------%
+
+check_clauses(ClauseList, Decls, Clauses, Errors) :-
+ init(Clauses0),
+ check_clauses0(ClauseList, Decls, Clauses0, Clauses, Errors0),
+
+ keys(Decls, DeclIds),
+ set__sorted_list_to_set(DeclIds, DeclSet),
+ keys(Clauses, ClauseIds),
+ set__sorted_list_to_set(ClauseIds, ClauseSet),
+ NoDeclSet = ClauseSet - DeclSet,
+ NoClauseSet = DeclSet - ClauseSet,
+
+ % Productions that have no rule declaration.
+ set__to_sorted_list(NoDeclSet, NoDeclList),
+ map((pred(NoDeclId::in, NoDeclError::out) is det :-
+ lookup(Clauses, NoDeclId, List),
+ ( List = [clause(_, _, _, NoDeclContext)|_] ->
+ id(NoDeclId, NoDeclName, NoDeclArity),
+ format("No rule declaration for %s/%d.",
+ [s(NoDeclName), i(NoDeclArity)], NoDeclMsg),
+ NoDeclError = error([NoDeclMsg], NoDeclContext)
+ ;
+ error("check_clauses: no clause ids")
+ )
+ ), NoDeclList, Errors1),
+
+ % Rules that have no productions.
+ set__to_sorted_list(NoClauseSet, NoClauseList),
+ map((pred(NoClauseId::in, NoClauseError::out) is det :-
+ lookup(Decls, NoClauseId, Decl),
+ Decl = rule(_, _, _, NoClauseContext),
+ id(NoClauseId, NoClauseName, NoClauseArity),
+ format("No productions for %s/%d.",
+ [s(NoClauseName), i(NoClauseArity)], NoClauseMsg),
+ NoClauseError = error([NoClauseMsg], NoClauseContext)
+ ), NoClauseList, Errors2),
+
+ condense([Errors0, Errors1, Errors2], Errors).
+
+:- pred check_clauses0(list(clause), rule_decls, clauses, clauses,
+ list(check:error)).
+:- mode check_clauses0(in, in, in, out, out) is det.
+
+check_clauses0([], _Decls, Clauses, Clauses, []).
+check_clauses0([Clause|ClauseList], Decls, Clauses0, Clauses, Errors) :-
+ Clause = clause(Head, Prod, _, Context),
+ Id = nonterminal(Head),
+ ( search(Clauses0, Id, ClauseList0) ->
+ append(ClauseList0, [Clause], ClauseList1)
+ ;
+ ClauseList1 = [Clause]
+ ),
+ set(Clauses0, Id, ClauseList1, Clauses1),
+
+ % Look for used nonterminals that are not declared.
+ solutions((pred(NonTermId::out) is nondet :-
+ % XXX performance
+ nonterminals(Prod, NonTermIds),
+ member(NonTermId, NonTermIds),
+ not contains(Decls, NonTermId)
+ ), UnDeclaredIds),
+ map((pred(UnDeclaredId::in, UnDeclaredError::out) is det :-
+ id(Id, CN, CA),
+ id(UnDeclaredId, NN, NA),
+ format("In production for %s/%d,", [s(CN), i(CA)], Msg0),
+ format(" the nonterminal %s/%d is undeclared.",
+ [s(NN), i(NA)], Msg1),
+ UnDeclaredError = error([Msg0, Msg1], Context)
+ ), UnDeclaredIds, Errors0),
+ (
+ Errors0 = [],
+ check_clauses0(ClauseList, Decls, Clauses1, Clauses, Errors)
+ ;
+ % Not tail recursive, so only do it if we have to.
+ Errors0 = [_|_],
+ check_clauses0(ClauseList, Decls, Clauses1, Clauses, Errors1),
+ append(Errors0, Errors1, Errors)
+ ).
+
+%------------------------------------------------------------------------------%
+
+check_useless(Start, Clauses, Decls, Errors) :-
+ StartSet = { Start },
+ useful(StartSet, Clauses, StartSet, UsefulSet),
+ map__keys(Clauses, AllIds),
+ set__sorted_list_to_set(AllIds, AllSet),
+ UselessSet = AllSet - UsefulSet,
+ set__to_sorted_list(UselessSet, UselessList),
+ filter_map((pred(UselessId::in, Error::out) is semidet :-
+ % Use search rather than lookup in case
+ % it was an undeclared rule.
+ search(Decls, UselessId, Decl),
+ Decl = rule(_Id, _Args, _VarSet, Context),
+ UselessId = Name / Arity,
+ format("Grammar rule %s/%d is not used.", [s(Name), i(Arity)],
+ Msg),
+ Error = error([Msg], Context)
+ ), 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.
+
+useful(New0, Clauses, Useful0, Useful) :-
+ ( empty(New0) ->
+ Useful = Useful0
+ ;
+ solutions_set((pred(UId::out) is nondet :-
+ member(Id, New0),
+ search(Clauses, Id, ClauseList),
+ member(Clause, ClauseList),
+ Clause = clause(_Head, Prod, _VarSet, _Context),
+ nonterminal(UId, Prod)
+ ), NewSet),
+ New1 = NewSet - Useful0,
+ Useful1 = New1 \/ Useful0,
+ useful(New1, Clauses, Useful1, Useful)
+ ).
+
+:- pred nonterminal(nonterminal, prod).
+:- mode nonterminal(out, in) is nondet.
+
+nonterminal(nonterminal(Term), nonterminal(Term)).
+nonterminal(NonTerminal, (A, B)) :-
+ (
+ nonterminal(NonTerminal, A)
+ ;
+ nonterminal(NonTerminal, B)
+ ).
+nonterminal(NonTerminal, (A ; B)) :-
+ (
+ nonterminal(NonTerminal, A)
+ ;
+ nonterminal(NonTerminal, B)
+ ).
+
+%------------------------------------------------------------------------------%
+
+check_inf_derivations(Clauses, Decls, Errors) :-
+ map__keys(Clauses, AllIds),
+ set__sorted_list_to_set(AllIds, InfSet0),
+ init(FinSet0),
+ finite(InfSet0, FinSet0, Clauses, InfSet),
+ set__to_sorted_list(InfSet, InfList),
+ filter_map((pred(InfId::in, Error::out) is semidet :-
+ % Use search rather than lookup in case
+ % it was an undeclared rule.
+ search(Decls, InfId, Decl),
+ Decl = rule(_Id, _Args, _VarSet, Context),
+ InfId = Name / Arity,
+ format("Rule %s/%d does not have any finite derivations.",
+ [s(Name), i(Arity)], Msg),
+ Error = error([Msg], Context)
+ ), InfList, Errors).
+
+:- pred finite(set(nonterminal), set(nonterminal), clauses, set(nonterminal)).
+:- mode finite(in, in, in, out) is det.
+
+finite(Inf0, Fin0, Clauses, Inf) :-
+ solutions_set((pred(NewFinId::out) is nondet :-
+ member(NewFinId, Inf0),
+ % search rather than lookup in case the nonterminal
+ % doesn't have any clauses. This may lead to
+ % spurious infinite derivations.
+ search(Clauses, NewFinId, ClauseList),
+ member(Clause, ClauseList),
+ Clause = clause(_Head, Prod, _VarSet, _Context),
+ nonterminals(Prod, NonTerms),
+ (
+ NonTerms = []
+ ;
+ NonTerms = [_|_],
+ all [NId] (
+ member(NId, NonTerms) => member(NId, Fin0)
+ )
+ )
+ ), NewFinSet),
+ NewFin = NewFinSet - Fin0,
+ ( empty(NewFin) ->
+ Inf = Inf0
+ ;
+ Inf1 = Inf0 - NewFin,
+ Fin1 = Fin0 \/ NewFin,
+ finite(Inf1, Fin1, Clauses, Inf)
+ ).
+
+:- pred nonterminals(prod, list(nonterminal)).
+:- mode nonterminals(in, 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 ; _B), Syms) :-
+ nonterminals(A, Syms).
+nonterminals((_A ; B), Syms) :-
+ nonterminals(B, Syms).
+nonterminals(action(_), []).
+
+%------------------------------------------------------------------------------%
+
+:- pred id(nonterminal, name, arity) is det.
+:- mode id(in, out, out) is det.
+
+id(Name/Arity, Name, Arity).
+id(start, _, _) :-
+ error("id: unexpected start").
+
+%------------------------------------------------------------------------------%
+
+write_error(error(MsgLines, Context)) -->
+ { Context = context(File, Line) },
+ { format("%s:%d: ", [s(File), i(Line)], ContextMsg) },
+ stderr_stream(StdErr),
+ foldl((pred(Msg::in, di, uo) is det -->
+ write_string(StdErr, ContextMsg),
+ write_string(StdErr, Msg),
+ nl(StdErr)
+ ), MsgLines).
+
+%------------------------------------------------------------------------------%
+
Index: grammar.m
===================================================================
RCS file: grammar.m
diff -N grammar.m
--- /dev/null Tue May 16 14:50:59 2000
+++ grammar.m Sat May 6 18:29:00 2000
@@ -0,0 +1,700 @@
+%------------------------------------------------------------------------------%
+%
+% file: grammar.m
+% main author: conway, November 1998
+%
+% This module defines the representation(s) of grammars that moose uses
+% to construct parsers.
+%
+%------------------------------------------------------------------------------%
+
+:- module grammar.
+
+:- interface.
+
+:- import_module misc.
+:- import_module array, list, map, set, term, varset.
+
+:- 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)).
+
+:- type clauses == map(nonterminal, list(clause)).
+
+:- type (clause)
+ ---> clause(
+ term, % Head
+ prod, % body
+ varset,
+ context % Context of the `--->'
+ ).
+
+:- type prod
+ ---> 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.
+ .
+
+:- type nonterminal
+ ---> start % S' - the distinguished start symbol. Will always
+ % correspond to prodnum == 0.
+ ; (name / arity)
+ .
+
+:- type symbol
+ ---> terminal(terminal)
+ ; nonterminal(nonterminal)
+ .
+
+:- type symbols == array(symbol).
+
+:- type bodyterm
+ ---> 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.
+ ).
+
+:- type rules == (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.
+ ).
+
+:- type xform
+ ---> xform(
+ nonterminal,
+ string
+ ).
+
+:- type xforms == (nonterminal -> xform).
+
+:- type first == (nonterminal -> set(terminal)).
+
+:- type follow == (nonterminal -> set(terminal)).
+
+:- type state == int.
+
+:- type action
+ ---> accept
+ ; shift(int)
+ ; reduce(int)
+ .
+
+:- type actiontable == (state -> terminal -> action).
+
+:- type gototable == (state -> nonterminal -> state).
+
+:- pred term_to_clause(term, varset, nonterminal, clause).
+:- mode term_to_clause(in, in, out, out) is semidet.
+
+:- pred add_clause(clauses, nonterminal, clause, clauses).
+:- mode add_clause(in, in, in, out) is det.
+
+:- pred construct_grammar(nonterminal, term, clauses, xforms, grammar).
+:- mode construct_grammar(in, in, in, in, out) is det.
+
+:- pred compute_first(rules, first).
+:- mode compute_first(in, out) is det.
+
+:- pred compute_follow(rules, nonterminal, terminal, first, follow).
+:- mode compute_follow(in, in, in, in, out) is det.
+
+ % Misc predicates.
+
+:- func terminal(term) = terminal.
+:- func nonterminal(term) = nonterminal.
+:- func first(first, symbols, int) = set(terminal).
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module misc.
+:- import_module bool, int, require, std_util, string.
+
+%------------------------------------------------------------------------------%
+
+%------------------------------------------------------------------------------%
+
+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).
+
+:- 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 = [] ->
+ Prod = []
+ ; Atom = atom("."), Args = [Head, Tail] ->
+ terminals(Tail, terminal(Head), Prod)
+ ;
+ Prod = nonterminal(functor(Atom, Args, Ctxt))
+ ).
+
+:- pred terminals(term, prod, prod).
+:- mode terminals(in, in, 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
+ ).
+
+%------------------------------------------------------------------------------%
+
+add_clause(Clauses0, Id, Clause, Clauses) :-
+ ( map__search(Clauses0, Id, These0) ->
+ These = [Clause|These0]
+ ;
+ These = [Clause]
+ ),
+ map__set(Clauses0, Id, These, Clauses).
+
+%------------------------------------------------------------------------------%
+
+construct_grammar(Start, _End, AllClauses, XForms, Grammar) :-
+ map__to_assoc_list(AllClauses, ClauseList),
+ Nont0 = 1,
+ start_rule(Start, StartRule),
+ map__from_assoc_list([0 - StartRule], Rules0),
+ map__init(Xfs0),
+ map__init(ClauseIndex0),
+ map__init(First0),
+ map__init(Follow0),
+ Grammar0 = grammar(Rules0, AllClauses, XForms, Nont0, ClauseIndex0,
+ First0, Follow0),
+ foldl(transform_clause_list, ClauseList, Grammar0, Grammar1),
+ compute_first0(Grammar1, Grammar2),
+ compute_follow0(Grammar2, Grammar).
+
+:- pred start_rule(nonterminal, rule).
+:- mode start_rule(in, out) is det.
+
+start_rule(Id, Rule) :-
+ (
+ Id = Name/Arity
+ ;
+ Id = start,
+ error("epsilon start rule")
+ ),
+ varset__init(VarSet0),
+ varset__new_vars(VarSet0, Arity, Vars, VarSet1),
+ foldl((pred(V::in, VS0::in, VS::out) is det :-
+ var_to_int(V, I),
+ format("V%d", [i(I)], N),
+ varset__name_var(VS0, V, N, 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.
+
+transform_clause_list(Id - Clauses, Grammar0, Grammar) :-
+ foldl(transform_clause(Id), Clauses, Grammar0, Grammar).
+
+:- pred transform_clause(nonterminal, clause, grammar, grammar).
+:- mode transform_clause(in, in, in, out) is det.
+
+transform_clause(Id, Clause, Grammar0, Grammar) :-
+ Clause = clause(Head, Prod, Varset, Context),
+ solutions(transform_prod(Prod), Bodies),
+ foldl(add_rule(Id, Head, Varset, Context), Bodies, Grammar0, 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.
+
+add_rule(Id, Head, Varset, Context, BodyTerms - Actions, Grammar0, Grammar) :-
+ Grammar0 = grammar(Rules0, C, Xfs, Nont0, ClauseIndex0, F, L),
+ 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(ClauseIndex0, Id, Prods, 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.
+
+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 ; 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")
+ ).
+
+nonterminal(Term) = Terminal :-
+ (
+ Term = functor(atom(Name), Args, _),
+ length(Args, Arity)
+ ->
+ Terminal = Name / Arity
+ ;
+ 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.
+
+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).
+
+:- type first_stuff
+ ---> 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),
+ foldl(compute_first, Rules, Stuff2, Stuff3)
+ ),
+ (pred(StuffN::in) is semidet :-
+ StuffN = stuff(no, _, _, _)
+ ), Stuff0, Stuff),
+ Stuff = stuff(_, _, _, First).
+
+:- pred compute_first(int, (rule), first_stuff, first_stuff).
+:- mode compute_first(in, in, in, 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 = { 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
+ ),
+ set(First0, Id, ThisFirst, First1),
+ Stuff = 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_first(I, IMax, Elems, First, Set0, Set) :-
+ ( I =< IMax ->
+ 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),
+ insert(Set0, Id, Set1),
+ difference(Set1, { epsilon }, Set)
+ ;
+ Elem = nonterminal(Id),
+ ( 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.
+ union(Set0, Set1, Set2),
+ ( member(epsilon, Set1) ->
+ compute_first(I + 1, IMax, Elems, First,
+ Set2, Set)
+ ;
+ difference(Set2, { epsilon }, Set)
+ )
+ ;
+ % If we don't know anything about
+ % this nonterminal, then stop here.
+ Set = Set0
+ )
+ )
+ ;
+ Set = Set0
+ ).
+
+:- pred collect_terminals(rules, set(terminal)).
+:- mode collect_terminals(in, out) is det.
+
+collect_terminals(Rules, Terminals) :-
+ foldl((pred(_RN::in, Rule::in, Ts0::in, Ts::out) is det :-
+ Rule = rule(_Id, _Head, Elems, _, _, _, _),
+ 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.
+
+collect_nonterminals(Rules, Nonterminals) :-
+ 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 array.m
+:- pred foldl(pred(T, U, U), array(T), U, U).
+:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
+
+foldl(Closure, Array, Acc0, Acc) :-
+ array__max(Array, Max),
+ foldl(0, Max, Closure, Array, Acc0, Acc).
+
+:- pred foldl(int, int, pred(T, U, U), array(T), U, U).
+:- mode foldl(in, in, pred(in, in, out) is det, in, in, out) is det.
+
+foldl(I, IMax, Closure, Array, Acc0, Acc) :-
+ ( I =< IMax ->
+ lookup(Array, I, Elem),
+ call(Closure, Elem, Acc0, Acc1),
+ foldl(I + 1, IMax, Closure, Array, Acc1, Acc)
+ ;
+ Acc = Acc0
+ ).
+
+ % 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.
+
+while(Cond, Body, Acc0, Acc) :-
+ ( call(Cond, Acc0) ->
+ call(Body, Acc0, Acc1),
+ while(Cond, Body, Acc1, Acc)
+ ;
+ 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.
+
+until(Body, Cond, Acc0, Acc) :-
+ call(Body, Acc0, Acc1),
+ ( call(Cond, Acc1) ->
+ Acc = Acc1
+ ;
+ 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.
+
+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).
+
+:- type follow_stuff
+ ---> stuff(
+ bool, % Changed?
+ list(nonterminal), % Nonterminals
+ rules,
+ first,
+ follow
+ ).
+
+compute_follow(Rules, Start, EOF, First, Follow) :-
+ map__init(Follow0),
+ % Rule 1
+ map__set(Follow0, Start, { EOF }, 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).
+
+:- pred compute_follow(int, (rule), follow_stuff, follow_stuff).
+:- mode compute_follow(in, in, in, 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).
+
+:- pred compute_follow2(int, int, first, symbols, follow_stuff, follow_stuff).
+:- mode compute_follow2(in, in, in, in, in, 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, { epsilon }, IdFollow),
+ add_follow(Id, IdFollow, Stuff0, Stuff1)
+ ;
+ Stuff1 = Stuff0
+ ),
+ compute_follow2(I + 1, IMax, First, Elems, Stuff1, Stuff)
+ ;
+ Stuff = Stuff0
+ ).
+
+:- pred compute_follow3(int, first, nonterminal, symbols,
+ follow_stuff, follow_stuff).
+:- mode compute_follow3(in, in, in, in, in, out) is det.
+
+compute_follow3(I, First, MyId, Elems, Stuff0, Stuff) :-
+ ( I >= 0 ->
+ lookup(Elems, I, Elem),
+ ( Elem = nonterminal(Id) ->
+ get_follow(MyId, MyFollow, Stuff0, _),
+ add_follow(Id, MyFollow, Stuff0, Stuff1),
+ lookup(First, Id, IdFirst),
+ ( member(epsilon, IdFirst) ->
+ compute_follow3(I - 1, First, MyId, Elems,
+ Stuff1, Stuff)
+ ;
+ Stuff = Stuff1
+ )
+ ;
+ Stuff = Stuff0
+ )
+ ;
+ Stuff = Stuff0
+ ).
+
+:- pred get_follow(nonterminal, set(terminal), follow_stuff, follow_stuff).
+:- mode get_follow(in, out, in, out) is det.
+
+get_follow(Id, IdFollow, Stuff, Stuff) :-
+ Stuff = stuff(_, _, _, _, Follow),
+ ( search(Follow, Id, IdFollow0) ->
+ IdFollow = IdFollow0
+ ;
+ 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),
+ ( search(Follow0, Id, OldFollow) ->
+ difference(IdFollow0, OldFollow, NewFollow),
+ ( empty(NewFollow) ->
+ IdFollow = OldFollow,
+ Ch = Ch0
+ ;
+ union(OldFollow, NewFollow, IdFollow),
+ Ch = yes
+ )
+ ;
+ IdFollow = IdFollow0,
+ Ch = yes
+ ),
+ set(Follow0, Id, IdFollow, Follow),
+ Stuff = stuff(Ch, Ns, Rs, Fs, Follow).
+
+%------------------------------------------------------------------------------%
+
+first(First, Elems, I) = FirstI :-
+ array__max(Elems, Max),
+ ( I =< Max ->
+ lookup(Elems, I, Elem),
+ (
+ Elem = terminal(Id),
+ FirstI = { Id }
+ ;
+ Elem = nonterminal(Id),
+ lookup(First, Id, FirstI0),
+ ( member(epsilon, FirstI0) ->
+ RestFirst = first(First, Elems, I+1),
+ union(FirstI0, RestFirst, FirstI)
+ ;
+ FirstI = FirstI0
+ )
+ )
+ ;
+ FirstI = { epsilon }
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred add_rule(rules, int, rule, rules).
+:- mode add_rule(in, in, in, out) is det.
+
+add_rule(Rules0, Num, Rule, Rules) :-
+ set(Rules0, Num, Rule, Rules).
+
+%------------------------------------------------------------------------------%
Index: lalr.m
===================================================================
RCS file: lalr.m
diff -N lalr.m
--- /dev/null Tue May 16 14:50:59 2000
+++ lalr.m Sat May 6 18:29:00 2000
@@ -0,0 +1,567 @@
+%------------------------------------------------------------------------------%
+% file: lalr.m
+% main author: conway
+%
+% This module builds the lalr items and lookaheads for the grammar.
+%
+%------------------------------------------------------------------------------%
+:- module lalr.
+
+:- interface.
+
+:- import_module grammar, misc.
+:- import_module int, io, set.
+
+:- type item
+ ---> item(prodnum, dot).
+
+:- type items == set(item).
+
+:- type gotos == (items -> symbol -> items).
+
+:- type lr1item
+ ---> item(prodnum, dot, terminal).
+
+:- type lr1items == set(lr1item).
+
+:- type prodnum == int.
+
+:- type dot == int.
+
+:- type reaching == (nonterminal -> set(nonterminal)).
+
+:- type propaheads == (items -> item -> items -> items).
+
+:- type lookaheads == (items -> item -> set(terminal)).
+
+:- type previews == (lookaheads - propaheads).
+
+:- pred reaching(rules, first, reaching).
+:- mode reaching(in, in, out) is det.
+
+:- pred lr0items(rules, reaching, set(items), gotos).
+:- mode lr0items(in, in, out, out) is det.
+
+:- pred lookaheads(set(items), gotos, rules, first, index, lookaheads,
+ io__state, io__state).
+:- mode lookaheads(in, in, in, in, in, out, di, uo) is det.
+
+:- implementation.
+
+:- import_module array, bool, list, map, require, std_util, term.
+
+%------------------------------------------------------------------------------%
+
+reaching(Productions, First, 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.
+
+reaching([], _Productions, _First, no, Reaching, Reaching).
+reaching([], Productions, First, yes, Reaching0, Reaching) :-
+ prodnums(Productions, ProdNums),
+ reaching(ProdNums, Productions, First, no, Reaching0, Reaching).
+reaching([ProdNum|ProdNums], Productions, First, Ch0, Reaching0, Reaching) :-
+ lookup(Productions, ProdNum, Prod),
+ Prod = rule(NonTerminal, _Head, Symbols, _, _, _V, _C),
+ array__max(Symbols, PMax),
+ reaching(0, PMax, Symbols, First, NonTerminal, Ch0, Ch1,
+ Reaching0, Reaching1),
+ reaching(ProdNums, Productions, First, Ch1, Reaching1, Reaching).
+
+:- pred reaching(int, int, symbols, first, nonterminal, bool, bool,
+ reaching, reaching).
+:- mode reaching(in, in, in, in, in, in, out, in, out) is det.
+
+reaching(SN, Max, Symbols, First, C, Ch0, Ch, Reaching0, Reaching) :-
+ ( SN > Max ->
+ Ch = Ch0,
+ Reaching = Reaching0
+ ;
+ lookup(Symbols, SN, Symbol),
+ (
+ Symbol = terminal(_),
+ Ch = Ch0,
+ Reaching = Reaching0
+ ;
+ Symbol = nonterminal(A),
+ reaches(C, A, Ch0, Ch1, Reaching0, Reaching1),
+ ( search(Reaching1, A, AR) ->
+ set__to_sorted_list(AR, ARList),
+ foldl2(reaches(C), ARList, Ch1, Ch2,
+ Reaching1, Reaching2)
+ ;
+ Ch2 = Ch1,
+ Reaching2 = Reaching1
+ ),
+ lookup(First, A, FirstA),
+ ( member(epsilon, FirstA) ->
+ reaching(SN + 1, Max, Symbols, First, C,
+ Ch2, Ch, Reaching2, Reaching)
+ ;
+ Ch = Ch2,
+ Reaching2 = Reaching
+ )
+ )
+ ).
+
+:- pred reaches(nonterminal, nonterminal, bool, bool, reaching, reaching).
+:- mode reaches(in, in, in, out, in, out) is det.
+
+reaches(C, A, Ch0, Ch, Reaching0, Reaching) :-
+ ( search(Reaching0, C, As0) ->
+ ( member(A, As0) ->
+ Ch = Ch0,
+ Reaching = Reaching0
+ ;
+ Ch = yes,
+ As = As0 \/ { A },
+ set(Reaching0, C, As, Reaching)
+ )
+ ;
+ Ch = yes,
+ As = { A },
+ set(Reaching0, C, As, Reaching)
+ ).
+
+%------------------------------------------------------------------------------%
+
+lr0items(Productions, Reaching, C, Gotos) :-
+ I0 = { item(0, 0) },
+ C0 = { I0 },
+ Pending = { 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.
+
+lr0items1(Pending0, Productions, Reaching, Gotos0, Gotos, C0, C) :-
+ ( remove_least(Pending0, J, Pending1) ->
+ set__to_sorted_list(J, JList),
+ lr0items_1(JList, J, Productions, Reaching, Gotos0, Gotos1,
+ empty, NewSet),
+ set__to_sorted_list(NewSet, NewItems),
+ map((pred(Pair::in, J0::out) is det :-
+ Pair = I0 - X,
+ lookup(Gotos1, I0, I0Gotos),
+ lookup(I0Gotos, X, J0)
+ ), NewItems, PendingList),
+ set__list_to_set(PendingList, NewPending0),
+ NewPending = NewPending0 - C0,
+ C1 = C0 \/ NewPending,
+ Pending = Pending1 \/ NewPending,
+ lr0items1(Pending, Productions, Reaching, Gotos1, Gotos, C1, C)
+ ;
+ Gotos = Gotos0,
+ C = C0
+ ).
+
+:- 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.
+
+lr0items_1([], _I, _Productions, _Reaching, Gotos, Gotos, New, New).
+lr0items_1([BItem|RestItems], I, Productions, Reaching, Gotos0, Gotos,
+ New0, New) :-
+ BItem = item(BProdNum, BDot),
+ lookup(Productions, BProdNum, BProd),
+ BProd = rule(_NonTerminal, _Head, BSyms, _, _, _V, _C),
+ array__max(BSyms, BMax),
+ (
+ BDot =< BMax
+ ->
+ lookup(BSyms, BDot, X),
+ addgoto(I, X, item(BProdNum, BDot + 1), Gotos0, Gotos1,
+ New0, New1)
+ ;
+ Gotos1 = Gotos0,
+ New1 = New0
+ ),
+ (
+ BDot =< BMax,
+ lookup(BSyms, BDot, nonterminal(C))
+ ->
+ ( search(Reaching, C, As) ->
+ set__to_sorted_list(As, AXList)
+ ;
+ AXList = []
+ ),
+ addAs([C|AXList], I, Productions, Gotos1, Gotos2, New1, New2)
+ ;
+ Gotos2 = Gotos1,
+ New2 = New1
+ ),
+ lr0items_1(RestItems, I, Productions, Reaching, Gotos2, Gotos,
+ New2, New).
+
+:- pred addgoto(items, symbol, item, gotos, gotos, new, new).
+:- mode addgoto(in, in, in, in, out, in, out) is det.
+
+addgoto(I, X, NewItem, Gotos0, Gotos, New0, New) :-
+ ( search(Gotos0, I, IGotos0) ->
+ IGotos1 = IGotos0
+ ;
+ init(IGotos1)
+ ),
+ ( search(IGotos1, X, GotoIX0) ->
+ GotoIX1 = GotoIX0
+ ;
+ GotoIX1 = empty
+ ),
+ GotoIX = GotoIX1 \/ { NewItem },
+ set(IGotos1, X, GotoIX, IGotos),
+ set(Gotos0, I, IGotos, Gotos),
+ ( GotoIX \= GotoIX1 ->
+ New = New0 \/ { I - X }
+ ;
+ New = New0
+ ).
+
+:- pred addAs(list(nonterminal), items, rules, gotos, gotos, new, new).
+:- mode addAs(in, in, in, in, out, in, out) is det.
+
+addAs([], _I, _Productions, Gotos, Gotos, New, New).
+addAs([A|As], I, Productions, Gotos0, Gotos, New0, New) :-
+ prodnums(Productions, ProdNums),
+ addAs_2(ProdNums, A, I, Productions, Gotos0, Gotos1, New0, New1),
+ addAs(As, I, Productions, Gotos1, Gotos, New1, 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.
+
+addAs_2([], _A, _I, _Productions, Gotos, Gotos, New, New).
+addAs_2([Pn|Pns], A, I, Productions, Gotos0, Gotos, New0, New) :-
+ lookup(Productions, Pn, Prod),
+ (
+ Prod = rule(A, _Head, Symbols, _, _, _V, _C),
+ array__max(Symbols, Max),
+ Max >= 0
+ ->
+ lookup(Symbols, 0, X),
+ addgoto(I, X, item(Pn, 1), Gotos0, Gotos1, New0, New1)
+ ;
+ Gotos1 = Gotos0,
+ New1 = New0
+ ),
+ addAs_2(Pns, A, I, Productions, Gotos1, Gotos, New1, New).
+
+%------------------------------------------------------------------------------%
+
+lookaheads(C, Gotos, Rules, First, Index, Lookaheads) -->
+ { map__from_assoc_list([item(0, 0) - { ($) }], I0) },
+ { map__from_assoc_list([{item(0, 0)} - I0], Lookaheads0) },
+ { init(Propaheads0) },
+ { set__to_sorted_list(C, CList) },
+ { lookaheads(CList, Gotos, Rules, First, Index,
+ Lookaheads0 - Propaheads0, Lookaheads1 - 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),
+ stderr_stream(StdErr),
+ write_string(StdErr, "\tpropagating...\n"),
+ { propagate(C, Propaheads, Lookaheads1, Lookaheads) }.
+
+:- pred lookaheads(list(items), gotos, rules, first, index, previews, previews).
+:- mode lookaheads(in, in, in, in, in, in, out) is det.
+
+lookaheads([], _Gotos, _Rules, _First, _Index, Lookaheads, Lookaheads).
+lookaheads([K|Ks], Gotos, Rules, First, Index, Lookaheads0, Lookaheads) :-
+ set__to_sorted_list(K, KList),
+ lookaheads1(KList, K, Gotos, Rules, First, Index,
+ Lookaheads0, Lookaheads1),
+ lookaheads(Ks, Gotos, Rules, First, Index, Lookaheads1, Lookaheads).
+
+:- pred lookaheads1(list(item), items, gotos, rules, first, index,
+ previews, previews).
+:- mode lookaheads1(in, in, in, in, in, in, in, out) is det.
+
+lookaheads1([], _I, _Gotos, _Rules, _First, _Index, Lookaheads, Lookaheads).
+lookaheads1([BItem|BItems], I, Gotos, Rules, First, Index,
+ Lookaheads0, Lookaheads) :-
+ BItem = item(Bp, Bd),
+ BItem0 = item(Bp, Bd, (*)),
+ J0 = closure({ BItem0 }, Rules, First, Index),
+ set__to_sorted_list(J0, JList),
+ lookaheads2(JList, BItem, I, Gotos, Rules, Lookaheads0, Lookaheads1),
+ lookaheads1(BItems, I, Gotos, Rules, First, Index,
+ Lookaheads1, Lookaheads).
+
+:- func closure(lr1items, rules, first, index) = lr1items.
+closure(I0, Rules, First, Index) = 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.
+
+closure(Rules, First, Index, New0, I0, I) :-
+ set__to_sorted_list(New0, NewList),
+ closure1(NewList, Rules, First, Index, [I0], Is),
+ do_union(Is, I1),
+ New = I1 - I0,
+ ( empty(New) ->
+ I = I1
+ ;
+ 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.
+
+closure1([], _Rules, _First, _Index, I, I).
+closure1([AItem|AItems], Rules, First, Index, I0, I) :-
+ AItem = item(Ap, Ad, Asym),
+ lookup(Rules, Ap, rule(_, _, Asyms, _, _, _, _)),
+ array__max(Asyms, AMax),
+ ( Ad =< AMax ->
+ lookup(Asyms, Ad, BSym),
+ ( BSym = nonterminal(Bn) ->
+ Bf0 = first(First, Asyms, Ad + 1),
+ ( member(epsilon, Bf0) ->
+ delete(Bf0, epsilon, Bf1),
+ insert(Bf1, Asym, Bf)
+ %Bf = Bf1 \/ { Asym }
+ ;
+ Bf = Bf0
+ ),
+ set__to_sorted_list(Bf, BfList),
+ lookup(Index, Bn, Bps),
+ make_items(Bps, BfList, [], NList),
+ set__list_to_set(NList, N),
+ I1 = [N|I0]
+ ;
+ I1 = I0
+ )
+ ;
+ I1 = I0
+ ),
+ closure1(AItems, Rules, First, Index, I1, 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.
+
+do_union([], I) :-
+ init(I).
+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").
+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 \/ 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.
+
+lookaheads2([], _B, _I, _Gotos, _Rules, Lookaheads, Lookaheads).
+lookaheads2([A|As], B, I, Gotos, Rules, Lookaheads0, Lookaheads) :-
+ A = item(Ap, Ad, Alpha),
+ lookup(Rules, Ap, rule(_, _, ASyms, _, _, _, _)),
+ array__max(ASyms, AMax),
+ ( Ad =< AMax ->
+ lookup(ASyms, Ad, X),
+ ( Gix = goto(Gotos, I, X) ->
+ Ad1 = Ad + 1,
+ ( Alpha = (*) ->
+ add_propagated(I, B, Gix, item(Ap, Ad1),
+ Lookaheads0, Lookaheads1)
+ ;
+ add_spontaneous(Gix, item(Ap, Ad1), Alpha,
+ Lookaheads0, Lookaheads1)
+ )
+ ;
+ Lookaheads1 = Lookaheads0
+ )
+ ;
+ Lookaheads1 = Lookaheads0
+ ),
+ lookaheads2(As, B, I, Gotos, Rules, Lookaheads1, Lookaheads).
+
+:- pred make_items(list(prodnum), list(terminal), list(lr1item), list(lr1item)).
+:- mode make_items(in, in, in, out) is det.
+
+make_items([], _, Items, Items).
+make_items([Bp|Bps], BfList, Items0, Items) :-
+ make_items1(Bp, BfList, Items0, Items1),
+ make_items(Bps, BfList, Items1, Items).
+
+:- pred make_items1(prodnum, list(terminal), list(lr1item), list(lr1item)).
+:- mode make_items1(in, in, in, out) is det.
+
+make_items1(_, [], Items, Items).
+make_items1(Bp, [Bt|Bts], Items0, Items) :-
+ Items1 = [item(Bp, 0, Bt)|Items0],
+ make_items1(Bp, Bts, Items1, Items).
+
+:- func goto(gotos, items, symbol) = items.
+:- mode (goto(in, in, in) = out) is semidet.
+
+goto(Gotos, I, X) = A :-
+ search(Gotos, I, IXs),
+ search(IXs, X, A).
+
+:- pred add_propagated(items, item, items, item, previews, previews).
+:- mode add_propagated(in, in, in, in, in, out) is det.
+
+add_propagated(I, B, Ia, A, L - P0, L - P) :-
+ ( search(P0, I, X0) ->
+ X1 = X0
+ ;
+ init(X1)
+ ),
+ ( search(X1, B, Y0) ->
+ Y1 = Y0
+ ;
+ init(Y1)
+ ),
+ ( search(Y1, Ia, As0) ->
+ As1 = As0
+ ;
+ As1 = empty
+ ),
+ insert(As1, A, As),
+ set(Y1, Ia, As, Y),
+ set(X1, B, Y, X),
+ set(P0, I, X, P).
+
+:- pred add_spontaneous(items, item, terminal, previews, previews).
+:- mode add_spontaneous(in, in, in, in, out) is det.
+
+add_spontaneous(I, B, Alpha, L0 - P, L - P) :-
+ ( search(L0, I, X0) ->
+ X1 = X0
+ ;
+ init(X1)
+ ),
+ ( search(X1, B, As0) ->
+ As1 = As0
+ ;
+ As1 = empty
+ ),
+ insert(As1, Alpha, As),
+ set(X1, B, As, X),
+ set(L0, I, X, L).
+
+:- pred propagate(set(items), propaheads, lookaheads, lookaheads).
+:- mode propagate(in, in, in, out) is det.
+
+propagate(C, Props, Lookaheads0, Lookaheads) :-
+ set__to_sorted_list(C, CList),
+ propagate(CList, Props, no, Change, Lookaheads0, Lookaheads1),
+ (
+ Change = no,
+ Lookaheads = Lookaheads1
+ ;
+ Change = yes,
+ propagate(C, Props, Lookaheads1, Lookaheads)
+ ).
+
+:- pred propagate(list(items), propaheads, bool, bool, lookaheads, lookaheads).
+:- mode propagate(in, in, in, out, in, out) is det.
+
+propagate([], _Props, Ch, Ch, L, L).
+propagate([I|Is], Props, Ch0, Ch, L0, L) :-
+ set__to_sorted_list(I, IList),
+ propagate1(IList, I, Props, Ch0, Ch1, L0, L1),
+ propagate(Is, Props, Ch1, Ch, L1, L).
+
+:- pred propagate1(list(item), items, propaheads, bool, bool,
+ lookaheads, lookaheads).
+:- mode propagate1(in, in, in, in, out, in, out) is det.
+
+propagate1([], _I, _Props, Ch, Ch, L, L).
+propagate1([Item|Items], I, Props, Ch0, Ch, L0, L) :-
+ (
+ search(L0, I, X),
+ search(X, Item, Ts),
+ search(Props, I, Y),
+ search(Y, Item, Ps)
+ ->
+ keys(Ps, Pkeys),
+ propagate2(Pkeys, Ps, Ts, Ch0, Ch1, L0, L1)
+ ;
+ Ch1 = Ch0,
+ L1 = L0
+ ),
+ propagate1(Items, I, Props, Ch1, Ch, L1, L).
+
+:- pred propagate2(list(items), (items -> items), set(terminal), bool, bool,
+ lookaheads, lookaheads).
+:- mode propagate2(in, in, in, in, out, in, out) is det.
+
+propagate2([], _Ps, _Ts, Ch, Ch, L, L).
+propagate2([I|Pks], Ps, Ts, Ch0, Ch, L0, L) :-
+ lookup(Ps, I, Ips),
+ set__to_sorted_list(Ips, IPList),
+ propagate3(IPList, I, Ts, Ch0, Ch1, L0, L1),
+ propagate2(Pks, Ps, Ts, Ch1, Ch, L1, L).
+
+:- pred propagate3(list(item), items, set(terminal), bool, bool,
+ lookaheads, lookaheads).
+:- mode propagate3(in, in, in, in, out, in, out) is det.
+
+propagate3([], _I, _Ts, Ch, Ch, L, L).
+propagate3([Item|Items], I, Ts0, Ch0, Ch, L0, L) :-
+ ( search(L0, I, X0) ->
+ X1 = X0
+ ;
+ init(X1)
+ ),
+ ( search(X1, Item, Ts1) ->
+ Ts2 = Ts1
+ ;
+ Ts2 = empty
+ ),
+ NewTs = Ts0 - Ts2,
+ ( not empty(NewTs) ->
+ Ts = Ts2 \/ NewTs,
+ set(X1, Item, Ts, X),
+ set(L0, I, X, L1),
+ Ch1 = yes
+ ;
+ Ch1 = Ch0,
+ L1 = L0
+ ),
+ propagate3(Items, I, Ts0, Ch1, Ch, L1, L).
+
+%------------------------------------------------------------------------------%
+
+:- pred prodnums(rules, list(prodnum)).
+:- mode prodnums(in, out) is det.
+
+prodnums(Rules, ProdNums) :-
+ keys(Rules, ProdNums).
+
+%------------------------------------------------------------------------------%
Index: mercury.m
===================================================================
RCS file: mercury.m
diff -N mercury.m
--- /dev/null Tue May 16 14:50:59 2000
+++ mercury.m Sat May 6 18:29:00 2000
@@ -0,0 +1,785 @@
+:- module mercury.
+
+:- interface.
+
+:- import_module io, list, term, varset.
+
+:- type (module) == list(element).
+
+ % 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
+ .
+
+:- type module_result
+ ---> module(module, list(module_error)).
+
+:- type module_error
+ ---> error(string, int).
+
+:- pred read_module(module_result, io__state, io__state).
+:- mode read_module(out, di, uo) is det.
+
+:- type lines
+ ---> lines
+ ; nolines
+ .
+
+:- pred write_element(lines, element, io__state, io__state).
+:- mode write_element(in, in, di, uo) is det.
+
+:- pred write_module(lines, (module), io__state, io__state).
+:- mode write_module(in, in, di, uo) is det.
+
+:- type (type)
+ ---> abstr(term)
+ ; equiv(term, term)
+ ; disj(term, list(term))
+ .
+
+:- pred term_to_type(term, (type)).
+:- mode term_to_type(in, 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)
+ .
+
+:- pred term_to_goal(term, goal).
+:- mode term_to_goal(in, out) is semidet.
+
+:- pred write_goal(varset, goal, io__state, io__state).
+:- mode write_goal(in, in, di, uo) is det.
+
+:- type vars == list(var).
+
+:- implementation.
+
+:- import_module int, require, std_util, string, term_io.
+
+%------------------------------------------------------------------------------%
+
+read_module(Result) -->
+ read_module([], [], Result0),
+ { Result0 = module(Module0, Errors0) },
+ { reverse(Module0, Module) },
+ { reverse(Errors0, Errors) },
+ { Result = module(Module, Errors) }.
+
+:- type element_result
+ ---> element(element)
+ ; eof
+ ; error(string, int)
+ .
+
+:- pred read_module(module, list(module_error), module_result,
+ io__state, io__state).
+:- mode read_module(in, in, out, di, uo) is det.
+
+read_module(Module0, Errors0, Result) -->
+ read_element(Result0),
+ (
+ { Result0 = eof },
+ { Result = module(Module0, Errors0) }
+ ;
+ { Result0 = element(Element) },
+ read_module([Element|Module0], Errors0, Result)
+ ;
+ { Result0 = error(Msg, Line) },
+ read_module(Module0, [error(Msg, Line)|Errors0], Result)
+ ).
+
+:- pred read_element(element_result, io__state, io__state).
+:- mode read_element(out, di, uo) is det.
+
+read_element(Result) -->
+ read_term(Result0),
+ (
+ { 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) }
+ ).
+
+:- pred classify(term, varset, element).
+:- mode classify(in, in, 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: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)
+ ).
+
+%------------------------------------------------------------------------------%
+
+write_module(_Lines, []) --> [].
+write_module(Lines, [Element|Module]) -->
+ write_element(Lines, Element),
+ nl,
+ write_module(Lines, Module).
+
+write_element(Lines, pred(PredDecl, VarSet)) -->
+ { cons_decl("pred", PredDecl, Term) },
+ write_term(Lines, 0, VarSet, Term),
+ dot_nl.
+
+write_element(Lines, func(FuncDecl, VarSet)) -->
+ { cons_decl("func", FuncDecl, Term) },
+ write_term(Lines, 0, VarSet, Term),
+ dot_nl.
+
+write_element(Lines, type(TypeDecl, VarSet)) -->
+ (
+ { TypeDecl = abstr(AbstrTerm) },
+ { cons_decl("type", AbstrTerm, Term) },
+ write_term(Lines, 0, VarSet, Term)
+ ;
+ { 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)
+ ;
+ { 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)
+ ),
+ dot_nl.
+
+write_element(Lines, mode(ModeDecl, VarSet)) -->
+ { cons_decl("mode", ModeDecl, Term) },
+ write_term(Lines, 0, VarSet, Term),
+ dot_nl.
+
+write_element(Lines, inst(InstDecl, VarSet)) -->
+ { cons_decl("inst", InstDecl, Term) },
+ write_term(Lines, 0, VarSet, Term),
+ dot_nl.
+
+write_element(Lines, class(ClassDecl, VarSet)) -->
+ { cons_decl("class", ClassDecl, Term) },
+ write_term(Lines, 0, VarSet, Term),
+ dot_nl.
+
+write_element(Lines, instance(InstanceDecl, VarSet)) -->
+ { cons_decl("instance", InstanceDecl, Term) },
+ write_term(Lines, 0, VarSet, Term),
+ dot_nl.
+
+write_element(Lines, misc(Term, VarSet)) -->
+ write_term(Lines, 0, VarSet, Term),
+ dot_nl.
+
+write_element(Lines, clause(Head, Goal, VarSet)) -->
+ write_term(Lines, 0, VarSet, Head),
+ write_string(" :-\n"),
+ write_goal(Lines, 1, normal, Goal, VarSet),
+ dot_nl.
+
+write_element(Lines, dcg_clause(Head, Goal, VarSet)) -->
+ write_term(Lines, 0, VarSet, Head),
+ write_string(" -->\n"),
+ write_goal(Lines, 1, dcg, Goal, VarSet),
+ dot_nl.
+
+%------------------------------------------------------------------------------%
+
+:- type goal_type
+ ---> normal
+ ; dcg
+ .
+
+:- pred write_goal_term(lines, int, goal_type, term, varset,
+ io__state, io__state).
+:- mode write_goal_term(in, in, in, in, in, di, uo) is det.
+
+write_goal_term(Lines, Ind, Type, Term, VarSet) -->
+ ( { term_to_conj(Term, Conjuncts) } ->
+ write_conjuncts(Lines, Ind, Type, Conjuncts, VarSet)
+ ; { term_to_ite(Term, IfThens, Else) } ->
+ write_ite_terms(Lines, Ind, Type, IfThens, Else, VarSet)
+ ; { term_to_disj(Term, Disjuncts) } ->
+ write_disjuncts(Lines, Ind, Type, Disjuncts, VarSet)
+ ;
+ % Too bad if it is a quantifier, { Goal }, etc.
+ % Also too bad if it contains a pred expression...
+ % You can add pretty things here...
+ write_term(Lines, Ind, VarSet, Term)
+ ).
+
+:- pred term_to_conj(term, list(term)).
+:- mode term_to_conj(in, out) is semidet.
+
+term_to_conj(functor(atom(","), [Head,Term], _), [Head|Tail]) :-
+ ( term_to_conj(Term, Tail0) ->
+ Tail = Tail0
+ ;
+ Tail = [Term]
+ ).
+
+:- pred term_to_disj(term, list(term)).
+:- mode term_to_disj(in, out) is semidet.
+
+term_to_disj(functor(atom(";"), [Head,Term], _), [Head|Tail]) :-
+ ( term_to_disj(Term, Tail0) ->
+ Tail = Tail0
+ ;
+ Tail = [Term]
+ ).
+
+:- pred term_to_ite(term, list(pair(term)), term).
+:- mode term_to_ite(in, out, out) is semidet.
+
+term_to_ite(functor(atom(";"), [Head,Else0], _), [If - Then|Rest], Else) :-
+ Head = functor(atom("->"), [If, Then], _),
+ ( term_to_ite(Else0, Rest0, Else1) ->
+ Rest = Rest0,
+ Else = Else1
+ ;
+ Rest = [],
+ Else = Else0
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_conjuncts(lines, int, goal_type, list(term), varset,
+ io__state, io__state).
+:- mode write_conjuncts(in, in, in, in, in, di, uo) is det.
+
+write_conjuncts(_Lines, Ind, Type, [], _VarSet) -->
+ write_ind(Ind),
+ (
+ { Type = normal },
+ write_string("true")
+ ;
+ { Type = dcg },
+ write_string("{ true }")
+ ).
+
+write_conjuncts(Lines, Ind, Type, [Goal], VarSet) -->
+ write_goal_term(Lines, Ind, Type, Goal, VarSet).
+
+write_conjuncts(Lines, Ind, Type, [Goal|Goals], VarSet) -->
+ { Goals = [_|_] },
+ write_goal_term(Lines, Ind, Type, Goal, VarSet),
+ write_string(",\n"),
+ write_conjuncts(Lines, Ind, Type, Goals, VarSet).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_disjuncts(lines, int, goal_type, list(term), varset,
+ io__state, io__state).
+:- mode write_disjuncts(in, in, in, in, in, di, uo) is det.
+
+write_disjuncts(Lines, Ind, Type, Goals, VarSet) -->
+ write_ind(Ind),
+ write_string("(\n"),
+ write_disjuncts0(Lines, Ind, Type, Goals, VarSet), nl,
+ write_ind(Ind),
+ write_string(")").
+
+:- pred write_disjuncts0(lines, int, goal_type, list(term), varset,
+ io__state, io__state).
+:- mode write_disjuncts0(in, in, in, in, in, di, uo) is det.
+
+write_disjuncts0(_Lines, Ind, Type, [], _VarSet) -->
+ write_ind(Ind),
+ (
+ { Type = normal },
+ write_string("fail")
+ ;
+ { Type = dcg },
+ write_string("{ fail }")
+ ).
+
+write_disjuncts0(Lines, Ind, Type, [Goal], VarSet) -->
+ write_goal_term(Lines, Ind + 1, Type, Goal, VarSet), nl.
+
+write_disjuncts0(Lines, Ind, Type, [Goal|Goals], VarSet) -->
+ { Goals = [_|_] },
+ write_goal_term(Lines, Ind + 1, Type, Goal, VarSet), nl,
+ write_ind(Ind),
+ write_string(";\n"),
+ write_disjuncts0(Lines, Ind, Type, Goals, VarSet).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_ite_terms(lines, int, goal_type, list(pair(term)), term, varset,
+ io__state, io__state).
+:- mode write_ite_terms(in, in, in, in, in, in, di, uo) is det.
+
+write_ite_terms(Lines, Ind, Type, IfThens, Else, VarSet) -->
+ write_ind(Ind),
+ write_string("(\n"),
+ write_ite_terms0(Lines, Ind, Type, IfThens, VarSet),
+ write_ind(Ind),
+ write_string(";\n"),
+ write_goal_term(Lines, Ind + 1, Type, Else, VarSet), nl,
+ write_ind(Ind),
+ write_string(")").
+
+:- pred write_ite_terms0(lines, int, goal_type, list(pair(term)), varset,
+ io__state, io__state).
+:- mode write_ite_terms0(in, in, in, in, in, di, uo) is det.
+
+write_ite_terms0(_Lines, _Ind, _Type, [], _VarSet) -->
+ { error("no if-thens") }.
+write_ite_terms0(Lines, Ind, Type, [If - Then], VarSet) -->
+ write_goal_term(Lines, Ind + 1, Type, If, VarSet), nl,
+ write_ind(Ind),
+ write_string("->\n"),
+ write_goal_term(Lines, Ind + 1, Type, Then, VarSet), nl.
+write_ite_terms0(Lines, Ind, Type, [If - Then|Rest], VarSet) -->
+ { Rest = [_|_] },
+ write_goal_term(Lines, Ind + 1, Type, If, VarSet), nl,
+ write_ind(Ind),
+ write_string("->\n"),
+ write_goal_term(Lines, Ind + 1, Type, Then, VarSet), nl,
+ write_ind(Ind),
+ write_string(";\n"),
+ write_ite_terms0(Lines, Ind, Type, Rest, VarSet).
+
+%------------------------------------------------------------------------------%
+
+:- pred cons_decl(string, term, term).
+:- mode cons_decl(in, in, out) is det.
+
+cons_decl(Atom, DeclTerm, Term) :-
+ 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.
+
+get_context(variable(_), Context) :-
+ context_init(Context).
+get_context(functor(_, _, Context), Context).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_ind(int, io__state, io__state).
+:- mode write_ind(in, di, uo) is det.
+
+write_ind(N) -->
+ ( { N > 0 } ->
+ write_string(" "),
+ write_ind(N - 1)
+ ;
+ []
+ ).
+
+:- pred dot_nl(io__state, io__state).
+:- mode dot_nl(di, uo) is det.
+
+dot_nl --> write_string(".\n").
+
+:- pred write_term(lines, int, varset, term, io__state, io__state).
+:- mode write_term(in, in, in, in, di, uo) is det.
+
+write_term(lines, Ind, VarSet, Term) -->
+ { get_context(Term, context(File, Line)) },
+ ( { File = "", Line = 0 } ->
+ []
+ ;
+ format("#%d\n", [i(Line)])
+ ),
+ write_ind(Ind),
+ write_term(VarSet, Term).
+write_term(nolines, Ind, VarSet, Term) -->
+ write_ind(Ind),
+ write_term(VarSet, Term).
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+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))
+ ).
+
+:- pred cons_type_body(list(term), term).
+:- mode cons_type_body(in, out) is det.
+
+cons_type_body([], _) :-
+ 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).
+
+%------------------------------------------------------------------------------%
+
+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))
+ ).
+
+:- pred term_to_goal0(string, list(term), context, goal).
+:- mode term_to_goal0(in, in, in, 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], _, 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("=", [A, B], Context, =(A, B, Context)).
+
+term_to_goal0("not", [A], _, not(Goal)) :-
+ term_to_goal(A, Goal).
+
+term_to_goal0("\\+", [A], _, not(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).
+
+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).
+*/
+
+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).
+
+%------------------------------------------------------------------------------%
+
+write_goal(VarSet, Goal) -->
+ write_goal(nolines, 1, normal, Goal, VarSet).
+
+:- pred write_goal(lines, int, goal_type, goal, varset, io__state, io__state).
+:- mode write_goal(in, in, in, in, in, di, uo) is det.
+
+write_goal(Lines, Ind, _GoalType, call(Term), VarSet) -->
+ write_term(Lines, Ind, VarSet, Term).
+
+write_goal(Lines, Ind, GoalType, =(LHS, RHS, Context), VarSet) -->
+ { UnifyTerm = functor(atom("="), [LHS, RHS], Context) },
+ (
+ { GoalType = dcg },
+ { Term = functor(atom("{}"), [UnifyTerm], Context) }
+ ;
+ { GoalType = normal },
+ { Term = UnifyTerm }
+ ),
+ write_term(Lines, Ind, VarSet, Term).
+
+write_goal(Lines, Ind, GoalType, conj(Goals), VarSet) -->
+ write_conj(Lines, Ind, GoalType, Goals, VarSet).
+
+write_goal(Lines, Ind, GoalType, disj(Goals), VarSet) -->
+ write_disj(Lines, Ind, GoalType, Goals, VarSet).
+
+write_goal(Lines, Ind, GoalType, ite(If, Then, Else0), VarSet) -->
+ { collect_ite(Else0, IfThens0, Else) },
+ write_ite(Lines, Ind, GoalType, [If - Then|IfThens0], Else, VarSet).
+
+write_goal(Lines, Ind, GoalType, not(Goal), VarSet) -->
+ write_ind(Ind),
+ write_string("not (\n"),
+ write_goal(Lines, Ind + 1, GoalType, Goal, VarSet), nl,
+ write_ind(Ind),
+ write_string(")").
+
+write_goal(Lines, Ind, GoalType, exists(Vars, Goal), VarSet) -->
+ write_ind(Ind),
+ write_string("some ["),
+ write_vars(Vars, VarSet),
+ write_string("] (\n"),
+ write_goal(Lines, Ind + 1, GoalType, Goal, VarSet), nl,
+ write_ind(Ind),
+ write_string(")").
+
+write_goal(Lines, Ind, GoalType, forall(Vars, Goal), VarSet) -->
+ write_ind(Ind),
+ write_string("all ["),
+ write_vars(Vars, VarSet),
+ write_string("] (\n"),
+ write_goal(Lines, Ind + 1, GoalType, Goal, VarSet), nl,
+ write_ind(Ind),
+ write_string(")").
+
+/*
+write_goal(Lines, Ind, GoalType, (A => B), VarSet) -->
+ write_ind(Ind),
+ write_string("((\n"),
+ write_goal(Lines, Ind, GoalType, A, VarSet), nl,
+ write_ind(Ind),
+ write_string(") => (\n"),
+ write_goal(Lines, Ind, GoalType, A, VarSet), nl,
+ write_ind(Ind),
+ write_string("))").
+*/
+
+write_goal(Lines, Ind, GoalType, (A <= B), VarSet) -->
+ write_ind(Ind),
+ write_string("((\n"),
+ write_goal(Lines, Ind, GoalType, A, VarSet), nl,
+ write_ind(Ind),
+ write_string(") <= (\n"),
+ write_goal(Lines, Ind, GoalType, B, VarSet), nl,
+ write_ind(Ind),
+ write_string("))").
+
+write_goal(Lines, Ind, GoalType, (A <=> B), VarSet) -->
+ write_ind(Ind),
+ write_string("((\n"),
+ write_goal(Lines, Ind, GoalType, A, VarSet), nl,
+ write_ind(Ind),
+ write_string(") <=> (\n"),
+ write_goal(Lines, Ind, GoalType, B, VarSet), nl,
+ write_ind(Ind),
+ write_string("))").
+
+%------------------------------------------------------------------------------%
+
+:- pred write_conj(lines, int, goal_type, list(goal), varset,
+ io__state, io__state).
+:- mode write_conj(in, in, in, in, in, di, uo) is det.
+
+write_conj(_Lines, Ind, Type, [], _VarSet) -->
+ write_ind(Ind),
+ (
+ { Type = normal },
+ write_string("true")
+ ;
+ { Type = dcg },
+ write_string("{ true }")
+ ).
+
+write_conj(Lines, Ind, Type, [Goal], VarSet) -->
+ write_goal(Lines, Ind, Type, Goal, VarSet).
+
+write_conj(Lines, Ind, Type, [Goal|Goals], VarSet) -->
+ { Goals = [_|_] },
+ write_goal(Lines, Ind, Type, Goal, VarSet),
+ write_string(",\n"),
+ write_conj(Lines, Ind, Type, Goals, VarSet).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_disj(lines, int, goal_type, list(goal), varset,
+ io__state, io__state).
+:- mode write_disj(in, in, in, in, in, di, uo) is det.
+
+write_disj(Lines, Ind, Type, Goals, VarSet) -->
+ write_ind(Ind),
+ write_string("(\n"),
+ write_disj0(Lines, Ind, Type, Goals, VarSet), nl,
+ write_ind(Ind),
+ write_string(")").
+
+:- pred write_disj0(lines, int, goal_type, list(goal), varset,
+ io__state, io__state).
+:- mode write_disj0(in, in, in, in, in, di, uo) is det.
+
+write_disj0(_Lines, Ind, Type, [], _VarSet) -->
+ write_ind(Ind + 1),
+ (
+ { Type = normal },
+ write_string("fail")
+ ;
+ { Type = dcg },
+ write_string("{ fail }")
+ ).
+
+write_disj0(Lines, Ind, Type, [Goal], VarSet) -->
+ write_goal(Lines, Ind + 1, Type, Goal, VarSet), nl.
+
+write_disj0(Lines, Ind, Type, [Goal|Goals], VarSet) -->
+ { Goals = [_|_] },
+ write_goal(Lines, Ind + 1, Type, Goal, VarSet), nl,
+ write_ind(Ind),
+ write_string(";\n"),
+ write_disj0(Lines, Ind, Type, Goals, VarSet).
+
+%------------------------------------------------------------------------------%
+
+:- pred collect_ite(goal, list(pair(goal)), goal).
+:- mode collect_ite(in, out, 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
+ ).
+
+:- pred write_ite(lines, int, goal_type, list(pair(goal)), goal, varset,
+ io__state, io__state).
+:- mode write_ite(in, in, in, in, in, in, di, uo) is det.
+
+write_ite(Lines, Ind, Type, IfThens, Else, VarSet) -->
+ write_ind(Ind),
+ write_string("(\n"),
+ write_ite0(Lines, Ind, Type, IfThens, VarSet),
+ write_ind(Ind),
+ write_string(";\n"),
+ write_goal(Lines, Ind + 1, Type, Else, VarSet), nl,
+ write_ind(Ind),
+ write_string(")").
+
+:- pred write_ite0(lines, int, goal_type, list(pair(goal)), varset,
+ io__state, io__state).
+:- mode write_ite0(in, in, in, in, in, di, uo) is det.
+
+write_ite0(_Lines, _Ind, _Type, [], _VarSet) -->
+ { error("no if-thens") }.
+write_ite0(Lines, Ind, Type, [If - Then], VarSet) -->
+ write_goal(Lines, Ind + 1, Type, If, VarSet), nl,
+ write_ind(Ind),
+ write_string("->\n"),
+ write_goal(Lines, Ind + 1, Type, Then, VarSet), nl.
+write_ite0(Lines, Ind, Type, [If - Then|Rest], VarSet) -->
+ { Rest = [_|_] },
+ write_goal(Lines, Ind + 1, Type, If, VarSet), nl,
+ write_ind(Ind),
+ write_string("->\n"),
+ write_goal(Lines, Ind + 1, Type, Then, VarSet), nl,
+ write_ind(Ind),
+ write_string(";\n"),
+ write_ite0(Lines, Ind, Type, Rest, VarSet).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_vars(vars, varset, io__state, io__state).
+:- mode write_vars(in, in, di, uo) is det.
+
+write_vars([], _) --> [].
+write_vars([V], VarSet) -->
+ write_variable(V, VarSet).
+write_vars([V|Vs], VarSet) -->
+ { Vs = [_|_] },
+ write_variable(V, VarSet),
+ write_string(", "),
+ write_vars(Vs, VarSet).
+
Index: misc.m
===================================================================
RCS file: misc.m
diff -N misc.m
--- /dev/null Tue May 16 14:50:59 2000
+++ misc.m Sat May 6 18:29:00 2000
@@ -0,0 +1,46 @@
+:- module misc.
+
+:- interface.
+
+:- import_module int, map, set, std_util.
+
+:- type '' ---> ''.
+
+:- type (T1 -> T2) == map(T1, T2).
+
+:- type (T1 - T2) == pair(T1, T2).
+
+:- func empty = set(T).
+
+:- func { T } = set(T).
+
+:- func (set(T) /\ set(T)) = set(T).
+
+:- func (set(T) \/ set(T)) = set(T).
+
+:- func (set(T) - set(T)) = set(T).
+
+:- pred between(int, int, int).
+:- mode between(in, in, out) is nondet.
+
+:- implementation.
+
+empty = Empty :-
+ set__init(Empty).
+
+{ Elem } = Set :- set__singleton_set(Set, Elem).
+
+A /\ B = C :- set__intersect(A, B, C).
+
+A \/ B = C :- set__union(A, B, C).
+
+A - B = C :- set__difference(A, B, C).
+
+between(Min, Max, Z) :-
+ Min =< Max,
+ (
+ Z = Min
+ ;
+ between(Min + 1, Max, Z)
+ ).
+
Index: moose.m
===================================================================
RCS file: moose.m
diff -N moose.m
--- /dev/null Tue May 16 14:50:59 2000
+++ moose.m Fri May 19 16:02:23 2000
@@ -0,0 +1,871 @@
+:- module moose.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module grammar, lalr, tables, check, mercury, misc, options.
+:- import_module array, bool, getopt, int, list, map, require.
+:- import_module set, std_util, string, term, term_io, varset.
+
+main -->
+ parse_options(MOptions, Args),
+ (
+ { MOptions = ok(Options) },
+ { lookup_bool_option(Options, help, Help) },
+ ( { Help = yes } ->
+ help
+ ;
+ main2(Options, Args)
+ )
+ ;
+ { MOptions = error(String) },
+ stderr_stream(StdErr),
+ write_string(StdErr, String),
+ nl(StdErr)
+ ).
+
+:- pred main2(options::in, list(string)::in, io__state::di, io__state::uo).
+main2(_Options, []) -->
+ stderr_stream(StdErr),
+ write_string(StdErr, "no input files.\n"),
+ help.
+main2(Options, [Name0|Names]) -->
+ { figure_out_names(Name0, InName, OutName) },
+ see(InName, Res0),
+ (
+ { Res0 = ok },
+ tell(OutName, Res1),
+ (
+ { Res1 = ok },
+ process(Options),
+ told
+ ;
+ { Res1 = error(Err) },
+ { error_message(Err, Msg) },
+ stderr_stream(StdErr),
+ write_string(StdErr, Msg),
+ nl(StdErr)
+ )
+ ;
+ { Res0 = error(Err) },
+ { error_message(Err, Msg) },
+ stderr_stream(StdErr),
+ write_string(StdErr, Msg),
+ nl(StdErr)
+ ),
+ ( { Names = [_|_] } ->
+ main2(Options, 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) ->
+ Name = Name1
+ ;
+ Name = Name0
+ ),
+ string__append(Name, ".moo", InName),
+ string__append(Name, ".m", OutName).
+
+:- type whereami
+ ---> (interface) ; (implementation) .
+
+:- type parser
+ ---> parser(whereami, nonterminal, term, string, string).
+
+:- pred process(options::in, io__state::di, io__state::uo) is det.
+
+process(Options) -->
+ { lookup_bool_option(Options, verbose, Verbse) },
+ ( { Verbse = yes } -> report_stats ; [] ),
+ read_module(Result),
+ { Result = module(Module, Errors) },
+ (
+ { Errors = [_|_] },
+ stderr_stream(StdErr),
+ foldl((pred(Err::in, di, uo) is det -->
+ { Err = error(Msg, Line) },
+ format(StdErr, "%d: %s\n", [i(Line), s(Msg)])
+ ), Errors)
+ ;
+ { Errors = [] },
+ { get_moose_elements(Module, [], Remainder0, (implementation),
+ [], MParser, [], RuleDecls, [], ClauseList,
+ [], XFormList) },
+ (
+ { MParser = [] },
+ stderr_stream(StdErr),
+ write_string(StdErr, "error: no parse/4 declaration.\n")
+ ;
+ { MParser = [Parser] },
+ { reverse(Remainder0, Remainder) },
+ process_2(Options, Remainder, Parser,
+ RuleDecls, ClauseList, XFormList)
+ ;
+ { MParser = [_,_|_] },
+ stderr_stream(StdErr),
+ write_string(StdErr, "error: more than one parse/4 declaration.\n")
+ )
+ ).
+
+:- pred process_2(options, (module), parser, list(rule_decl), list(clause),
+ list(xform), io__state, io__state).
+:- mode process_2(in, in, in, in, in, in, di, uo) is det.
+
+process_2(Options, Module, Parser, Decls0, Clauses0, XFormList) -->
+ { lookup_bool_option(Options, verbose, Verbse) },
+ ( { Verbse = yes } -> report_stats ; [] ),
+
+ { check_rule_decls(Decls0, Decls, DeclErrors) },
+ foldl(write_error, DeclErrors),
+
+ { check_clauses(Clauses0, Decls, Clauses, ClauseErrors) },
+ foldl(write_error, ClauseErrors),
+
+ { Parser = parser(WhereAmI, StartId, EndToken, TokenType, _Prefix) },
+
+ { check_useless(StartId, Clauses, Decls, UselessErrors) },
+ foldl(write_error, UselessErrors),
+
+ { check_inf_derivations(Clauses, Decls, InfErrors) },
+ foldl(write_error, InfErrors),
+
+ (
+ { DeclErrors = [] },
+ { ClauseErrors = [] },
+ { UselessErrors = [] },
+ { InfErrors = [] }
+ ->
+ write_module(nolines, Module), nl,
+ { lookup(Decls, StartId, StartDecl) },
+ write_parser(WhereAmI, StartId, StartDecl, TokenType),
+ write_action_type_class(WhereAmI, XFormList, Decls),
+
+ stderr_stream(StdErr),
+ write_string(StdErr, "constructing grammar...\n"),
+
+ { map__init(Xfns0) },
+ { foldl((pred(XForm::in, Xf0::in, Xf::out) is det :-
+ XForm = xform(XfNt, _),
+ map__det_insert(Xf0, XfNt, XForm, Xf)
+ ), XFormList, Xfns0, XForms) },
+
+ { construct_grammar(StartId, EndToken, Clauses, XForms,
+ Grammar) },
+ { Grammar = grammar(Rules, _, Xfns, _, Index, First, _Follow) },
+ { reaching(Rules, First, Reaching) },
+
+ write_string(StdErr, "constructing lr(0) items...\n"),
+ { lr0items(Rules, Reaching, C, Gotos) },
+ write_string(StdErr, "determining lookaheads...\n"),
+ lookaheads(C, Gotos, Rules, First, Index, Lookaheads),
+ write_string(StdErr, "computing the action table...\n"),
+ { shifts(C, Rules, First, Reaching, Shifts) },
+ { actions(C, Rules, Lookaheads, Gotos, Shifts,
+ States, ActionTable, ActionErrs) },
+ foldl2((pred(Err::in, HasEs0::in, HasEs::out, di, uo) is det -->
+ (
+ { Err = warning(Warning) },
+ { HasEs = HasEs0 },
+ (
+ { Warning = shiftreduce(_S, Rp) },
+ write_string(StdErr,
+ "shift reduce conflict involving:\n\t"),
+ write_rule(StdErr, Rp, Rules)
+ )
+ ;
+ { Err = error(Error) },
+ { HasEs = yes },
+ (
+ { Error = shiftshift(_, _) },
+ write_string(StdErr,
+ "shift shift error.\n")
+ ;
+ { Error = reducereduce(R0, R1) },
+ write_string(StdErr,
+ "reduce reduce conflict involving:\n\t"),
+ write_rule(StdErr, R0, Rules),
+ write_string(StdErr, "\t"),
+ write_rule(StdErr, R1, Rules)
+ ;
+ { Error = misc(Ac1, Ac2) },
+ write_string(StdErr,
+ "misc conflict involving:\n\t"),
+ write(StdErr, Ac1),
+ write_string(StdErr, "\n\t"),
+ write(StdErr, Ac2),
+ write_string(StdErr, "\n")
+ )
+ )
+ ), ActionErrs, no, _HasErrors),
+ write_action_table(ActionTable, TokenType, EndToken),
+ write_string(StdErr, "computing the goto table...\n"),
+ { gotos(C, States, Gotos, GotoTable) },
+ write_goto_table(GotoTable, Decls),
+ write_reductions(Rules, TokenType, Xfns),
+ []
+ ;
+ []
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_action_type_class(whereami, list(xform), rule_decls,
+ io__state, io__state).
+:- mode write_action_type_class(in, in, in, di, uo) is det.
+
+write_action_type_class(Where, XForms, Decls) -->
+ ( { Where = (interface) } ->
+ write_string(":- interface.\n\n")
+ ;
+ []
+ ),
+ io__write_string(":- typeclass parser_state(T) where [\n"),
+ io__write_string(" pred get_token(token, T, T),\n"),
+ io__write_string(" mode get_token(out, in, out) is semidet"),
+ ( { not XForms = [] } ->
+ io__write_string(",\n")
+ ;
+ []
+ ),
+ { WriteIn = (pred(_Anything::in, di, uo) is det -->
+ io__write_string("in"))
+ },
+ { WriteXForm = (pred(XForm::in, di, uo) is det -->
+ { XForm = xform(NT, MethodName) },
+ { lookup(Decls, NT, RuleDecl) },
+ { RuleDecl = rule(_NT, Types, VarSet, _Context) },
+ io__write_strings(["\tpred ", MethodName, "("]),
+ io__write_list(Types, ", ", term_io__write_term(VarSet)),
+ ( { Types \= [] } -> io__write_string(", ") ; [] ),
+ io__write_string("T, T),\n"),
+
+ io__write_strings(["\tmode ", MethodName, "("]),
+ io__write_list(Types, ", ", WriteIn),
+ ( { Types \= [] } -> io__write_string(", ") ; [] ),
+ io__write_string("in, out) is det")
+ )
+ },
+ io__write_list(XForms, ",\n", WriteXForm),
+ io__write_string("\n].\n"),
+ ( { Where = (interface) } ->
+ write_string(":- implementation.\n\n")
+ ;
+ []
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_rule(output_stream, int, rules, io__state, io__state).
+:- mode write_rule(in, in, in, di, uo) is det.
+
+write_rule(Stream, RN, Rules) -->
+ { lookup(Rules, RN, Rule) },
+ write_int(Stream, RN), write_string(Stream, ": "),
+ { Rule = rule(NT, _, Syms, _, _, _, _) },
+ write(Stream, NT),
+ write_string(Stream, " ->\t"),
+ write_syms(Stream, 0, 999, Syms),
+ write_string(Stream, "\n").
+
+:- pred write_syms(output_stream, int, int, symbols, io__state, io__state).
+:- mode write_syms(in, in, in, in, di, uo) is det.
+
+write_syms(Stream, N, Dot, Syms) -->
+ ( { N = Dot } ->
+ write_string(Stream, ". ")
+ ;
+ []
+ ),
+ { array__max(Syms, Max) },
+ ( { N =< Max } ->
+ { lookup(Syms, N, Sym) },
+ write(Stream, Sym),
+ write_string(Stream, " "),
+ write_syms(Stream, N + 1, Dot, Syms)
+ ;
+ []
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- 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.
+
+get_moose_elements([], Remainder, Remainder, _WhereAmI, MParser, MParser,
+ RuleDecls, RuleDecls, Clauses, Clauses, Actions, Actions).
+get_moose_elements([Element|Elements], Remainder0, Remainder, WhereAmI0,
+ MParser0, MParser, RuleDecls0, RuleDecls, Clauses0, Clauses,
+ Actions0, Actions) :-
+ (
+ Element = misc(ClauseTerm, ClauseVarSet),
+ term_to_clause(ClauseTerm, ClauseVarSet, _, Clause)
+ ->
+ WhereAmI = WhereAmI0,
+ Remainder1 = Remainder0,
+ MParser1 = MParser0,
+ RuleDecls1 = RuleDecls0,
+ Clauses1 = [Clause|Clauses0],
+ Actions1 = Actions0
+ ;
+ Element = misc(MiscTerm0, _),
+ interface_term(MiscTerm0)
+ ->
+ WhereAmI = (interface),
+ Remainder1 = [Element|Remainder0],
+ MParser1 = MParser0,
+ RuleDecls1 = RuleDecls0,
+ Clauses1 = Clauses0,
+ Actions1 = Actions0
+ ;
+ Element = misc(MiscTerm1, _),
+ implementation_term(MiscTerm1)
+ ->
+ WhereAmI = (implementation),
+ Remainder1 = [Element|Remainder0],
+ MParser1 = MParser0,
+ RuleDecls1 = RuleDecls0,
+ Clauses1 = Clauses0,
+ Actions1 = Actions0
+ ;
+ Element = misc(MiscTerm2, MiscVarSet2),
+ rule_term(MiscTerm2, MiscVarSet2, RuleDecl)
+ ->
+ WhereAmI = WhereAmI0,
+ Remainder1 = Remainder0,
+ MParser1 = MParser0,
+ RuleDecls1 = [RuleDecl|RuleDecls0],
+ Clauses1 = Clauses0,
+ Actions1 = Actions0
+ ;
+ Element = misc(MiscTerm3, MiscVarSet3),
+ parser_term(MiscTerm3, MiscVarSet3, WhereAmI0, Parser)
+ ->
+ WhereAmI = WhereAmI0,
+ Remainder1 = Remainder0,
+ MParser1 = [Parser|MParser0],
+ RuleDecls1 = RuleDecls0,
+ Clauses1 = Clauses0,
+ Actions1 = Actions0
+ ;
+ Element = misc(MiscTerm4, _),
+ xform_term(MiscTerm4, XForm)
+ ->
+ WhereAmI = WhereAmI0,
+ Remainder1 = Remainder0,
+ MParser1 = MParser0,
+ RuleDecls1 = RuleDecls0,
+ Clauses1 = Clauses0,
+ Actions1 = [XForm|Actions0]
+ ;
+ WhereAmI = WhereAmI0,
+ Remainder1 = [Element|Remainder0],
+ MParser1 = MParser0,
+ RuleDecls1 = RuleDecls0,
+ Clauses1 = Clauses0,
+ Actions1 = Actions0
+ ),
+ get_moose_elements(Elements, Remainder1, Remainder, WhereAmI,
+ MParser1, MParser, RuleDecls1, RuleDecls, Clauses1, Clauses,
+ Actions1, 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, varset, rule_decl).
+:- mode rule_term(in, in, 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, varset, whereami, parser).
+:- mode parser_term(in, in, in, out) is semidet.
+
+parser_term(functor(atom(":-"), [functor(atom("parse"), Args, _)], _),
+ _VarSet, WhereAmI, Decl) :-
+ Args = [StartIdTerm, EndTok, TokTerm, PrefixTerm],
+ StartIdTerm = functor(atom("/"), [functor(atom(Name), [], _),
+ functor(integer(Arity), _, _)], _),
+ StartId = Name / Arity,
+ TokTerm = functor(atom(TokAtom), [], _),
+ PrefixTerm = functor(atom(PrefixAtom), [], _),
+ Decl = parser(WhereAmI, StartId, EndTok, TokAtom, PrefixAtom).
+
+:- pred xform_term(term, xform).
+:- mode xform_term(in, out) is semidet.
+
+xform_term(Term, XForm) :-
+ Term = functor(atom(":-"), [
+ functor(atom("action"), [
+ functor(atom("/"), [
+ functor(atom(Name), [], _),
+ functor(integer(Arity), _, _)
+ ], _),
+ functor(atom(Pred), [], _)
+ ], _)
+ ], _),
+ XForm = xform(Name/Arity, Pred).
+
+%------------------------------------------------------------------------------%
+
+:- pred help(io__state, io__state).
+:- mode help(di, uo) is det.
+
+help -->
+ stderr_stream(StdErr),
+ write_strings(StdErr, [
+ "usage: moose <options> file ...\n",
+ " -h|--help help\n",
+ " -a|--dump-action dump the action table\n",
+ " -f|--dump-first dump the FIRST sets\n",
+ " -a|--dump-follow dump the FOLLOW sets\n",
+ " -a|--dump-goto dump the goto table\n",
+ " -a|--dump-items dump the item sets\n",
+ " -a|--dump-rules dump the flattened rules\n"
+ ]).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_action_table(actiontable, string, term, io__state, io__state).
+:- mode write_action_table(in, in, in, di, uo) is det.
+
+write_action_table(Table, TT, End) -->
+ write_strings([
+ ":- type parsing_action\n",
+ " ---> shift\n",
+ " ; reduce\n",
+ " ; accept\n",
+ " .\n",
+ "\n",
+ ":- pred actions(int, ", TT, ", parsing_action, int).\n",
+ ":- mode actions(in, in, out, out) is semidet.\n",
+ "\n"
+ ]),
+ foldl((pred(State::in, StateActions::in, di,uo) is det -->
+ { format("0x%x", [i(State)], SS) },
+ write_strings([
+ "actions(", SS, ",Tok, Action, Value) :-\n",
+ " actions", SS, "(Tok, Action, Value).\n",
+ "\n",
+ ":- pred actions", SS, "(", TT, ", parsing_action, int).\n",
+ ":- mode actions", SS, "(in, out, out) is semidet.\n",
+ "\n"
+ ]),
+ write_state_actions(SS, End, StateActions)
+ ), Table).
+
+:- pred write_state_actions(string, term, (terminal -> action),
+ io__state, io__state).
+:- mode write_state_actions(in, in, in, di, uo) is det.
+
+write_state_actions(SS, End, StateActions) -->
+ { format("actions%s", [s(SS)], Name) },
+ foldl((pred(Terminal::in, Action::in, di, uo) is det -->
+ { terminal_to_term(Terminal, End, Token) },
+ { context_init(Ctxt) },
+ { Term = functor(atom(Name),
+ [Token,
+ functor(atom(Kind), [], Ctxt),
+ functor(integer(Val), [], Ctxt)], Ctxt) },
+ (
+ { Action = shift(Val) },
+ { Kind = "shift" }
+ ;
+ { Action = reduce(Val) },
+ { Kind = "reduce" }
+ ;
+ { Action = accept },
+ { Kind = "accept" },
+ { Val = 0 }
+ ),
+ { init(Varset) },
+ term_io__write_term_nl(Varset, Term)
+ ), StateActions),
+ nl.
+
+:- pred terminal_to_term(terminal, term, term).
+:- mode terminal_to_term(in, in, out) is det.
+
+terminal_to_term(epsilon, _, _) :-
+ error("terminal_to_term: unexpected epsilon").
+terminal_to_term(Name/Arity, _, Term) :-
+ init(V0),
+ new_vars(V0, Arity, Vars, _),
+ context_init(Ctxt),
+ map((pred(Var::in, T::out) is det :-
+ T = variable(Var)
+ ), 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__state, io__state).
+:- mode write_goto_table(in, in, di, uo) is det.
+
+write_goto_table(Table, DeclTable) -->
+ { values(DeclTable, Decls) },
+ write_nonterminal_type(Decls),
+ write_strings([
+ ":- pred gotos(int, nonterminal, int).\n",
+ ":- mode gotos(in, in, out) is semidet.\n",
+ "\n"
+ ]),
+ foldl((pred(State::in, StateActions::in, di,uo) is det -->
+ { format("0x%x", [i(State)], SS) },
+ write_strings([
+ "gotos(", SS, ", NT, NS) :-\n",
+ " gotos", SS, "(NT, NS).\n",
+ "\n",
+ ":- pred gotos", SS, "(nonterminal, int).\n",
+ ":- mode gotos", SS, "(in, out) is semidet.\n",
+ "\n"
+ ]),
+ write_state_gotos(SS, StateActions)
+ ), Table).
+
+:- pred write_nonterminal_type(list(rule_decl), io__state, io__state).
+:- mode write_nonterminal_type(in, di, uo) is det.
+
+write_nonterminal_type(Ds) -->
+ { 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) },
+ { context_init(Ctxt) },
+ { init(Varset) },
+ { Type = disj(functor(atom("nonterminal"), [], Ctxt), NTTypes) },
+ { Element = type(Type, Varset) },
+ write_element(nolines, Element),
+ nl.
+
+:- pred write_state_gotos(string, (nonterminal -> grammar__state),
+ io__state, io__state).
+:- mode write_state_gotos(in, in, di, uo) is det.
+
+write_state_gotos(SS, StateActions) -->
+ { format("gotos%s", [s(SS)], Name) },
+ foldl((pred(NT::in, NS::in, di, uo) is det -->
+ { nonterminal_to_term(NT, Token) },
+ { context_init(Ctxt) },
+ { Term = functor(atom(Name),
+ [Token, functor(integer(NS), [], Ctxt)], Ctxt) },
+ { init(Varset) },
+ term_io__write_term_nl(Varset, Term)
+ ), StateActions),
+ nl.
+
+:- pred nonterminal_to_term(nonterminal, term).
+:- mode nonterminal_to_term(in, out) is det.
+
+nonterminal_to_term(start, _) :-
+ error("nonterminal_to_term: unexpected start").
+nonterminal_to_term(Name/Arity, Term) :-
+ init(V0),
+ new_vars(V0, Arity, Vars, _),
+ context_init(Ctxt),
+ map((pred(Var::in, T::out) is det :-
+ T = variable(Var)
+ ), Vars, Args),
+ Term = functor(atom(Name), Args, Ctxt).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_parser(whereami, nonterminal, rule_decl, string,
+ io__state, io__state).
+:- mode write_parser(in, in, in, in, di, uo) is det.
+
+write_parser(Where, NT, Decl, TT) -->
+ (
+ { NT = StartName/StartArity }
+ ;
+ { NT = start },
+ { error("write_parser: start!") }
+ ),
+ { Decl = rule(_, DeclArgs, DeclVarset, DeclCtxt) },
+ { init(Varset0) },
+ { mkstartargs(StartArity, [], StartArgs, Varset0, Varset) },
+ { StartTerm = functor(atom(StartName), StartArgs, Ctxt) },
+ { context_init(Ctxt) },
+ { ParseResultType = type(disj(functor(atom("presult"), [], Ctxt),
+ [OkayType, ErrorType]), DeclVarset) },
+ { OkayType = functor(atom(StartName), DeclArgs, DeclCtxt) },
+ { ErrorType = functor(atom("error"), [
+ functor(atom("string"), [], Ctxt)], Ctxt) },
+ ( { Where = (interface) } ->
+ write_string(":- interface.\n\n")
+ ;
+ []
+ ),
+ write_element(nolines, ParseResultType),
+ nl,
+ write_strings([
+ ":- import_module list.\n\n",
+ ":- pred parse(P, presult, P) <= parser_state(P).\n",
+ ":- mode parse(in, out, out) is det.\n",
+ "\n"
+ ]),
+ ( { Where = (interface) } ->
+ write_string(":- implementation.\n\n")
+ ;
+ []
+ ),
+ write_strings([
+"parse(Toks0, Result, Toks) :-\n",
+" parse(Toks0, Toks, [0], [], Result).\n",
+"\n",
+":- pred parse(P, P, statestack, symbolstack, presult) <= parser_state(P).\n",
+":- mode parse(in, out, in, in, out) is det.\n",
+"\n",
+"parse(Toks0, Toks, St0, Sy0, Res) :-\n",
+" (\n",
+" St0 = [S0|_],\n",
+" ( \n",
+" get_token(Tok, Toks0, Toks1)\n",
+" ->\n",
+" ( \n",
+" actions(S0, Tok, What, Val)\n",
+" ->\n",
+" (\n",
+" What = shift,\n",
+" Sy1 = [t(Tok)|Sy0],\n",
+" St1 = [Val|St0],\n",
+" parse(Toks1, Toks, St1, Sy1, Res)\n",
+" ;\n",
+" What = reduce,\n",
+" reduce(Val, St0, St1, Sy0, Sy1, Toks0, Toks2),\n",
+" parse(Toks2, Toks, St1, Sy1, Res)\n",
+" ;\n",
+" What = accept,\n",
+" ( Sy0 = [n("
+ ]),
+ write_term(Varset, StartTerm),
+ write_strings([
+")] ->\n",
+" Res = ("
+ ]),
+ write_term(Varset, StartTerm),
+ write_strings([
+"),\n",
+" Toks = Toks1\n",
+" ;\n",
+" error(""parse: internal accept error"")\n",
+" )\n",
+" )\n",
+" ;\n",
+" Res = error(""parse error""),\n",
+" Toks = Toks0\n",
+" )\n",
+" ;\n",
+" Res = error(""unexpected end of input""),\n",
+" Toks = Toks0\n",
+" )\n",
+" ;\n",
+" St0 = [],\n",
+" error(""parse: state stack underflow"")\n",
+" ).\n",
+"\n"
+ ]).
+
+:- pred mkstartargs(int, list(term), list(term), varset, varset).
+:- mode mkstartargs(in, in, out, in, out) is det.
+
+mkstartargs(N, Ts0, Ts, VS0, VS) :-
+ ( N =< 0 ->
+ Ts = Ts0,
+ VS = VS0
+ ;
+ format("V%d", [i(N)], VarName),
+ new_named_var(VS0, VarName, Var, VS1),
+ T = variable(Var),
+ Ts1 = [T|Ts0],
+ mkstartargs(N - 1, Ts1, Ts, VS1, VS)
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred write_reductions(rules, string, xforms, io__state, io__state).
+:- mode write_reductions(in, in, in, di, uo) is det.
+
+write_reductions(Rules, TT, Xfns) -->
+ write_strings([
+":- import_module require, std_util.\n",
+"\n",
+":- type statestack == list(int).\n",
+":- type symbolstack == list(stacksymbol).\n",
+":- type stacksymbol\n",
+" ---> n(nonterminal)\n",
+" ; t(", TT, ").\n",
+"\n",
+":- pred reduce(int, statestack, statestack, symbolstack, symbolstack,\n",
+" P, P) <= parser_state(P).\n",
+":- mode reduce(in, in, out, in, out, in, out) is det.\n",
+"\n",
+"reduce(RuleNum, States0, States, Symbols0, Symbols, Tokens0, Tokens) :-\n",
+" (\n",
+" reduce0(RuleNum, States0, States1, Symbols0, Symbols1,\n",
+" Tokens0, Tokens1),\n",
+" States1 = [State0|_States2],\n",
+" Symbols1 = [n(Non)|_],\n",
+" gotos(State0, Non, State1),\n",
+" States3 = [State1|States1]\n",
+" ->\n",
+" States = States3,\n",
+" Symbols = Symbols1,\n",
+" Tokens = Tokens1\n",
+" ;\n",
+" error(""reduce: reduction failed"")\n",
+" ).\n",
+"\n",
+":- pred reduce0(int, statestack, statestack, symbolstack, symbolstack,\n",
+" P, P) <= parser_state(P).\n",
+":- mode reduce0(in, in, out, in, out, in, out) is semidet.\n",
+"\n"
+ ]),
+ foldl((pred(Rn::in, Rule::in, di, uo) is det -->
+ ( { Rn \= 0 } ->
+ { format("reduce0x%x", [i(Rn)], RedName) },
+ { format("0x%x", [i(Rn)], RnS) },
+ write_strings([
+"reduce0(", RnS, ", S0, S, T0, T, U0, U) :-\n",
+" ", RedName, "(S0, S, T0, T, U0, U).\n",
+"\n",
+":- pred ", RedName, "(statestack, statestack, symbolstack, symbolstack,\n",
+" P, P) <= parser_state(P).\n",
+":- mode ", RedName, "(in, out, in, out, in, out) is det.\n",
+"\n"
+ ]),
+ { Rule = rule(RNt, Head, _, Body, Actions, Varset0, _C) },
+ { new_named_var(Varset0, "M_St0", St0v, Varset1) },
+ { St0 = variable(St0v) },
+ { new_named_var(Varset1, "M_St1", St1v, Varset2) },
+ { St1 = variable(St1v) },
+ { new_named_var(Varset2, "M_Sy0", Sy0v, Varset3) },
+ { Sy0 = variable(Sy0v) },
+ { new_named_var(Varset3, "M_Sy1", Sy1v, Varset4) },
+ { Sy1 = variable(Sy1v) },
+ { new_named_var(Varset4, "M_RedRes", Resv, Varset5) },
+ { Res = variable(Resv) },
+ { ResS = functor(atom("n"), [variable(Resv)], Ctxt) },
+ { new_named_var(Varset5, "M_D", Dv, Varset6) },
+ { _D = variable(Dv) },
+ { new_named_var(Varset6, "M_S", Sv, Varset7) },
+ { _S = variable(Sv) },
+ { new_named_var(Varset7, "M_St", Stv, Varset8) },
+ { St = variable(Stv) },
+ { new_named_var(Varset8, "M_Sy", Syv, Varset9) },
+ { Sy = variable(Syv) },
+ { new_named_var(Varset9, "M_Ts0", Ts0v, Varset10) },
+ { Ts0 = variable(Ts0v) },
+ { new_named_var(Varset10, "M_Ts", Tsv, Varset11) },
+ { Ts = variable(Tsv) },
+ { context_init(Ctxt) },
+ { 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) },
+ { append(Actions, [Red], AllActions0) },
+ { 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) },
+ (
+ { search(Xfns, RNt, xform(_, XFormName)) },
+ { Head = functor(_, HeadArgs, _) }
+ ->
+ { append(HeadArgs, [Ts0, Ts], Then1Args) },
+ { Then1 = functor(atom(XFormName), Then1Args, Ctxt) }
+ ;
+ { Then1 = functor(atom("="), [Ts0, Ts], 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),
+ nl
+ ; [] )
+ ), Rules).
+
+:- pred mkstacks(list(bodyterm), term, term, term, term, varset, varset).
+:- mode mkstacks(in, in, out, in, out, in, out) is det.
+
+mkstacks([], St, St, Sy, Sy, VS, VS).
+mkstacks([E0|Es], St0, St, Sy0, Sy, VS0, VS) :-
+ new_var(VS0, U, VS1),
+ context_init(Ctxt),
+ (
+ E0 = terminal(ET),
+ E = functor(atom("t"), [ET], Ctxt)
+ ;
+ E0 = nonterminal(EN),
+ E = functor(atom("n"), [EN], Ctxt)
+ ),
+ Sy1 = functor(atom("."), [E, Sy0], Ctxt),
+ St1 = functor(atom("."), [variable(U), St0], Ctxt),
+ mkstacks(Es, St1, St, Sy1, Sy, VS1, VS).
+
+:- pred mkactions(list(term), term, term).
+:- mode mkactions(in, in, out) is det.
+
+mkactions([], Term, Term).
+mkactions([E|Es], Term0, Term) :-
+ context_init(Ctxt),
+ Term1 = functor(atom(","), [E, Term0], Ctxt),
+ mkactions(Es, Term1, Term).
+
+%------------------------------------------------------------------------------%
+
+:- pred sub(string, list(pair(string)), string).
+:- mode sub(in, in, out) is det.
+
+sub(Orig, Subs, Final) :-
+ foldl((pred(Sub::in, S0::in, S1::out) is det :-
+ Sub = From - To,
+ string__replace_all(S0, From, To, S1)
+ ), Subs, Orig, Final).
+
Index: options.m
===================================================================
RCS file: options.m
diff -N options.m
--- /dev/null Tue May 16 14:50:59 2000
+++ options.m Tue May 2 13:34:20 2000
@@ -0,0 +1,79 @@
+:- module options.
+
+:- interface.
+
+:- import_module getopt, io, list, string.
+
+:- type option
+ ---> help
+ ; verbose
+
+ % Debugging options
+ ; dump_action
+ ; dump_first
+ ; dump_follow
+ ; dump_goto
+ ; dump_items
+ ; dump_rules
+
+ % Output options
+ .
+
+:- 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.
+
+:- implementation.
+
+:- import_module bool, char, std_util.
+
+parse_options(MOpts, Args) -->
+ io__command_line_arguments(Args0),
+ { OptionOpts = option_ops(short, long, defaults) },
+ { getopt__process_options(OptionOpts, Args0, Args, MOpts) }.
+
+:- pred short(char, option).
+:- mode short(in, 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).
+
+:- pred long(string, option).
+:- mode long(in, 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).
+
+:- pred defaults(option, option_data).
+:- mode defaults(out, out) is nondet.
+
+defaults(Opt, Data) :-
+ semidet_succeed,
+ defaults0(Opt, Data).
+
+:- pred defaults0(option, option_data).
+:- mode defaults0(out, out) is multi.
+
+defaults0(help, bool(no)).
+defaults0(verbose, bool(no)).
+defaults0(dump_action, bool(no)).
+defaults0(dump_first, bool(no)).
+defaults0(dump_follow, bool(no)).
+defaults0(dump_goto, bool(no)).
+defaults0(dump_items, bool(no)).
+defaults0(dump_rules, bool(no)).
+
Index: tables.m
===================================================================
RCS file: tables.m
diff -N tables.m
--- /dev/null Tue May 16 14:50:59 2000
+++ tables.m Sat May 6 18:29:01 2000
@@ -0,0 +1,218 @@
+:- module tables.
+
+:- interface.
+
+:- import_module grammar, lalr, misc.
+:- import_module int, list, set.
+
+:- type states == (items -> int).
+
+:- type shifts == (nonterminal -> set(terminal)).
+
+:- type actionerrors == list(actionerr).
+
+:- type actionerr
+ ---> warning(actionwarning)
+ ; error(actionerror)
+ .
+
+:- type actionwarning
+ ---> shiftreduce(state, prodnum)
+ .
+
+:- type actionerror
+ ---> 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 actions(set(items), rules, lookaheads, gotos, shifts,
+ states, actiontable, actionerrors).
+:- mode actions(in, in, in, in, in, out, out, out) is det.
+
+:- pred gotos(set(items), states, gotos, gototable).
+:- mode gotos(in, in, in, out) is det.
+
+:- implementation.
+
+:- import_module array, bool, map, require, std_util, term.
+
+%------------------------------------------------------------------------------%
+
+shifts(_C, _Rules, First, Reaching, Shifts) :-
+ init(Shifts0),
+ foldl((pred(N::in, Ts0::in, Ss0::in, Ss::out) is det :-
+ ( search(Reaching, N, Ns0) ->
+ set__to_sorted_list(Ns0, Ns1)
+ ;
+ Ns1 = []
+ ),
+ map(lookup(First), Ns1, Ts1),
+ foldl(union, Ts1, Ts0, Ts2),
+ Ts = Ts2 - { epsilon },
+ set(Ss0, N, Ts, Ss)
+ ), First, Shifts0, Shifts).
+
+%------------------------------------------------------------------------------%
+
+actions(C, Rules, Lookaheads, Gotos, Shifts, States, Actions, Errs) :-
+ set__to_sorted_list(C, CList),
+ init(States0),
+ number_states(CList, 0, States0, States),
+ init(Actions0),
+ actions1(CList, Rules, Lookaheads, States, Gotos, Shifts,
+ Actions0, Actions, [], Errs).
+
+:- pred number_states(list(items), int, states, states).
+:- mode number_states(in, in, in, out) is det.
+
+number_states([], _N, States, States).
+number_states([I|Is], N, States0, States) :-
+ map__det_insert(States0, I, N, States1),
+ number_states(Is, N + 1, States1, 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.
+
+actions1([], _Rules, _Lookaheads, _States, _Gotos, _Shifts,
+ Actions, Actions, Errs, Errs).
+actions1([I|Is], Rules, Lookaheads, States, Gotos, Shifts,
+ Actions0, Actions, Errs0, Errs) :-
+ lookup(States, I, Sn),
+ set__to_sorted_list(I, IList),
+ actions2(IList, I, Sn, Rules, Lookaheads, States, Gotos, Shifts,
+ Actions0, Actions1, Errs0, Errs1),
+ actions1(Is, Rules, Lookaheads, States, Gotos, Shifts,
+ Actions1, Actions, Errs1, 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.
+
+actions2([], _I, _Sn, _Rules, _LA, _States, _Gotos, _Shifts,
+ Actions, Actions, Errs, Errs).
+actions2([A|As], I, Sn, Rules, LA, States, Gotos, Shifts,
+ Actions0, Actions, Errs0, Errs) :-
+ A = item(Ip, Id),
+ lookup(Rules, Ip, rule(_, _, Syms, _, _, _, _)),
+ array__max(Syms, Max),
+ ( Id =< Max ->
+ lookup(Syms, Id, X),
+ lookup(Gotos, I, IGs),
+ (
+ X = terminal(T0),
+ Ts = { T0 }
+ ;
+ X = nonterminal(N),
+ ( search(Shifts, N, Ts0) ->
+ Ts = Ts0
+ ;
+ Ts = empty
+ )
+ ),
+ set__to_sorted_list(Ts, TList),
+ foldl2((pred(T::in, Ac0::in, Ac::out, in, out) is det -->
+ { lookup(IGs, terminal(T), J) },
+ { lookup(States, J, Jn) },
+ addaction(Sn, T, shift(Jn), Ac0, Ac)
+ ), TList, Actions0, Actions1, Errs0, Errs1)
+ ;
+ % A -> alpha .
+ (
+ search(LA, I, ILAs),
+ search(ILAs, A, Alphas)
+ ->
+ set__to_sorted_list(Alphas, AlphaList),
+ foldl2((pred(T::in, A0::in, A1::out, in, out) is det -->
+ ( { Ip = 0, T = ($) } ->
+ addaction(Sn, T, accept, A0, A1)
+ ;
+ addaction(Sn, T, reduce(Ip), A0, A1)
+ )
+ ), AlphaList, Actions0, Actions1, Errs0, Errs1)
+ ;
+ Actions1 = Actions0,
+ Errs1 = Errs0
+ )
+ ),
+ actions2(As, I, Sn, Rules, LA, States, Gotos, Shifts,
+ Actions1, Actions, Errs1, Errs).
+
+:- pred addaction(state, terminal, action, actiontable, actiontable,
+ actionerrors, actionerrors).
+:- mode addaction(in, in, in, in, out, in, out) is det.
+
+addaction(Sn, T, A0, Actions0, Actions, Errs0, Errs) :-
+ ( search(Actions0, Sn, State0) ->
+ State1 = State0
+ ;
+ init(State1)
+ ),
+ ( search(State1, T, A1) ->
+ ( A0 = A1 ->
+ A = A1,
+ Errs = Errs0
+ ;
+ (
+ 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,
+ Errs = [Err|Errs0]
+ ;
+ 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))
+ ),
+ Errs = [Err|Errs0]
+ )
+ ;
+ A = A0,
+ Errs = Errs0
+ ),
+ set(State1, T, A, State),
+ set(Actions0, Sn, State, Actions).
+
+%------------------------------------------------------------------------------%
+
+gotos(_C, States, Gotos, GotoTable) :-
+ init(GotoTable0),
+ foldl((pred(I0::in, IGs::in, in, out) is det -->
+ { lookup(States, I0, Sf) },
+ foldl((pred(Sym::in, J0::in, GT0::in, GT::out) is det :-
+ ( Sym = nonterminal(N) ->
+ lookup(States, J0, St),
+ ( search(GT0, Sf, X0) ->
+ X1 = X0
+ ;
+ init(X1)
+ ),
+ set(X1, N, St, X),
+ set(GT0, Sf, X, GT)
+ ;
+ GT = GT0
+ )
+ ), IGs)
+ ), Gotos, GotoTable0, GotoTable).
Index: samples/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null Tue May 16 14:50:59 2000
+++ Mmakefile Fri May 19 16:11:44 2000
@@ -0,0 +1,18 @@
+
+.SUFFIXES: .m .moo
+
+default_target : all
+
+depend : try_alpha.depend try_expr.depend
+
+try_alpha.depend: alpha.m
+try_expr.depend: expr.m
+
+all: try_alpha try_expr cgram.m small.m
+
+.moo.m:
+ ../moose $<
+
+realclean:
+ rm -f alpha.m expr.m small.m cgram.m
+
Index: samples/README
===================================================================
RCS file: README
diff -N README
--- /dev/null Tue May 16 14:50:59 2000
+++ README Fri May 19 16:11:01 2000
@@ -0,0 +1,10 @@
+
+alpha.moo: A small expression grammar + lexer.
+
+expr.moo: A larger expression grammar + lexer.
+
+cgram.moo: A grammar for C, which includes an action.
+ However there is no lexer provided.
+
+small.moo: A grammar for a small C like language.
+
Index: samples/alpha.input
===================================================================
RCS file: alpha.input
diff -N alpha.input
--- /dev/null Tue May 16 14:50:59 2000
+++ alpha.input Fri May 19 10:37:38 2000
@@ -0,0 +1,2 @@
+1 + 2
+3 + 4
Index: samples/alpha.moo
===================================================================
RCS file: alpha.moo
diff -N alpha.moo
--- /dev/null Tue May 16 14:50:59 2000
+++ alpha.moo Fri May 19 10:20:19 2000
@@ -0,0 +1,60 @@
+:- module alpha.
+
+:- interface.
+
+:- import_module char, int, list.
+
+:- type token
+ ---> ('+')
+ ; num(int)
+ ; ('(')
+ ; (')')
+ ; ('$')
+ .
+
+:- parse(exprn/1, ('$'), token, xx).
+
+:- pred scan(list(char), list(token)).
+:- mode scan(in, out) is semidet.
+
+:- implementation.
+
+:- import_module string.
+
+:- rule exprn(int).
+exprn(Num) ---> exprn(A), [+], term(B), { Num = A + B }.
+exprn(Term) ---> term(Term).
+
+:- rule term(int).
+term(Num) ---> factor(Num).
+
+:- rule factor(int).
+factor(Num) ---> ['('], exprn(Num), [')'].
+factor(Num) ---> [num(Num)].
+
+scan(Chars, Toks) :-
+ scan(Chars, [], Toks0),
+ list__reverse(Toks0, Toks).
+
+:- pred scan(list(char), list(token), list(token)).
+:- mode scan(in, in, out) is semidet.
+
+scan([], Toks, ['$'|Toks]).
+scan([C|Cs], Toks0, Toks) :-
+ ( char__is_whitespace(C) ->
+ scan(Cs, Toks0, Toks)
+ ; char__is_digit(C) ->
+ takewhile(char__is_digit, [C|Cs], Digits, Rest),
+ string__from_char_list(Digits, NumStr),
+ string__to_int(NumStr, Num),
+ scan(Rest, [num(Num)|Toks0], Toks)
+ ; C = ('+') ->
+ scan(Cs, ['+'|Toks0], Toks)
+ ; C = ('(') ->
+ scan(Cs, ['('|Toks0], Toks)
+ ; C = (')') ->
+ scan(Cs, [')'|Toks0], Toks)
+ ;
+ fail
+ ).
+
Index: samples/cgram.moo
===================================================================
RCS file: cgram.moo
diff -N cgram.moo
--- /dev/null Tue May 16 14:50:59 2000
+++ cgram.moo Fri May 19 14:14:31 2000
@@ -0,0 +1,501 @@
+:- module cgram.
+
+:- interface.
+
+:- parse(file/0, ('$'), token, 'x').
+
+:- type token --->
+('!'); ('!='); ('$'); ('%');
+('%='); ('&&'); ('&'); ('&=');
+('('); (')'); ('*'); ('*=');
+('+'); ('++'); ('+='); (',');
+('-'); ('--'); ('-='); ('->');
+('.'); ('...'); ('/'); ('/=');
+(':'); (';'); ('<'); ('<<');
+('<<='); ('<='); ('='); ('==');
+('>'); ('>='); ('>>'); ('>>=');
+('?'); ('['); (']'); ('^');
+('^='); ('auto'); ('break'); ('case');
+('char'); ('const'); ('continue'); ('default');
+('do'); ('double'); ('else'); ('enum');
+('extern'); ('float'); ('for'); ('goto');
+('id'); ('if'); ('int'); ('literal'); ('long');
+('register'); ('return'); ('short'); ('signed');
+('sizeof'); ('static'); ('string'); ('struct');
+('switch'); ('type_name'); ('typedef'); ('union');
+('unsigned'); ('void'); ('volatile'); ('while');
+('{'); ('|'); ('|='); ('||'); ('}'); ('~').
+
+:- implementation.
+
+:- rule primary_expr.
+primary_expr --->
+ identifier
+ ; [literal]
+ ; [string]
+ ; ['('], expr, [')']
+ .
+
+:- rule postfix_expr.
+postfix_expr --->
+ primary_expr
+ ; postfix_expr, [('[')], expr, [(']')]
+ ; postfix_expr, ['('], [')']
+ ; postfix_expr, ['('], argument_expr_list, [')']
+ ; postfix_expr, ['.'], identifier
+ ; postfix_expr, ['->'], identifier
+ ; postfix_expr, ['++']
+ ; postfix_expr, ['--']
+ .
+
+:- rule argument_expr_list.
+argument_expr_list --->
+ assignment_expr
+ ; argument_expr_list, [','], assignment_expr
+ .
+
+:- rule unary_expr.
+unary_expr --->
+ postfix_expr
+ ; ['++'], unary_expr
+ ; ['--'], unary_expr
+ ; unary_operator, cast_expr
+ ; [sizeof], unary_expr
+ ; [sizeof], ['('], type_name, [')']
+ .
+
+:- rule unary_operator.
+unary_operator --->
+ ['&']
+ ; ['*']
+ ; ['+']
+ ; ['-']
+ ; ['~']
+ ; ['!']
+ .
+
+:- rule cast_expr.
+cast_expr --->
+ unary_expr
+ ; ['('], type_name, [')'], cast_expr
+ .
+
+:- rule multiplicative_expr.
+multiplicative_expr --->
+ cast_expr
+ ; multiplicative_expr, ['*'], cast_expr
+ ; multiplicative_expr, ['/'], cast_expr
+ ; multiplicative_expr, ['%'], cast_expr
+ .
+
+:- rule additive_expr.
+additive_expr --->
+ multiplicative_expr
+ ; additive_expr, ['+'], multiplicative_expr
+ ; additive_expr, ['-'], multiplicative_expr
+ .
+
+:- rule shift_expr.
+shift_expr --->
+ additive_expr
+ ; shift_expr, ['<<'], additive_expr
+ ; shift_expr, ['>>'], additive_expr
+ .
+
+:- rule relational_expr.
+relational_expr --->
+ shift_expr
+ ; relational_expr, ['<'], shift_expr
+ ; relational_expr, ['>'], shift_expr
+ ; relational_expr, ['<='], shift_expr
+ ; relational_expr, ['>='], shift_expr
+ .
+
+:- rule equality_expr.
+equality_expr --->
+ relational_expr
+ ; equality_expr, ['=='], relational_expr
+ ; equality_expr, ['!='], relational_expr
+ .
+
+:- rule and_expr.
+and_expr --->
+ equality_expr
+ ; and_expr, ['&'], equality_expr
+ .
+
+:- rule exclusive_or_expr.
+exclusive_or_expr --->
+ and_expr
+ ; exclusive_or_expr, ['^'], and_expr
+ .
+
+:- rule inclusive_or_expr.
+inclusive_or_expr --->
+ exclusive_or_expr
+ ; inclusive_or_expr, ['|'], exclusive_or_expr
+ .
+
+:- rule logical_and_expr.
+logical_and_expr --->
+ inclusive_or_expr
+ ; logical_and_expr, ['&&'], inclusive_or_expr
+ .
+
+:- rule logical_or_expr.
+logical_or_expr --->
+ logical_and_expr
+ ; logical_or_expr, ['||'], logical_and_expr
+ .
+
+:- rule conditional_expr.
+conditional_expr --->
+ logical_or_expr
+ ; logical_or_expr, ['?'], logical_or_expr, [':'], conditional_expr
+ .
+
+:- rule assignment_expr.
+assignment_expr --->
+ conditional_expr
+ ; unary_expr, assignment_operator, assignment_expr
+ .
+
+:- rule assignment_operator.
+assignment_operator --->
+ ['=']
+ ; ['*=']
+ ; ['/=']
+ ; ['%=']
+ ; ['+=']
+ ; ['-=']
+ ; ['<<=']
+ ; ['>>=']
+ ; ['&=']
+ ; ['^=']
+ ; ['|=']
+ .
+
+:- rule expr.
+expr --->
+ assignment_expr
+ ; expr, [','], assignment_expr
+ .
+
+:- rule constant_expr.
+constant_expr --->
+ conditional_expr
+ .
+
+:- rule declaration.
+declaration --->
+ declaration_specifiers, [';']
+ ; declaration_specifiers, init_declarator_list, [';']
+ .
+
+:- action(declaration/0, handle_typedefs).
+
+:- rule declaration_specifiers.
+declaration_specifiers --->
+ storage_class_specifier
+ ; storage_class_specifier, declaration_specifiers
+ ; type_specifier
+ ; type_specifier, declaration_specifiers
+ .
+
+:- rule init_declarator_list.
+init_declarator_list --->
+ init_declarator
+ ; init_declarator_list, [','], init_declarator
+ .
+
+:- rule init_declarator.
+init_declarator --->
+ declarator
+ ; declarator, ['='], initializer
+ .
+
+:- rule storage_class_specifier.
+storage_class_specifier --->
+ [typedef]
+ ; [extern]
+ ; [static]
+ ; [auto]
+ ; [register]
+ .
+
+:- rule type_specifier.
+type_specifier --->
+ [char]
+ ; [short]
+ ; [int]
+ ; [long]
+ ; [signed]
+ ; [unsigned]
+ ; [float]
+ ; [double]
+ ; [const]
+ ; [volatile]
+ ; [void]
+ ; struct_or_union_specifier
+ ; enum_specifier
+ ; [type_name]
+ .
+
+:- rule struct_or_union_specifier.
+struct_or_union_specifier --->
+ struct_or_union, identifier, ['{'], struct_declaration_list, ['}']
+ ; struct_or_union, ['{'], struct_declaration_list, ['}']
+ ; struct_or_union, identifier
+ .
+
+:- rule struct_or_union.
+struct_or_union --->
+ [struct]
+ ; [union]
+ .
+
+:- rule struct_declaration_list.
+struct_declaration_list --->
+ struct_declaration
+ ; struct_declaration_list, struct_declaration
+ .
+
+:- rule struct_declaration.
+struct_declaration --->
+ type_specifier_list, struct_declarator_list, [';']
+ .
+
+:- rule struct_declarator_list.
+struct_declarator_list --->
+ struct_declarator
+ ; struct_declarator_list, [','], struct_declarator
+ .
+
+:- rule struct_declarator.
+struct_declarator --->
+ declarator
+ ; [':'], constant_expr
+ ; declarator, [':'], constant_expr
+ .
+
+:- rule enum_specifier.
+enum_specifier --->
+ [enum], ['{'], enumerator_list, ['}']
+ ; [enum], identifier, ['{'], enumerator_list, ['}']
+ ; [enum], identifier
+ .
+
+:- rule enumerator_list.
+enumerator_list --->
+ enumerator
+ ; enumerator_list, [','], enumerator
+ .
+
+:- rule enumerator.
+enumerator --->
+ identifier
+ ; identifier, ['='], constant_expr
+ .
+
+:- rule declarator.
+declarator --->
+ declarator2
+ ; pointer, declarator2
+ .
+
+:- rule declarator2.
+declarator2 --->
+ identifier
+ ; ['('], declarator, [')']
+ ; declarator2, ['['], [']']
+ ; declarator2, ['['], constant_expr, [']']
+ ; declarator2, ['('], [')']
+ ; declarator2, ['('], parameter_type_list, [')']
+ ; declarator2, ['('], parameter_identifier_list, [')']
+ .
+
+:- rule pointer.
+pointer --->
+ ['*']
+ ; ['*'], type_specifier_list
+ ; ['*'], pointer
+ ; ['*'], type_specifier_list, pointer
+ .
+
+:- rule type_specifier_list.
+type_specifier_list --->
+ type_specifier
+ ; type_specifier_list, type_specifier
+ .
+
+:- rule parameter_identifier_list.
+parameter_identifier_list --->
+ identifier_list
+ ; identifier_list, [','], ['...']
+ .
+
+:- rule identifier_list.
+identifier_list --->
+ identifier
+ ; identifier_list, [','], identifier
+ .
+
+:- rule parameter_type_list.
+parameter_type_list --->
+ parameter_list
+ ; parameter_list, [','], ['...']
+ .
+
+:- rule parameter_list.
+parameter_list --->
+ parameter_declaration
+ ; parameter_list, [','], parameter_declaration
+ .
+
+:- rule parameter_declaration.
+parameter_declaration --->
+ type_specifier_list, declarator
+ ; type_name
+ .
+
+:- rule type_name.
+type_name --->
+ type_specifier_list
+ ; type_specifier_list, abstract_declarator
+ .
+
+:- rule abstract_declarator.
+abstract_declarator --->
+ pointer
+ ; abstract_declarator2
+ ; pointer, abstract_declarator2
+ .
+
+:- rule abstract_declarator2.
+abstract_declarator2 --->
+ ['('], abstract_declarator, [')']
+ ; ['['], [']']
+ ; ['['], constant_expr, [']']
+ ; abstract_declarator2, ['['], [']']
+ ; abstract_declarator2, ['['], constant_expr, [']']
+ ; ['('], [')']
+ ; ['('], parameter_type_list, [')']
+ ; abstract_declarator2, ['('], [')']
+ ; abstract_declarator2, ['('], parameter_type_list, [')']
+ .
+
+:- rule initializer.
+initializer --->
+ assignment_expr
+ ; ['{'], initializer_list, ['}']
+ ; ['{'], initializer_list, [','], ['}']
+ .
+
+:- rule initializer_list.
+initializer_list --->
+ initializer
+ ; initializer_list, [','], initializer
+ .
+
+:- rule statement.
+statement --->
+ labeled_statement
+ ; compound_statement
+ ; expression_statement
+ ; selection_statement
+ ; iteration_statement
+ ; jump_statement
+ .
+
+:- rule labeled_statement.
+labeled_statement --->
+ identifier, [':'], statement
+ ; [case], constant_expr, [':'], statement
+ ; [default], [':'], statement
+ .
+
+:- rule compound_statement.
+compound_statement --->
+ ['{'], ['}']
+ ; ['{'], statement_list, ['}']
+ ; ['{'], declaration_list, ['}']
+ ; ['{'], declaration_list, statement_list, ['}']
+ .
+
+:- rule declaration_list.
+declaration_list --->
+ declaration
+ ; declaration_list, declaration
+ .
+
+:- rule statement_list.
+statement_list --->
+ statement
+ ; statement_list, statement
+ .
+
+:- rule expression_statement.
+expression_statement --->
+ [';']
+ ; expr, [';']
+ .
+
+:- rule selection_statement.
+selection_statement --->
+ [if], ['('], expr, [')'], statement
+ ; [if], ['('], expr, [')'], statement, [else], statement
+ ; [switch], ['('], expr, [')'], statement
+ .
+
+:- rule iteration_statement.
+iteration_statement --->
+ [while], ['('], expr, [')'], statement
+ ; [do], statement, [while], ['('], expr, [')'], [';']
+ ; [for], ['('], [';'], [';'], [')'], statement
+ ; [for], ['('], [';'], [';'], expr, [')'], statement
+ ; [for], ['('], [';'], expr, [';'], [')'], statement
+ ; [for], ['('], [';'], expr, [';'], expr, [')'], statement
+ ; [for], ['('], expr, [';'], [';'], [')'], statement
+ ; [for], ['('], expr, [';'], [';'], expr, [')'], statement % XXX
+ ; [for], ['('], expr, [';'], expr, [';'], [')'], statement
+ ; [for], ['('], expr, [';'], expr, [';'], expr, [')'], statement
+ .
+
+:- rule jump_statement.
+jump_statement --->
+ [goto], identifier, [';']
+ ; [continue], [';']
+ ; [break], [';']
+ ; [return], [';']
+ ; [return], expr, [';']
+ .
+
+:- rule file.
+file --->
+ external_definition
+ ; file, external_definition
+ .
+
+:- rule external_definition.
+external_definition --->
+ function_definition
+ ; declaration
+ .
+
+:- rule function_definition.
+function_definition --->
+ declarator, function_body
+ ; declaration_specifiers, declarator, function_body
+ .
+
+:- rule function_body.
+function_body --->
+ compound_statement
+ ; declaration_list, compound_statement
+ .
+
+:- rule identifier.
+identifier --->
+ [id]
+ .
+
Index: samples/expr.input
===================================================================
RCS file: expr.input
diff -N expr.input
--- /dev/null Tue May 16 14:50:59 2000
+++ expr.input Fri May 19 16:09:33 2000
@@ -0,0 +1,2 @@
+7 + 10 / 2
+(3 + 4) * 5
Index: samples/expr.moo
===================================================================
RCS file: expr.moo
diff -N expr.moo
--- /dev/null Tue May 16 14:50:59 2000
+++ expr.moo Fri May 19 10:06:15 2000
@@ -0,0 +1,72 @@
+:- module expr.
+
+:- interface.
+
+:- import_module char, int, list.
+
+:- type token
+ ---> ('+')
+ ; ('-')
+ ; ('*')
+ ; ('/')
+ ; num(int)
+ ; ('(')
+ ; (')')
+ ; ('$')
+ .
+
+:- parse(exprn/1, ('$'), token, xx).
+
+:- pred scan(list(char), list(token)).
+:- mode scan(in, out) is semidet.
+
+:- implementation.
+
+:- import_module string.
+
+:- rule exprn(int).
+exprn(Num) ---> exprn(A), [+], term(B), { Num = A + B }.
+exprn(Num) ---> exprn(A), [-], term(B), { Num = A - B }.
+exprn(Num) ---> term(Num).
+
+:- rule term(int).
+term(Num) ---> term(A), [*], factor(B), { Num = A * B }.
+term(Num) ---> term(A), [/], factor(B), { Num = A // B }.
+term(Num) ---> factor(Num).
+
+:- rule factor(int).
+factor(Num) ---> ['('], exprn(Num), [')'].
+factor(Num) ---> [num(Num)].
+
+scan(Chars, Toks) :-
+ scan(Chars, [], Toks0),
+ list__reverse(Toks0, Toks).
+
+:- pred scan(list(char), list(token), list(token)).
+:- mode scan(in, in, out) is semidet.
+
+scan([], Toks, ['$'|Toks]).
+scan([C|Cs], Toks0, Toks) :-
+ ( char__is_whitespace(C) ->
+ scan(Cs, Toks0, Toks)
+ ; char__is_digit(C) ->
+ takewhile(char__is_digit, [C|Cs], Digits, Rest),
+ string__from_char_list(Digits, NumStr),
+ string__to_int(NumStr, Num),
+ scan(Rest, [num(Num)|Toks0], Toks)
+ ; C = ('+') ->
+ scan(Cs, ['+'|Toks0], Toks)
+ ; C = ('-') ->
+ scan(Cs, ['-'|Toks0], Toks)
+ ; C = ('*') ->
+ scan(Cs, ['*'|Toks0], Toks)
+ ; C = ('/') ->
+ scan(Cs, ['/'|Toks0], Toks)
+ ; C = ('(') ->
+ scan(Cs, ['('|Toks0], Toks)
+ ; C = (')') ->
+ scan(Cs, [')'|Toks0], Toks)
+ ;
+ fail
+ ).
+
Index: samples/small.moo
===================================================================
RCS file: small.moo
diff -N small.moo
--- /dev/null Tue May 16 14:50:59 2000
+++ small.moo Tue May 2 13:35:25 2000
@@ -0,0 +1,155 @@
+:- module small.
+
+:- parse(program/1, ('$'), token, 'x').
+
+:- rule program(list(defn)).
+program(Defs) --->
+ (
+ definition(Def),
+ { Defs = [Def] }
+ ;
+ program(Defs0), definition(Def),
+ { append(Defs0, [Def], Defs) }
+ ).
+
+:- rule definition(defn).
+definition(Def) --->
+ (
+ globals(Glob), { Def = glob(Glob) }
+ ;
+ function(Fun), { Def = fun(Fun) }
+ ).
+
+:- rule globals(pair((type), list(id))).
+globals(Type - Vars) ---> type(Type), vars(Vars), [';'].
+
+:- rule function(fun).
+function(Fun) --->
+ type(RType), [id(Name)], ['('], parameters(Params), [')'],
+ compound(Stmnt),
+ { Fun = fun(Name, RType, Params, Stmnt) }.
+
+:- rule parameters(list(pair((type), id))).
+parameters([]) ---> [].
+parameters(PList) ---> parameter_list(PList).
+
+:- rule parameter_list(list(pair((type), id))).
+parameter_list(Params) --->
+ (
+ parameter(Param),
+ { Params = [Param] }
+ ;
+ parameter(Param), [','], parameter_list(Params0),
+ { Params = [Params0|Params] }
+ ).
+
+:- rule parameter(pair((type), id)).
+parameter(Type - Id) --->
+ type(Type), var(Id).
+
+:- rule compound(statement).
+compound(compound(Statements)) --->
+ ['{'], statements(Statements), ['}'].
+
+:- rule statements(list(statement)).
+statements(Statements) --->
+ (
+ statement(Statement),
+ { Statements = [Statement] }
+ ;
+ statements(Statements0), statement(Statement),
+ { Statements = [Statement|Statements0] }
+ ).
+
+:- rule statement(statement).
+statement(Stmnt) --->
+ compound(Stmnt)
+ ; ifthenelse(Stmnt)
+ ; while(Stmnt)
+ ; assignment(Stmnt)
+ .
+
+:- rule ifthenelse(statement).
+ifthenelse(Stmnt) --->
+ (
+ ['if'], ['('], expression(Cond), [')'], statement(Then),
+ { Stmnt = ite(Cond, Then, compound([])) }
+ ;
+ ['if'], ['('], expression(Cond), [')'],
+ statement(Then), ['else'], statement(Else),
+ { Stmnt = ite(Cond, Then, Else) }
+ ).
+
+:- rule while(statement).
+while(Stmnt) --->
+ ['while'], ['('], expression(Cond), [')'], statement(Body),
+ { Stmnt = while(Cond, Body) }.
+
+:- rule assignment(statement).
+assignment(assign(Var, Expr)) --->
+ var(Var), ['='], expression(Expr).
+
+:- rule expression(expression).
+expression(E) ---> expression(E0), ['+'], term(E1), { E = E0 + E1 }.
+expression(E) ---> expression(E0), ['-'], term(E1), { E = E0 - E1 }.
+expression(E) ---> term(E).
+
+:- rule term(expression).
+term(E) ---> term(E0), ['*'], factor(E1), { E = E0 * E1 }.
+term(E) ---> term(E0), ['/'], factor(E1), { E = E0 / E1 }.
+term(E) ---> factor(E).
+
+:- rule factor(expression).
+factor(E) --->
+ (
+ [id(Var)], { E = var(Var) }
+ ;
+ [num(Num)], { E = const(Num) }
+ ;
+ [id(Func)], ['('], vars(Args), [')'],
+ { E = fun(Func, Args) }
+ ;
+ ['('], expression(E), [')']
+ ).
+
+:- rule vars(list(id)).
+vars([]) ---> [].
+vars(Vars) ---> vars1(Vars).
+
+:- rule vars1(list(id)).
+vars1(Vars) --->
+ (
+ var(Var),
+ { Vars = [Var] }
+ ;
+ var(Var), [','], vars1(Vars0),
+ { Vars = [Var|Vars0] }
+ ).
+
+:- rule var(id).
+var(Id) ---> [id(Id)].
+
+:- rule type(type).
+type(Type) --->
+ (
+ [int],
+ { Type = int }
+ ;
+ ['('], types(Types), [')'],
+ { ( Types = [Type0] ->
+ Type = Type0
+ ;
+ Type = tuple(Types)
+ ) }
+ ).
+
+:- rule types(list(type)).
+types(Types) --->
+ (
+ type(Type),
+ { Types = [Type] }
+ ;
+ types(Types0), type(Type),
+ { append(Types0, [Type], Types) }
+ ).
+
Index: samples/try_alpha.m
===================================================================
RCS file: try_alpha.m
diff -N try_alpha.m
--- /dev/null Tue May 16 14:50:59 2000
+++ try_alpha.m Fri May 19 10:36:49 2000
@@ -0,0 +1,43 @@
+:- module try_alpha.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io:state, io:state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module alpha, list.
+
+:- type token_list == list(token).
+
+:- instance parser_state(token_list) where [
+ pred(get_token/3) is uncons
+].
+
+:- pred uncons(T::out, list(T)::in, list(T)::out) is semidet.
+
+uncons(X, Xs, Xs0) :- Xs = [X | Xs0].
+
+main -->
+ read_line(Res0),
+ (
+ { Res0 = ok(Chars) },
+ ( { scan(Chars, Toks) } ->
+ { parse(Toks, Res, RemainingToks) },
+ write(Res), nl,
+ write(RemainingToks), nl
+ ;
+ write_string("scanning error.\n")
+ ),
+ main
+ ;
+ { Res0 = eof }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ write_string(Msg), nl
+ ).
+
Index: samples/try_expr.m
===================================================================
RCS file: try_expr.m
diff -N try_expr.m
--- /dev/null Tue May 16 14:50:59 2000
+++ try_expr.m Fri May 19 14:08:18 2000
@@ -0,0 +1,43 @@
+:- module try_expr.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io:state, io:state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module expr, list.
+
+:- type token_list == list(token).
+
+:- instance parser_state(token_list) where [
+ pred(get_token/3) is uncons
+].
+
+:- pred uncons(T::out, list(T)::in, list(T)::out) is semidet.
+
+uncons(X, Xs, Xs0) :- Xs = [X | Xs0].
+
+main -->
+ read_line(Res0),
+ (
+ { Res0 = ok(Chars) },
+ ( { scan(Chars, Toks) } ->
+ { parse(Toks, Res, RemainingToks) },
+ write(Res), nl,
+ write(RemainingToks), nl
+ ;
+ write_string("scanning error.\n")
+ ),
+ main
+ ;
+ { Res0 = eof }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ write_string(Msg), nl
+ ).
+
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list