diff: fix parsing bug

Fergus Henderson fjh at cs.mu.OZ.AU
Wed Nov 11 11:11:31 AEDT 1998


Estimated hours taken: 0.5

library/parser.m:
	Fix a bug: according to the ISO Prolog standard, it should allow
	terms of the form `{}(foo)' or `[](foo)'.

tests/valid/Mmakefile:
tests/valid/parsing_bug.m:
tests/valid/parsing_bug_main.m:
	Regression test.

Index: parser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.30
diff -u -u -r1.30 parser.m
--- parser.m	1998/05/21 16:52:13	1.30
+++ parser.m	1998/11/10 23:51:34
@@ -421,7 +421,14 @@
 	%	atom --> open_list, close_list
 	%	atom --> open_curly, close_curly
 	% term --> variable		% priority 0
-	% term -->
+	% term --> atom, open_ct, arg_list, close
+	%	arg_list --> arg
+	%	arg_list --> arg, comma, arg_list
+	% term --> open, term, close
+	% term --> open_ct, term, close
+	% term --> term, op, term	% with various conditions
+	% term --> op, term		% with various conditions
+	% term --> term, op		% with various conditions
 
 :- pred parser__parse_simple_term_2(token, token_context, int, parse(term),
 				parser__state, parser__state).
@@ -502,9 +509,9 @@
 	parser__parse_simple_term_2(open, Context, Prec, Term).
 
 parser__parse_simple_term_2(open_list, Context, _, Term) -->
+	parser__get_term_context(Context, TermContext),
 	( parser__get_token(close_list) ->
-		parser__get_term_context(Context, TermContext),
-		{ Term = ok(term__functor(term__atom("[]"), [], TermContext)) }
+		parser__parse_special_atom("[]", TermContext, Term)
 	;
 		parser__parse_list(Term)
 	).
@@ -512,7 +519,7 @@
 parser__parse_simple_term_2(open_curly, Context, _, Term) -->
 	parser__get_term_context(Context, TermContext),
 	( parser__get_token(close_curly) ->
-		{ Term = ok(term__functor(term__atom("{}"), [], TermContext)) }
+		parser__parse_special_atom("{}", TermContext, Term)
 	;
 		parser__parse_term(SubTerm0),
 		( { SubTerm0 = ok(SubTerm) } ->
@@ -527,6 +534,25 @@
 			% propagate error upwards
 			{ Term = SubTerm0 }
 		)
+	).
+
+:- pred parser__parse_special_atom(string, term__context, parse(term),
+		parser__state, parser__state).
+:- mode parser__parse_special_atom(in, in, out, in, out) is det.
+
+parser__parse_special_atom(Atom, TermContext, Term) -->
+	( parser__get_token(open_ct) ->
+		parser__parse_args(Args0),
+		(	{ Args0 = ok(Args) },
+			{ Term = ok(term__functor(term__atom(Atom),
+				Args, TermContext)) }
+		;
+			% propagate error upwards
+			{ Args0 = error(Message, Tokens) },
+			{ Term = error(Message, Tokens) }
+		)
+	;
+		{ Term = ok(term__functor(term__atom(Atom), [], TermContext)) }
 	).
 
 :- pred parser__parse_list(parse(term), parser__state, parser__state).
Index: parsing_bug.m
===================================================================
RCS file: parsing_bug.m
diff -N parsing_bug.m
--- /dev/null	Wed Nov 11 11:05:01 1998
+++ parsing_bug.m	Wed Nov 11 11:01:37 1998
@@ -0,0 +1,26 @@
+:- module parsing_bug.
+
+:- interface.
+
+:- import_module list, set.
+
+:- func { list(T) } = set(T).
+
+:- func (set(T) /\ set(T)) = set(T).
+
+:- func (set(T) \/ set(T)) = set(T).
+
+:- func (set(T) - set(T)) = set(T).
+
+:- implementation.
+
+{ List } = Set :- list_to_set(List, Set).
+
+A /\ B = C :- set__intersect(A, B, C).
+
+A \/ B = C :- set__union(A, B, C).
+
+A - B = C :- set__difference(A, B, C).
+
+
+
Index: parsing_bug_main.m
===================================================================
RCS file: parsing_bug_main.m
diff -N parsing_bug_main.m
--- /dev/null	Wed Nov 11 11:05:01 1998
+++ parsing_bug_main.m	Wed Nov 11 11:02:33 1998
@@ -0,0 +1,5 @@
+:- module parsing_bug_main.
+:- interface.
+:- import_module parsing_bug.
+
+:- type blah == int.	% just to avoid warning about exporting nothing.
Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.30
diff -u -u -r1.30 Mmakefile
--- Mmakefile	1998/11/10 22:23:06	1.30
+++ Mmakefile	1998/11/11 00:03:14
@@ -82,6 +82,7 @@
 	nasty_func_test.m \
 	nested_mod_type_bug.m \
 	nondet_live.m \
+	parsing_bug_main.m \
 	pred_with_no_modes.m \
 	qualified_cons_id.m \
 	same_length_2.m \

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "Binaries may die
WWW: <http://www.cs.mu.oz.au/~fjh>  |   but source code lives forever"
PGP: finger fjh at 128.250.37.3        |     -- leaked Microsoft memo.



More information about the developers mailing list