[m-rev.] For review: change moose to accept unique parser states

Ralph Becket rafe at cs.mu.OZ.AU
Wed Jan 30 16:08:06 AEDT 2002


Estimated hours taken: 20
Branches: main

I have changed moose to support user-specifiable parser state modes,
rather than just in/out.  In particular, this means the parser state
can now include the IO state (this will be useful in conjunction with
lex).

I have also made some changes to the interface.

This change is not backwards compatible.

extras/moose/README:
	Updated the documentation to reflect the new changes.

extras/moose/TODO:
	Removed this change from the TODO list.

extras/moose/grammar.m:
	Removed the unused EndToken argument from construct_grammar/5.

extras/moose/moose.m:
	Fairly extensive changes to support user-specifiable parser
	state modes.
	Changed the order of some arguments in .moo parse declarations.
	Changed the signature of action methods from preds to funcs.

extras/moose/samples/alpha.moo:
extras/moose/samples/expr.moo:
extras/moose/samples/cgram.moo:
extras/moose/samples/small.moo:
	Changed parse declarations to match new scheme.
	Changed the scan predicates in alpha.moo and expr.moo to be
	deterministic.

extras/moose/samples/try_alpha.m:
extras/moose/samples/try_expr.m:
	Changed to use the new interface.

Index: README
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/README,v
retrieving revision 1.1
diff -u -r1.1 README
--- README	22 May 2000 05:22:02 -0000	1.1
+++ README	30 Jan 2002 04:33:33 -0000
@@ -18,14 +18,15 @@
 
 - One Moose parser declaration, of the form
 
-	:- parse(<StartSymbol>, <EndToken>, <TokenType>, <Prefix>).
+	:- parse(<StartSymbol>, <TokenType>, <EndToken>, <Prefix>, <In>, <Out>).
 
-  Here <StartSymbol> is the name of the starting symbol for the grammar,
-  <EndToken> is the token that signifies end-of-file,
+  Here <StartSymbol> is the <Name>/<Arity> of the starting symbol for the
+  grammar,
   <TokenType> is the name of the Mercury type for tokens in this grammar,
-  and <Prefix> is unused.  (<Prefix> is intended to be used as a prefix
-  to the generated predicate names, however it is currently
-  unimplemented).
+  <EndToken> is the token that signifies end-of-file,
+  <Prefix> is intended to be used as a prefix to the generated predicate
+  names, however this is currently unimplemented,
+  <In> and <Out> are the modes to use for the parser state.
 
 - One or more Moose rule declarations, of the form
 
@@ -66,28 +67,29 @@
   
 - Zero or more Moose action declarations, of the form
 
-        :- action(<Name>/<Arity>, <PredicateName>).
+        :- action(<Name>/<Arity>, <FuncName>).
 
-  Each action declaration will add a method called PredicateName
-  to the type class parser_state/1.  The method will have the same types
-  as the rule given by Name/Arity, plus a threaded in/out pair of
-  parser_state arguments.
+  Each action declaration will add a method called FuncName
+  to the type class parser state/1.  The method will have the same types
+  as the rule given by Name/Arity, plus an <In> mode argument for the
+  parser state and returning an <Out> mode result of the same type.
 
   For example
         :- rule foo(int).
         :- action(foo/1, process_foo).
   will generate
