[m-dev.] Added module qualified backquoted operators to the syntax

[Ralph Becket]

Estimated hours taken: 1

library/parser.m:
	Extended parser__parse_rest//5 to handle backquoted operators with
	a (single) module qualifier so that e.g. (A `set.union` B) will
	parse successfully.

tests/hard_coded/infix_qualified_ops.m:
tests/hard_coded/infix_qualified_ops.exp:
tests/hard_coded/Mmakefile:
	Test case added.

Index: library/parser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.42
diff -u -r1.42 parser.m
--- library/parser.m	26 May 2003 09:00:30 -0000	1.42
+++ library/parser.m	22 Dec 2003 02:52:32 -0000
@@ -457,18 +457,40 @@
 			(
 				{ OpToken = name(NameOp) }
 			->
-				{ Op = NameOp },
-				{ VariableTerm = [] }
+					% XXX This code only handles one
+					% optional level of explicit module
+					% qualification of an operator name.
+					% Ideally it should handle multiple
+					% levels of qualification.
+					%
+				(
+					parser__get_token(name(".")),
+					parser__get_token(name(SndNameOp))
+				->
+						% It's a qualified name.
+						%
+					{ Op = SndNameOp },
+					{ VariableTerm = [] },
+					{ Qualified = yes(NameOp) }
+				;
+						% It's an unqualified name.
+						%
+					{ Op = NameOp },
+					{ VariableTerm = [] },
+					{ Qualified = no }
+				)
 			;
 				{ OpToken = variable(VariableOp) },
 				{ Op = "" },
 				parser__add_var(VariableOp, Var),
-				{ VariableTerm = [term__variable(Var)] }
+				{ VariableTerm = [term__variable(Var)] },
+				{ Qualified = no }
 			),
 			parser__get_token(name("`"), _)
 		;
 			{ Op = Op0 },
 			{ VariableTerm = [] },
+			{ Qualified = no },
 			parser__get_ops_table(OpTable),
 			{ ops__lookup_infix_op(OpTable, Op,
 					OpPriority, LeftAssoc, RightAssoc) }
@@ -481,10 +503,22 @@
 		parser__parse_term_2(RightPriority, TermKind, RightTerm0),
 		( { RightTerm0 = ok(RightTerm) } ->
 			parser__get_term_context(Context, TermContext),
-			{ OpTerm = term__functor(term__atom(Op),
+			{ OpTerm0 = term__functor(term__atom(Op),
 				list__append(VariableTerm,
 					[LeftTerm, RightTerm]),
 				TermContext) },
+			(
+				{ Qualified = no },
+				{ OpTerm = OpTerm0 }
+			;
+				{ Qualified = yes(ModuleName) },
+				{ QualifierTerm =
+					term__functor(term__atom(ModuleName),
+						[], TermContext) },
+				{ OpTerm = term__functor(term__atom("."),
+					[QualifierTerm, OpTerm0],
+					TermContext) }
+			),
 			parser__parse_rest(MaxPriority, TermKind, OpPriority,
 				OpTerm, Term)
 		;
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.215
diff -u -r1.215 Mmakefile
--- tests/hard_coded/Mmakefile	19 Dec 2003 02:43:59 -0000	1.215
+++ tests/hard_coded/Mmakefile	22 Dec 2003 02:47:41 -0000
@@ -91,6 +91,7 @@
 	impossible_unify \
 	impure_foreign \
 	impure_prune \
+	infix_qualified_ops \
 	integer_test \
 	intermod_c_code \
 	intermod_foreign_type \
Index: tests/hard_coded/infix_qualified_ops.exp
===================================================================
RCS file: tests/hard_coded/infix_qualified_ops.exp
diff -N tests/hard_coded/infix_qualified_ops.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/infix_qualified_ops.exp	22 Dec 2003 02:47:56 -0000
@@ -0,0 +1 @@
+2 + 2 = 4
Index: tests/hard_coded/infix_qualified_ops.m
===================================================================
RCS file: tests/hard_coded/infix_qualified_ops.m
diff -N tests/hard_coded/infix_qualified_ops.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/infix_qualified_ops.m	22 Dec 2003 02:47:24 -0000
@@ -0,0 +1,39 @@
+%-----------------------------------------------------------------------------%
+% infix_qualified_ops.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Mon Dec 22 13:45:14 EST 2003
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% Tests that the parser recognises backquoted, module-qualified operator
+% names.
+%
+%-----------------------------------------------------------------------------%
+
+:- module infix_qualified_ops.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io :: di, io :: uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int, string, list.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    io.format("2 + 2 = %d\n", [i(2 `infix_qualified_ops.add` 2)]).
+
+:- func int `infix_qualified_ops.add` int = int.
+
+X `infix_qualified_ops.add` Y  =  X + Y.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------