[m-rev.] for review: fix bug in write_term

Mark Brown mark at cs.mu.OZ.AU
Mon Mar 6 23:15:07 AEDT 2006


Hi,

This change works around the bug reported by Doug Auclair recently.  It's
not really a proper fix -- doing that really requires a proper BNF parser
rather than the operator precence parser that we have, otherwise we would
be forced to reject programs that we have been accepting for a long time.

This is for review by Zoltan.

Cheers,
Mark.

Estimated hours taken: 5
Branches: main

Fix a bug reported by Doug Auclair.

library/ops.m:
	Change the Mercury arg priority to 999.  It was previously set to
	1201, which allowed arguments and list elements to be parsed the
	way we intended.  However, this had the unintended side effect that
	valid terms were written out using incorrect syntax.

library/parser.m:
	Place the workaround here, here arguments and list elements are
	read.

	Note that this is still technically buggy, because we effectively
	allow syntax which should be illegal according to the operator
	precedence table.  But the proper fix for this involves moving to
	a BNF style parser, so that is left for later work.

tests/hard_coded/Mmakefile:
	Run the term_io_test case twice, check it against the expected output
	each time.  The first time it is run with the supplied input file.
	The second time it is run with the expected output as input -- this
	ensures that terms are read in the same way that they are written
	out.

tests/hard_coded/term_io_test.m:
	Read input from stdin rather than a fixed file.

tests/hard_coded/term_io_test.inp:
	Add additional input terms.