-        :- typeclass parser_state(T) where [
+        :- typeclass parser state(T) where [
                 ... get_token and any other action methods ...
-                pred process_foo(int, T, T),
-                mode process_foo(in, in, out) is det
+                func process_foo(int, T) = T,
+                mode process_foo(in, <In>) = <Out> is det
         ].
 
   Whenever the parser reduces using a rule, it will invoke the associated
-  action method for that rule (if there is one).  Since the parser_state
+  action method for that rule (if there is one).  Since the parser state
   is threaded through all action methods, it can be used to implement
   inherited attributes.  Actions can also modify the token stream in the
-  parser_state (see below).
+  parser state (see below).
+
 
 
 In order to use the Moose parser, you need to provide a lexer, which
@@ -95,26 +97,49 @@
 declaration.  To allow flexibility in implementing the lexer, the parser
 requests tokens using a type class.
 
-The parser_state type class is the set of all operations that must be
-implemented in order to use the parser.  parser_state will contain at
-least one method, called get_token.
+The parser state type class is the set of all operations that must be
+implemented in order to use the parser.  parser state will contain at
+least two methods:
 
         :- typeclass parser_state(T) where [
+
                 pred get_token(token, T, T),
-                mode get_token(out, in, out) is semidet
+                mode get_token(out, in, out) is det,
+
+		func unget_token(token, T) = T,
+		mode unget_token(in, <In>) = <Out> is det,
+
+		... any action methods ...
         ].
 
-get_token returns the next token in the token stream.  The parser state
-typically contains a list of tokens, from which the next token is
-retrieved (although other implementations are possible).  get_token may
-fail if there are no more tokens available.
+get_token returns the next token in the token stream.  get_token should
+return the <EndToken> on reaching the end of the input stream.
+
+get_token and unget_token should satisfy the following property:
 
-The other methods in parser_state will be dictated by the Moose action
+	all [Tok, T0] some [T] get_token(Tok, unget_token(Tok, T0), T)
+
+The other methods in parser state will be dictated by the Moose action
 declarations.  To use the Moose generated parser, simply call the
-generated parse predicate with an instance of the parser_state type
+generated parse predicate with an instance of the parser state type
 class.
 
+The parse predicate will have the following signature
+
+	:- pred parse(parse_result, P, P) <= parser_state(P).
+	:- mode parse(out, <In>, <Out>) is det.
+
+where
+
+	:- type parse_result
+		--->	<StartSymbolName>(...)
+		;	error(string).
+
+and the arguments types of the <StartSymbolName> constructor match those
+for the corresponding rule declaration.
+
+
 
 The samples directory contains some simple grammars, lexers
-and implementations of the parser_state.  
+and implementations of the parser state.  
Index: TODO
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/TODO,v
retrieving revision 1.2
diff -u -r1.2 TODO
--- TODO	24 May 2000 01:15:18 -0000	1.2
+++ TODO	30 Jan 2002 04:49:10 -0000
@@ -1,6 +1,4 @@
 To make moose more useful:
-	- allow the parsing state to be unique (so that it can contain
-	  the io:state, just for example).
 	- allow parsing actions to be semidet to allow the imposition
 	  of semantic conditions during parsing.
Index: grammar.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/grammar.m,v
retrieving revision 1.4
diff -u -r1.4 grammar.m
--- grammar.m	25 Sep 2001 09:37:00 -0000	1.4
+++ grammar.m	29 Jan 2002 04:27:27 -0000
@@ -135,8 +135,8 @@
 :- 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 construct_grammar(nonterminal, clauses, xforms, grammar).
+:- mode construct_grammar(in, in, in, out) is det.
 
 :- pred compute_first(rules, first).
 :- mode compute_first(in, out) is det.
@@ -219,7 +219,7 @@
 
 %------------------------------------------------------------------------------%
 
-construct_grammar(Start, _End, AllClauses, XForms, Grammar) :-
+construct_grammar(Start, AllClauses, XForms, Grammar) :-
 	map__to_assoc_list(AllClauses, ClauseList),
 	Nont0 = 1,
Index: moose.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/moose.m,v
retrieving revision 1.3
diff -u -r1.3 moose.m
--- moose.m	22 Nov 2001 10:07:05 -0000	1.3
+++ moose.m	30 Jan 2002 04:28:02 -0000
@@ -1,7 +1,14 @@
 %----------------------------------------------------------------------------%
-% Copyright (C) 1998-2001 The University of Melbourne.
+% Copyright (C) 1998-2002 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury Distribution.
+%
+% Original author: Tom Conway <conway at cs.mu.oz.au>
+% Extensions: Ralph Becket <rafe at cs.mu.oz.au>
+%
+% There's scope for recoding much of this to use the more recent
+% additions to the language, if anyone feels like something to do.
+%
 %----------------------------------------------------------------------------%
 
 :- module moose.
@@ -84,7 +91,15 @@
 	--->	(interface) ; (implementation) .
 
 :- type parser
-	--->	parser(whereami, nonterminal, term, string, string).
+	--->	parser(
+			whereami,
+			nonterminal,	% Starting nonterminal.
+			term,		% EOF token.
+			string,		% Token type name.
+			string,		% Naming prefix (unused).
+			string,		% Parser state input mode.
+			string		% Parser state output mode.
+		).
 
 :- pred process(options::in, io__state::di, io__state::uo) is det.
 
@@ -108,7 +123,7 @@
 		(
 			{ MParser = [] },
 			stderr_stream(StdErr),
-			write_string(StdErr, "error: no parse/4 declaration.\n")
+			write_string(StdErr, "error: no parse/6 declaration.\n")
 		;
 			{ MParser = [Parser] },
 			{ reverse(Remainder0, Remainder) },
@@ -135,7 +150,8 @@
 	{ check_clauses(Clauses0, Decls, Clauses, ClauseErrors) },
 	foldl(write_error, ClauseErrors),
 
-	{ Parser = parser(WhereAmI, StartId, EndToken, TokenType, _Prefix) },
+	{ Parser = parser(WhereAmI, StartId, EndTerm, TokenType, _Prefix,
+				InAtom, OutAtom) },
 
 	{ check_useless(StartId, Clauses, Decls, UselessErrors) },
 	foldl(write_error, UselessErrors),
@@ -151,8 +167,10 @@
 	->
 		write_module(nolines, Module), nl,
 		{ lookup(Decls, StartId, StartDecl) },
-		write_parser(WhereAmI, StartId, StartDecl, TokenType),
-		write_action_type_class(WhereAmI, XFormList, Decls),
+		write_parser(WhereAmI, StartId, StartDecl, TokenType,
+				InAtom, OutAtom),
+		write_action_type_class(WhereAmI, XFormList, Decls,
+					TokenType, InAtom, OutAtom),
 
 		stderr_stream(StdErr),
 		write_string(StdErr, "constructing grammar...\n"),
@@ -163,8 +181,7 @@
 			map__det_insert(Xf0, XfNt, XForm, Xf)
 		), XFormList, Xfns0, XForms) },
 
