[m-rev.] Extend recognition of field access syntax

[Ralph Becket]

This could be extended further to make (A ^ f(...) = X) and
((A0 ^ f(...) := X) = A) recognised *everywhere* as synonyms
for the desugared forms.  Is it worth it?

Estimated hours taken: 3
Branches: main

Allow field access syntax at the top-level of func and mode declarations and
in function clause heads.

NEWS:
	Report the new feature.

doc/reference_manual.texi:
	Document the new feature.

compiler/prog_io.m:
	Implement the new feature.

tests/hard_coded/Mmakefile:
tests/hard_coded/field_syntax.exp:
tests/hard_coded/field_syntax.m:
	Added a test case.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.291
diff -u -r1.291 NEWS
--- NEWS	5 Dec 2002 03:52:27 -0000	1.291
+++ NEWS	17 Dec 2002 08:07:08 -0000
@@ -6,6 +6,9 @@
 
 Changes to the Mercury language:
 * Infix `.' is now accepted as a module name separator.
+* Field access syntax can now be used at the top-level in func and mode
+  declarations and in the head of a clause for a user-defined field access
+  function.
 
 Changes to the Mercury compiler:
 * Nothing yet.
@@ -31,6 +34,14 @@
   same thing as io__write_string and list__member, for instance.  This
   has required changing the associativity of `.' from xfy to yfx and
   from precedence 600 to 10.
+
+* Field access notation can now be used at the top-level in func and
+  mode declarations and in the head of a clause for a user-defined
+  field access function.  That is, one can now write
+
+  	:- func a ^ f(b) = c.
+	:- mode a ^ f(b) = c is <detism>.
+	A ^ f(B) = ...
 
 Changes to the Mercury standard library:
 
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.213
diff -u -r1.213 prog_io.m
--- compiler/prog_io.m	5 Dec 2002 03:52:28 -0000	1.213
+++ compiler/prog_io.m	17 Dec 2002 02:40:19 -0000
@@ -979,7 +979,8 @@
 		parse_goal(Body, ProgVarSet, Body2, ProgVarSet2),
 		(
 			Head = term__functor(term__atom("="),
-					[FuncHead, FuncResult], _)
+					[FuncHead0, FuncResult], _),
+			FuncHead = desugar_field_access(FuncHead0)
 		->
 			parse_implicitly_qualified_term(ModuleName,
 				FuncHead, Head, "equation head", R2),
@@ -2327,7 +2328,8 @@
 		ExistQVars, Constraints, InstConstraints, Attributes, Result) :-
 	(
 		Term = term__functor(term__atom("="),
-				[FuncTerm, ReturnTypeTerm], _Context)
+				[FuncTerm0, ReturnTypeTerm], _Context),
+		FuncTerm = desugar_field_access(FuncTerm0)
 	->
 		parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
 			"`:- func' declaration", R),
@@ -2338,7 +2340,6 @@
 		Result = error("`=' expected in `:- func' declaration", Term)
 	).
 
-
 :- pred process_func_3(maybe_functor, term, term, term, varset,
 	maybe(determinism), condition, existq_tvars, class_constraints,
 	inst_var_sub, decl_attrs, maybe1(item)).
@@ -2404,6 +2405,32 @@
 
 %-----------------------------------------------------------------------------%
 
+	% Perform one of the following field-access syntax rewrites if
+	% possible:
+	%
+	% 	A ^ f(B, ...)		--->	f(B, ..., A)
+	% 	(A ^ f(B, ...) := X)	--->	'f :='(B, ..., A, X)
+	%
+:- func desugar_field_access(term) = term.
+
+desugar_field_access(Term) =
+	( if
+		Term = functor(atom("^"), [A, RHS], _),
+		RHS  = functor(atom(FieldName), Bs, Context)
+	  then
+	  	functor(atom(FieldName), Bs ++ [A], Context)
+	  else if
+		Term = functor(atom(":="), [LHS, X], _),
+		LHS  = functor(atom("^"), [A, RHS], Context),
+		RHS  = functor(atom(FieldName), Bs, Context)
+	  then
+	  	functor(atom(FieldName ++ " :="), Bs ++ [A, X], Context)
+	  else
+	  	Term
+	).
+
+%-----------------------------------------------------------------------------%
+
 	% parse a `:- mode p(...)' declaration
 
 :- pred process_mode(module_name, varset, term, condition, decl_attrs,
@@ -2415,7 +2442,8 @@
 	(
 		WithInst = no,
 		Term = term__functor(term__atom("="),
-				[FuncTerm, ReturnTypeTerm], _Context)
+				[FuncTerm0, ReturnTypeTerm], _Context),
+		FuncTerm = desugar_field_access(FuncTerm0)
 	->
 		parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
 				"function `:- mode' declaration", R),
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.263
diff -u -r1.263 reference_manual.texi
--- doc/reference_manual.texi	7 Nov 2002 06:14:09 -0000	1.263
+++ doc/reference_manual.texi	17 Dec 2002 08:16:48 -0000
@@ -1994,6 +1994,17 @@
 :- func elem(K, map(K, V)) = V is semidet.
 :- func 'elem :='(K, map(K, V), V) = map(K, V).
 @end example