tests/hard_coded/term_io_test.exp:
tests/invalid/*.err_exp:
	Update the expected output for this and other test cases.

Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.58
diff -u -r1.58 ops.m
--- library/ops.m	24 Feb 2006 07:11:18 -0000	1.58
+++ library/ops.m	6 Mar 2006 03:40:04 -0000
@@ -244,10 +244,8 @@
 
 :- func ops__mercury_arg_priority(mercury_op_table) = ops__priority.
 
-    % XXX ISO prolog syntax would require us to change this to 999,
-    % but we need bug-for-bug compatibility with the NU-Prolog parser
-    % in order to support e.g. `::' in args.
-ops__mercury_arg_priority(_Table) = 1201.
+    % This needs to be less than then priority of the ','/2 operator.
+ops__mercury_arg_priority(_Table) = 999.
 
     % Changes here may require changes to doc/reference_manual.texi.
 :- pred ops__op_table(string, ops__category, ops__specifier, ops__priority).
Index: library/parser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.48
diff -u -r1.48 parser.m
--- library/parser.m	17 Oct 2005 11:35:19 -0000	1.48
+++ library/parser.m	6 Mar 2006 07:10:15 -0000
@@ -294,14 +294,25 @@
 
 parse_arg(Term, !PS) :-
     get_ops_table(!.PS, OpTable),
-    parse_term_2(ops__arg_priority(OpTable), argument, Term, !PS).
+    % XXX We should do the following:
+    %   ArgPriority = ops__arg_priority(OpTable),
+    % but that would mean we can't, for example, parse '::'/2 in arguments
+    % the way we want to.  Perhaps a better solution would be to change the
+    % priority of '::'/2, but we need to analyse the impact of that further.
+    ArgPriority = ops__max_priority(OpTable) + 1,
+    parse_term_2(ArgPriority, argument, Term, !PS).
 
 :- pred parse_list_elem(parse(term(T))::out,
     state(Ops, T)::in, state(Ops, T)::out) is det <= op_table(Ops).
 
 parse_list_elem(Term, !PS) :-
     get_ops_table(!.PS, OpTable),
-    parse_term_2(ops__arg_priority(OpTable), list_elem, Term, !PS).
+    % XXX We should do the following:
+    %   ArgPriority = ops__arg_priority(OpTable),
+    % but that would mean we can't, for example, parse promise_pure/0 in
+    % foreign attribute lists.
+    ArgPriority = ops__max_priority(OpTable) + 1,
+    parse_term_2(ArgPriority, list_elem, Term, !PS).
 
 :- pred parse_term_2(int::in, term_kind::in, parse(term(T))::out,
     state(Ops, T)::in, state(Ops, T)::out) is det <= op_table(Ops).
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.278
diff -u -r1.278 Mmakefile
--- tests/hard_coded/Mmakefile	24 Feb 2006 01:42:12 -0000	1.278
+++ tests/hard_coded/Mmakefile	6 Mar 2006 10:20:26 -0000
@@ -523,6 +523,26 @@
 
 #-----------------------------------------------------------------------------#
 
+# For term_io_test, we want to run it once using the supplied input file.
+# But we want to check that the output parses the same as the input did,
+# so we also run it with the .exp file as the input.
+
+term_io_test.fix_out: term_io_test term_io_test.exp
+	./term_io_test < term_io_test.exp > $@ 2>&1 || \
+		{ grep . $@ /dev/null; exit 1; }
+
+term_io_test.res: term_io_test.out term_io_test.fix_out
+	@echo "Comparing term_io_test.{,fix_}out with term_io_test.exp,"
+	@echo "	results in $@"
+	@-rm -f $@ term_io_test.res
+	@{ diff $(DIFF_OPTS) term_io_test.exp term_io_test.out > $@ && \
+		echo "term_io_test.out matched term_io_test.exp"; } && \
+	{ diff $(DIFF_OPTS) term_io_test.exp term_io_test.fix_out >> $@ && \
+		echo "term_io_test.fix_out matched term_io_test.exp"; } || \
+	{ echo "** term_io_test.{,fix_}out did not match the expected output"; \
+		cat $@; \
+		exit 1; }
+
 nonascii.out:	nonascii.data
 
 nonascii.data:	nonascii_gen
Index: tests/hard_coded/term_io_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/term_io_test.exp,v
retrieving revision 1.2
diff -u -r1.2 term_io_test.exp
--- tests/hard_coded/term_io_test.exp	8 Nov 2001 15:30:39 -0000	1.2
+++ tests/hard_coded/term_io_test.exp	6 Mar 2006 11:36:09 -0000
@@ -1 +1,6 @@
-foo(pred(A :: in, B :: out) is det :- p(A, C), q(C, B), D, E).
+foo((pred((A :: in), (B :: out)) is det :- p(A, C), q(C, B)), D, E).
+{(a(1), X = 1, (b, Y = 1, (c, Z = 1 ; Z = 2) ; Y = 2, Z = 2) ; X = 2, Y = 2, Z = 2), A = 1}.
+[(a(1), X = 1 & X = 2, Y = 2), A = 1].
+[(a :: m), (b :: n)].
+[foo, (promise_pure), bar].
+bound((ground ; ground - unique)).
Index: tests/hard_coded/term_io_test.inp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/term_io_test.inp,v
retrieving revision 1.1
diff -u -r1.1 term_io_test.inp
--- tests/hard_coded/term_io_test.inp	13 Nov 1998 05:33:03 -0000	1.1
+++ tests/hard_coded/term_io_test.inp	6 Mar 2006 11:10:23 -0000
@@ -1,2 +1,34 @@
 foo((pred(A::in, B::out) is det :- p(A, C), q(C, B)), D, E).
+{
+	(
+		a(1),
+		X = 1,
+		(
+			b,
+			Y = 1,
+			( c, Z = 1; Z = 2 )
+		;
+			 Y = 2, Z = 2
+		)
+	;
+		X = 2,
+		Y = 2,
+		Z = 2
+	),
+	A = 1
+}.
+[
+	(
+		a(1),
+		X = 1
+	&
+		X = 2,
+		Y = 2
+	)
+,
+	A = 1
+].
+[a::m, b::n].
+[foo, promise_pure, bar].
+bound(ground ; ground - unique).
 
Index: tests/hard_coded/term_io_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/term_io_test.m,v
retrieving revision 1.1
diff -u -r1.1 term_io_test.m
--- tests/hard_coded/term_io_test.m	15 Nov 1998 06:48:10 -0000	1.1
+++ tests/hard_coded/term_io_test.m	6 Mar 2006 10:23:28 -0000
@@ -11,32 +11,17 @@
 :- import_module list, string, term_io.
 
 main -->
-	see("term_io_test.inp", Res0),
-	(
-		{ Res0 = ok },
-		doit,
-		seen
-	;
-		{ Res0 = error(Err) },
-		{ error_message(Err, Msg) },
-		stderr_stream(StdErr),
-		format(StdErr, "error opening term_io_test.inp: %s\n", [s(Msg)])
-	).
-
-:- pred doit(io__state::di, io__state::uo) is det.
-
-doit -->
 	read_term(Res0),
 	(
 		{ Res0 = term(VarSet, Term) },
 		write_term_nl(VarSet, Term),
-		doit
+		main
 	;
 		{ Res0 = eof }
 	;
 		{ Res0 = error(Msg, Line) },
 		stderr_stream(StdErr),
 		format(StdErr, "%d: %s\n", [i(Line), s(Msg)]),
-		doit
+		main
 	).
 
Index: tests/invalid/constrained_poly_insts.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/constrained_poly_insts.err_exp,v
retrieving revision 1.7
diff -u -r1.7 constrained_poly_insts.err_exp
--- tests/invalid/constrained_poly_insts.err_exp	14 Sep 2005 05:26:44 -0000	1.7
+++ tests/invalid/constrained_poly_insts.err_exp	6 Mar 2006 11:14:12 -0000
@@ -1,7 +1,7 @@
 constrained_poly_insts.m:007: Error: inconsistent constraints on inst variables in predicate mode declaration: p(in(_1), out(_1 =< any)).
-constrained_poly_insts.m:009: Error: inconsistent constraints on inst variables in `:- pred' declaration: q(_1 :: in(_2 =< free), _1 :: out(_2 =< bound(c))).
+constrained_poly_insts.m:009: Error: inconsistent constraints on inst variables in `:- pred' declaration: q((_1 :: in(_2 =< free)), (_1 :: out(_2 =< bound(c)))).
 constrained_poly_insts.m:012: Error: inconsistent constraints on inst variables in function mode declaration: r(in(_1)) = out(_1 =< free).
-constrained_poly_insts.m:014: Error: inconsistent constraints on inst variables in function declaration: s(_1 :: in(_2 =< ground)) = (_1 :: out(_2 =< unique)).
+constrained_poly_insts.m:014: Error: inconsistent constraints on inst variables in function declaration: s((_1 :: in(_2 =< ground))) = (_1 :: out(_2 =< unique)).
 constrained_poly_insts.m:023: Error: clause for predicate
 constrained_poly_insts.m:023:   `constrained_poly_insts.q/2'
 constrained_poly_insts.m:023:   without preceding `pred' declaration.
Index: tests/invalid/func_errors.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/func_errors.err_exp,v
retrieving revision 1.5
diff -u -r1.5 func_errors.err_exp
--- tests/invalid/func_errors.err_exp	14 Sep 2005 05:26:45 -0000	1.5
+++ tests/invalid/func_errors.err_exp	6 Mar 2006 11:14:30 -0000
@@ -1,4 +1,4 @@
-func_errors.m:010: Error: some but not all arguments have modes: bar(int :: in, int).
-func_errors.m:011: Error: function arguments have modes, but function result doesn't: baz(int :: in, int :: in).
+func_errors.m:010: Error: some but not all arguments have modes: bar((int :: in), int).
+func_errors.m:011: Error: function arguments have modes, but function result doesn't: baz((int :: in), (int :: in)).
 func_errors.m:012: Error: function result has mode, but function arguments don't: quux(int, int).
-func_errors.m:018: Error: some but not all arguments have modes: q(int :: in, int).
+func_errors.m:018: Error: some but not all arguments have modes: q((int :: in), int).
Index: tests/invalid/inst_list_dup.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/inst_list_dup.err_exp,v
retrieving revision 1.5
diff -u -r1.5 inst_list_dup.err_exp
--- tests/invalid/inst_list_dup.err_exp	14 Sep 2005 05:26:47 -0000	1.5
+++ tests/invalid/inst_list_dup.err_exp	6 Mar 2006 11:14:46 -0000
@@ -1,3 +1,3 @@
-inst_list_dup.m:003: Error: syntax error in inst body: bound(ground - unique ; ground - ground).
+inst_list_dup.m:003: Error: syntax error in inst body: bound((ground - unique ; ground - ground)).
 inst_list_dup.m:001: Warning: interface for module `inst_list_dup' does not
 inst_list_dup.m:001:   export anything.
Index: tests/invalid/predmode.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/predmode.err_exp,v
retrieving revision 1.7
diff -u -r1.7 predmode.err_exp
--- tests/invalid/predmode.err_exp	14 Sep 2005 05:26:50 -0000	1.7
+++ tests/invalid/predmode.err_exp	6 Mar 2006 11:15:02 -0000
@@ -1,3 +1,3 @@
-predmode.m:005: Error: some but not all arguments have modes: p(int :: in, int).
+predmode.m:005: Error: some but not all arguments have modes: p((int :: in), int).
 predmode.m:001: Warning: interface for module `predmode' does not export
 predmode.m:001:   anything.
Index: tests/invalid/some.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/some.err_exp,v
retrieving revision 1.5
diff -u -r1.5 some.err_exp
--- tests/invalid/some.err_exp	14 Sep 2005 05:26:51 -0000	1.5
+++ tests/invalid/some.err_exp	6 Mar 2006 11:15:09 -0000
@@ -1,4 +1,4 @@
-some.m:006: Error: unrecognized declaration: some junk pred p2(int :: in) is semidet.
+some.m:006: Error: unrecognized declaration: some junk pred p2((int :: in)) is semidet.
 some.m:012: In clause for predicate `some.p1/1':
 some.m:012:   in argument 1 of call to predicate `some/2':
 some.m:012:   error: undefined symbol `junk/0'.
Index: tests/invalid/with_type.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/with_type.err_exp,v
retrieving revision 1.3
diff -u -r1.3 with_type.err_exp
--- tests/invalid/with_type.err_exp	14 Sep 2005 05:26:55 -0000	1.3
+++ tests/invalid/with_type.err_exp	6 Mar 2006 11:15:20 -0000
@@ -1,6 +1,6 @@
-with_type.m:024: Error: `with_inst` and determinism both specified: with_type_4(_1 :: in, list(_2) :: in).
-with_type.m:027: Error: `with_inst` specified without `with_type`: with_type_5(_1 :: in, list(_2) :: in).
-with_type.m:030: Error: invalid inst in `with_inst`: with_inst(with_type(with_type_6(_1 :: in, list(_2) :: in), map_pred(string, string)), pred(in, in, out) is foo).
+with_type.m:024: Error: `with_inst` and determinism both specified: with_type_4((_1 :: in), (list(_2) :: in)).
+with_type.m:027: Error: `with_inst` specified without `with_type`: with_type_5((_1 :: in), (list(_2) :: in)).
+with_type.m:030: Error: invalid inst in `with_inst`: with_inst(with_type(with_type_6((_1 :: in), (list(_2) :: in)), map_pred(string, string)), pred(in, in, out) is foo).
 with_type.m:032: Error: `with_inst` specified without argument modes: with_type_7(_1, list(_2)).
 with_type.m:012: In type declaration for predicate `with_type.with_type_1':
 with_type.m:012:   error: expected higher order predicate type after
--------------------------------------------------------------------------
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