-		{ construct_grammar(StartId, EndToken, Clauses, XForms,
-			Grammar) },
+		{ construct_grammar(StartId, Clauses, XForms, Grammar) },
 		{ Grammar = grammar(Rules, _, Xfns, _, Index, First, _Follow) },
 		{ reaching(Rules, First, Reaching) },
 
@@ -211,11 +228,12 @@
 				)
 			)
 		), ActionErrs, no, _HasErrors),
-		write_action_table(ActionTable, TokenType, EndToken),
+		write_action_table(ActionTable, TokenType, EndTerm),
 		write_string(StdErr, "computing the goto table...\n"),
 		{ gotos(C, States, Gotos, GotoTable) },
 		write_goto_table(GotoTable, Decls),
-		write_reductions(Rules, TokenType, Xfns),
+		write_reductions(Rules, ActionTable, TokenType,
+				InAtom, OutAtom, Xfns),
 		[]
 	;
 		[]
@@ -224,18 +242,25 @@
 %------------------------------------------------------------------------------%
 
 :- 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.
+	string, string, string, io__state, io__state).
+:- mode write_action_type_class(in, in, in, in, in, in, di, uo) is det.
 
-write_action_type_class(Where, XForms, Decls) -->
+write_action_type_class(Where, XForms, Decls, TokenType, InAtom, OutAtom) -->
 	( { 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"),
+	io__format("\
+:- typeclass parser_state(T) where [
+	pred get_token(%s, T, T),
+	mode get_token(out, %s, %s) is det,
+	func unget_token(%s, T) = T,
+	mode unget_token(in, %s) = %s is det\
+",
+		[s(TokenType), s(InAtom), s(OutAtom),
+		 s(TokenType), s(InAtom), s(OutAtom)]
+	),
 	( { not XForms = [] } ->
 		io__write_string(",\n")
 	;
@@ -248,15 +273,15 @@
 		{ XForm = xform(NT, MethodName) },
 		{ lookup(Decls, NT, RuleDecl) },
 		{ RuleDecl = rule(_NT, Types, VarSet, _Context) },
-		io__write_strings(["\tpred ", MethodName, "("]),
+		io__format("\tfunc %s(", [s(MethodName)]),
 		io__write_list(Types, ", ", term_io__write_term(VarSet)),
 		( { Types \= [] } -> io__write_string(", ") ; [] ),
-		io__write_string("T, T),\n"),
+		io__format("T, T),\n", []),
 
-		io__write_strings(["\tmode ", MethodName, "("]),
+		io__format("\tmode %s(", [s(MethodName)]),
 		io__write_list(Types, ", ", WriteIn),
 		( { Types \= [] } -> io__write_string(", ") ; [] ),
-		io__write_string("in, out) is det")
+		io__format("%s) = %s is det", [s(InAtom), s(OutAtom)])
 		)
 	},
 	io__write_list(XForms, ",\n", WriteXForm),
@@ -406,13 +431,17 @@
 
 parser_term(functor(atom(":-"), [functor(atom("parse"), Args, _)], _),
 		_VarSet, WhereAmI, Decl) :-
-	Args = [StartIdTerm, EndTok, TokTerm, PrefixTerm],
+	Args = [StartIdTerm, TokTerm, EndTerm,
+			PrefixTerm, InAtomTerm, OutAtomTerm],
 	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).