+Field access syntax may be used at the top-level of @code{func} and
+ at code{mode} declarations and in the head of clauses.  For instance:
+ at example
+:- func map(K, V) ^ elem(K) = V.
+:- mode in        ^ in      = out is semidet.
+Map ^ elem(Key) = map__lookup(Map, Key).
+
+:- func (map(K, V) ^ elem(K) := V)  = V.
+:- mode (in        ^ in      := in) = out is semidet.
+(Map ^ elem(Key) := Value) = map__set(Map, Key, Value).
+ at end example
 
 The Mercury standard library modules @code{array} and @code{bt_array}
 define similar functions.
@@ -2022,20 +2033,20 @@
 The functions generated for the other fields are similar.
 
 @example
-:- func field1(type1) = type2.
-field1(type1(Field1, _)) = Field1.
+:- func type1 ^ field1 = type2.
+type1(Field1, _) ^ field1 = Field1.
 
-:- func 'field1 :='(type1, type2) = type1.
-'field1 :='(type1(_, Field2), Field1) = type1(Field1, Field2).
+:- func (type1 ^ field1 := type2) = type1.
+(type1(_, Field2) ^ field1 := Field1) = type1(Field1, Field2).
 @end example
 
 Using these functions and the syntactic sugar described in
 @ref{Record syntax}, programmers can write code such as
 
 @example
-:- func increment_field3(type1) = type1.
+:- func type1 ~ increment_field3 = type1.
 
-increment_field3(Term0) =
+Term0 ^ increment_field3 =
         Term0 ^ field1 ^ field3 := Term0 ^ field1 ^ field3 + 1.
 @end example
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.179
diff -u -r1.179 Mmakefile
--- hard_coded/Mmakefile	4 Dec 2002 01:57:29 -0000	1.179
+++ hard_coded/Mmakefile	18 Dec 2002 01:25:42 -0000
@@ -50,6 +50,7 @@
 	export_test \
 	factt \
 	failure_unify \
+	field_syntax \
 	float_consistency \
 	float_field \
 	float_map \
Index: tests/hard_coded/field_syntax.exp
===================================================================
RCS file: hard_coded/field_syntax.exp
diff -N hard_coded/field_syntax.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/field_syntax.exp	18 Dec 2002 01:25:49 -0000
@@ -0,0 +1,4 @@
+A                           = array([1, 2, 3])
+A ^ elem(0)                 = 1
+A ^ elem_from_end(0)        = 3
+(A ^ elem_from_end(2) := 4) = array([4, 2, 3])
Index: tests/hard_coded/field_syntax.m
===================================================================
RCS file: hard_coded/field_syntax.m
diff -N hard_coded/field_syntax.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/field_syntax.m	18 Dec 2002 01:04:54 -0000
@@ -0,0 +1,56 @@
+%-----------------------------------------------------------------------------%
+% field_syntax.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Tue Dec 17 14:13:23 EST 2002
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+%-----------------------------------------------------------------------------%
+
+:- module field_syntax.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array, int, list, string.
+
+%-----------------------------------------------------------------------------%
+
+:- func array(T) ^ elem_from_end(int) = T.
+:- mode array_ui ^ elem_from_end(in)  = out is det.
+
+A ^ elem_from_end(I) = A ^ elem(max(A) - I).
+
+%-----------------------------------------------------------------------------%
+
+:- func (array(T) ^ elem_from_end(int) := T)  = array(T).
+:- mode (array_di ^ elem_from_end(in)  := in) = array_uo is det.
+
+(A ^ elem_from_end(I) := X) = (A ^ elem(max(A) - I) := X).
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    A = array([1, 2, 3]),
+    io.format("A                           = ", [], !IO),
+    io.print(A, !IO),
+    io.nl(!IO),
+    io.format("A ^ elem(0)                 = %d\n",
+        [i(A ^ elem(0))],          !IO),
+    io.format("A ^ elem_from_end(0)        = %d\n",
+        [i(A ^ elem_from_end(0))], !IO),
+    io.format("(A ^ elem_from_end(2) := 4) = ", [], !IO),
+    io.print(A ^ elem_from_end(2) := 4, !IO),
+    io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------