+	InAtomTerm = functor(atom(InAtom), [], _),
+	OutAtomTerm = functor(atom(OutAtom), [], _),
+	Decl = parser(WhereAmI, StartId, EndTerm, TokAtom,
+			PrefixAtom, InAtom, OutAtom).
 
 :- pred xform_term(term, xform).
 :- mode xform_term(in, out) is semidet.
@@ -436,16 +465,16 @@
 
 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"
-	]).
+	write_string(StdErr, "\
+usage: moose <options> file ...
+	-h|--help		help
+	-a|--dump-action	dump the action table
+	-f|--dump-first		dump the FIRST sets
+	-a|--dump-follow	dump the FOLLOW sets
+	-a|--dump-goto		dump the goto table
+	-a|--dump-items		dump the item sets
+	-a|--dump-rules		dump the flattened rules
+"	).
 
 %------------------------------------------------------------------------------%
 
@@ -453,27 +482,33 @@
 :- 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"
-	]),
+	io__format(":- inst state_no --->\n\t\t", []),
+	io__write_list(map__keys(Table), "\n\t;\t", io__write_int),
+	io__format(".\n:- inst state_nos == list_skel(state_no).\n\n", []),
+	io__format("\
+:- type parsing_action
+	--->	shift
+	;	reduce
+	;	accept.
+
+:- pred actions(int, %s, parsing_action, int).
+:- mode actions(in(state_no), in, out, out(state_no)) is semidet.
+
+",
+		[s(TT)]
+	),
 	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"
-		]),
+		io__format("\
+actions(%s, Tok, Action, Value) :-
+	actions%s(Tok, Action, Value).
+
+:- pred actions%s(%s, parsing_action, int).
+:- mode actions%s(in, out, out(state_no)) is semidet.
+
+",
+			[s(SS), s(SS), s(SS), s(TT), s(SS)]
+		),
 		write_state_actions(SS, End, StateActions)
 	), Table).
 
@@ -531,21 +566,23 @@
 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"
-	]),
+	write_string("\
+:- pred gotos(int, nonterminal, int).
+:- mode gotos(in(state_no), in, out(state_no)) is semidet.
+
+"	),
 	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"
-		]),
+		io__format("\
+gotos(%s, NT, NS) :-
+	gotos%s(NT, NS).
+
+:- pred gotos%s(nonterminal, int).
+:- mode gotos%s(in, out) is semidet.
+
+",
+			[s(SS), s(SS), s(SS), s(SS)]
+		),
 		write_state_gotos(SS, StateActions)
 	), Table).
 
@@ -602,11 +639,11 @@
 
 %------------------------------------------------------------------------------%
 
-:- pred write_parser(whereami, nonterminal, rule_decl, string,
+:- pred write_parser(whereami, nonterminal, rule_decl, string, string, string,
 		io__state, io__state).
-:- mode write_parser(in, in, in, in, di, uo) is det.
+:- mode write_parser(in, in, in, in, in, in, di, uo) is det.
 
-write_parser(Where, NT, Decl, TT) -->
+write_parser(Where, NT, Decl, TT, InAtom, OutAtom) -->
 	(
 		{ NT = StartName/StartArity }
 	;
@@ -618,7 +655,7 @@
 	{ mkstartargs(StartArity, [], StartArgs, Varset0, Varset) },
 	{ StartTerm = functor(atom(StartName), StartArgs, Ctxt) },
 	{ context_init(Ctxt) },
-	{ ParseResultType = type(disj(functor(atom("presult"), [], Ctxt),
+	{ ParseResultType = type(disj(functor(atom("parse_result"), [], Ctxt),
 		[OkayType, ErrorType]), DeclVarset) },
 	{ OkayType = functor(atom(StartName), DeclArgs, DeclCtxt) },
 	{ ErrorType = functor(atom("error"), [
@@ -630,73 +667,70 @@
 	),
 	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"
-	]),
+	io__format("\
+:- import_module list.
+
+:- pred parse(parse_result, P, P) <= parser_state(P).
+:- mode parse(out, %s, %s) is det.
+
+",
+		[s(InAtom), s(OutAtom)]
+	),
 	( { 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("
-        ]),
+	io__format("\
+parse(Result, Toks0, Toks) :-
+	parse(Toks0, Toks, [0], [], Result).
+
+:- pred parse(P, P, statestack, symbolstack, parse_result) <= parser_state(P).
+:- mode parse(%s, %s, in(state_nos), in, out) is det.
+
+parse(Toks0, Toks, St0, Sy0, Res) :-
+    (
+        St0 = [S0|_],
+        get_token(Tok, Toks0, Toks1),
+        ( 
+            actions(S0, Tok, What, Val)
+        ->
+            (
+                What = shift,
+                Sy1 = [t(Tok)|Sy0],
+                St1 = [Val|St0],
+                parse(Toks1, Toks, St1, Sy1, Res)
+            ;
+                What = reduce,
+		Toks2 = unget_token(Tok, Toks1),
+                reduce(Val, St0, St1, Sy0, Sy1, Toks2, Toks3),
+                parse(Toks3, Toks, St1, Sy1, Res)
+            ;
+                What = accept,
+                    ( Sy0 = [n(",
+		[s(InAtom), s(OutAtom)]
+        ),
         write_term(Varset, StartTerm),
-        write_strings([
-")] ->\n",
-"                        Res = ("
-	]),
+        write_string(")] ->
+                            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"
-	]).
+	write_string("),
+                            Toks = Toks1
+                    ;
+                            error(""parse: internal accept error"")
+                    )
+                )
+        ;
+            Res = error(""parse error""),
+	    Toks = unget_token(Tok, Toks1)
+        )
+    ;
+        St0 = [],
+        error(""parse: state stack underflow"")
+    ).
+"
+	).
 
 :- pred mkstartargs(int, list(term), list(term), varset, varset).
 :- mode mkstartargs(in, in, out, in, out) is det.
@@ -715,57 +749,81 @@
 
 %------------------------------------------------------------------------------%
 
-:- pred write_reductions(rules, string, xforms, io__state, io__state).
-:- mode write_reductions(in, in, in, di, uo) is det.
+:- pred write_reductions(rules, actiontable, string, string, string, xforms,
+		io__state, io__state).
+:- mode write_reductions(in, in, in, 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"
-	]),
+write_reductions(Rules, Table, TT, InAtom, OutAtom, Xfns) -->
+	io__format("\
+:- import_module require, std_util.
+
+:- type statestack == list(int).
+:- type symbolstack == list(stacksymbol).
+:- type stacksymbol
+	--->	n(nonterminal)
+	;	t(%s).
+
+",
+		[s(TT)]
+	),
+	io__format("
+:- pred reduce(int, statestack, statestack,
+		symbolstack, symbolstack, P, P) <= parser_state(P).
+:- mode reduce(in(state_no), in(state_nos), out(state_nos),
+		in, out, %s, %s) is det.
+
+reduce(RuleNum, States0, States, Symbols0, Symbols, Tokens0, Tokens) :-
+	reduce0(RuleNum, States0, States1, Symbols0, Symbols1,
+		Tokens0, Tokens1),
+	(
+		States1 = [State0|_States2],
+		Symbols1 = [n(Non)|_],
+		gotos(State0, Non, State1),
+		States3 = [State1|States1]
+	->
+		States = States3,
+		Symbols = Symbols1,
+		Tokens = Tokens1
+	;
+		error(""reduce: reduction failed"")
+	).
+
+",
+		[s(InAtom), s(OutAtom)]
+	),
+	io__format("\
+:- pred reduce0(int, statestack, statestack,
+		symbolstack, symbolstack, P, P) <= parser_state(P).
+:- mode reduce0(in(state_no), in(state_nos), out(state_nos),
+		in, out, %s, %s) is det.
+
+",
+		[s(InAtom), s(OutAtom)]
+	),
 	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"
-		]),
+		( { Rn = 0 } ->
+
+		io__write_string("\
+reduce0(0x0, _, _, _, _, _, _) :-
+	reduce0_error(0x0).
+
+"		)
+
+		;
+
+		{ RedName = format("reduce0x%x", [i(Rn)]) },
+		{ RnS     = format("0x%x", [i(Rn)]) },
+		io__format("\
+reduce0(%s, S0, S, T0, T, U0, U) :-
+	%s(S0, S, T0, T, U0, U).
+
+:- pred %s(statestack, statestack, symbolstack, symbolstack,
+		P, P) <= parser_state(P).
+:- mode %s(in(state_nos), out(state_nos), in, out, %s, %s) is det.
+",
+			[s(RnS), s(RedName), s(RedName), s(RedName),
+			 s(InAtom), s(OutAtom)]
+		),
 		{ Rule = rule(RNt, Head, _, Body, Actions, Varset0, _C) },
 		{ new_named_var(Varset0, "M_St0", St0v, Varset1) },
 		{ St0 = variable(St0v) },
@@ -834,8 +892,31 @@
 			Goal, Varset12) },
 		write_element(lines, Clause),
 		nl
-		; [] )
-	), Rules).
+		)
+	), Rules),
+	foldl((pred(State::in, _TerminalAction::in, di, uo) is det -->
+			( if not { Rules `contains` State } then
+				io__format("\
+reduce0(0x%x, _, _, _, _, _, _) :-
+	reduce0_error(0x%x).
+
+",
+					[i(State), i(State)]
+				)
+			)
+		),
+		Table
+	),
+	io__format("\
+:- pred reduce0_error(int).
+:- mode reduce0_error(in) is erroneous.
+
+reduce0_error(State) :-
+	error(string__format(""reduce in state 0x%%x"", [i(State)])).
+
+",
+		[]
+	).
 
 :- pred mkstacks(list(bodyterm), term, term, term, term, varset, varset).
Index: alpha.moo
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/samples/alpha.moo,v
retrieving revision 1.1
diff -u -r1.1 alpha.moo
--- alpha.moo	22 May 2000 05:22:16 -0000	1.1
+++ alpha.moo	30 Jan 2002 04:44:24 -0000
@@ -9,17 +9,17 @@
 	;	num(int)
 	;	('(')
 	;	(')')
-	;	('$')
+	;	eof
 	.
 
-:- parse(exprn/1, ('$'), token, xx).
+:- parse(exprn/1, token, eof, xx, in, out).
 
 :- pred scan(list(char), list(token)).
-:- mode scan(in, out) is semidet.
+:- mode scan(in, out) is det.
 
 :- implementation.
 
-:- import_module string.
+:- import_module string, require.
 
 :- rule exprn(int).
 exprn(Num)	--->	exprn(A), [+], term(B), { Num = A + B }.
@@ -37,16 +37,16 @@
 	list__reverse(Toks0, Toks).
 
 :- pred scan(list(char), list(token), list(token)).
-:- mode scan(in, in, out) is semidet.
+:- mode scan(in, in, out) is det.
 
-scan([], Toks, ['$'|Toks]).
+scan([], Toks, [eof|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),
+		Num = string__det_to_int(NumStr),
 		scan(Rest, [num(Num)|Toks0], Toks)
 	; C = ('+') ->
 		scan(Cs, ['+'|Toks0], Toks)
@@ -55,6 +55,6 @@
 	; C = (')') ->
 		scan(Cs, [')'|Toks0], Toks)
 	;
-		fail
+		error("expr: syntax error in input")
 	).
Index: cgram.moo
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/samples/cgram.moo,v
retrieving revision 1.1
diff -u -r1.1 cgram.moo
--- cgram.moo	22 May 2000 05:22:17 -0000	1.1
+++ cgram.moo	30 Jan 2002 04:36:37 -0000
@@ -2,7 +2,7 @@
 
 :- interface.
 
-:- parse(file/0, ('$'), token, 'x').
+:- parse(file/0, token, ('$'), xx, in, out).
 
 :- type token --->
Index: expr.moo
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/samples/expr.moo,v
retrieving revision 1.1
diff -u -r1.1 expr.moo
--- expr.moo	22 May 2000 05:22:17 -0000	1.1
+++ expr.moo	30 Jan 2002 04:37:21 -0000
@@ -12,17 +12,17 @@
 	;	num(int)
 	;	('(')
 	;	(')')
-	;	('$')
+	;	eof
 	.
 
-:- parse(exprn/1, ('$'), token, xx).
+:- parse(exprn/1, token, eof, xx, in, out).
 
 :- pred scan(list(char), list(token)).
-:- mode scan(in, out) is semidet.
+:- mode scan(in, out) is det.
 
 :- implementation.
 
-:- import_module string.
+:- import_module string, require.
 
 :- rule exprn(int).
 exprn(Num)	--->	exprn(A), [+], term(B), { Num = A + B }.
@@ -43,16 +43,16 @@
 	list__reverse(Toks0, Toks).
 
 :- pred scan(list(char), list(token), list(token)).
-:- mode scan(in, in, out) is semidet.
+:- mode scan(in, in, out) is det.
 
-scan([], Toks, ['$'|Toks]).
+scan([], Toks, [eof|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),
+		Num = string__det_to_int(NumStr),
 		scan(Rest, [num(Num)|Toks0], Toks)
 	; C = ('+') ->
 		scan(Cs, ['+'|Toks0], Toks)
@@ -67,6 +67,6 @@
 	; C = (')') ->
 		scan(Cs, [')'|Toks0], Toks)
 	;
-		fail
+		error("expr: syntax error in input")
 	).
Index: small.moo
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/samples/small.moo,v
retrieving revision 1.1
diff -u -r1.1 small.moo
--- small.moo	22 May 2000 05:22:17 -0000	1.1
+++ small.moo	30 Jan 2002 04:36:37 -0000
@@ -1,6 +1,6 @@
 :- module small.
 
-:- parse(program/1, ('$'), token, 'x').
+:- parse(program/1, token, ('$'), xx, in, out).
 
 :- rule program(list(defn)).
Index: try_alpha.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/samples/try_alpha.m,v
retrieving revision 1.1
diff -u -r1.1 try_alpha.m
--- try_alpha.m	22 May 2000 05:22:18 -0000	1.1
+++ try_alpha.m	30 Jan 2002 04:09:25 -0000
@@ -14,23 +14,21 @@
 :- 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.
+	get_token(eof, [],       []),
+	get_token(T,   [T | Ts], Ts),
 
-uncons(X, Xs, Xs0) :- Xs = [X | Xs0].
+	unget_token(T, Ts) = [T | Ts]
+].
 
 main --> 
 	read_line(Res0),
 	(
 		{ Res0 = ok(Chars) },
-		( { scan(Chars, Toks) } ->
-			{ parse(Toks, Res, RemainingToks) },
+		(	{ scan(Chars, Toks) },
+			{ parse(Res, Toks, RemainingToks) },
 			write(Res), nl,
 			write(RemainingToks), nl
-		;
-			write_string("scanning error.\n")
 		),
 		main
Index: try_expr.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/moose/samples/try_expr.m,v
retrieving revision 1.1
diff -u -r1.1 try_expr.m
--- try_expr.m	22 May 2000 05:22:18 -0000	1.1
+++ try_expr.m	30 Jan 2002 04:39:42 -0000
@@ -14,23 +14,21 @@
 :- 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.
+	get_token(eof, [],       []),
+	get_token(T,   [T | Ts], Ts),
 
-uncons(X, Xs, Xs0) :- Xs = [X | Xs0].
+	unget_token(T, Ts) = [T | Ts]
+].
 
 main --> 
 	read_line(Res0),
 	(
 		{ Res0 = ok(Chars) },
-		( { scan(Chars, Toks) } ->
-			{ parse(Toks, Res, RemainingToks) },
+		(	{ scan(Chars, Toks) },
+			{ parse(Res, Toks, RemainingToks) },
 			write(Res), nl,
 			write(RemainingToks), nl
-		;
-			write_string("scanning error.\n")
 		),
 		main
 	;


--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list