[m-rev.] For review: State-variable record update transformation

[Jonathan Morgan]

This change was posted a few months ago (see
http://www.cs.mu.oz.au/research/mercury/mailing-lists/mercury-reviews/mercury-reviews.200703/0015.html)
and never committed.  The changes to the compiler and reference manual
were reviewed, but the test case and NEWS file weren't.

Jon

========================================================
Estimated hours taken: 2.5
Branches: main

Enhance the state variable notation to recognise !X ^ field_list :=
Term as a synonym for
!:X = !.X ^ field_list := Term.

NEWS:
   Announce the new construct.

compiler/add_clause.m:
  Recognise this new construct, and transform it.

doc/reference_manual.texi:
  Document the change.

tests/hard_coded/Mmakefile:
tests/hard_coded/sv_record_update.m:
tests/hard_coded/sv_record_update.exp:
   A test case for this feature.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.461
diff -u -r1.461 NEWS
--- NEWS	29 May 2007 08:18:24 -0000	1.461
+++ NEWS	29 May 2007 14:15:42 -0000
@@ -14,6 +14,8 @@
   values for each thread.
 * promise_equivalent_solutions scopes (et al.) must now also list variables
   with inst any that may be constrained by the goal.
+* We now support !X ^ field_list := Term as a synonym for
+!:X = !.X ^ field_list := Term.

 Changes to the Mercury standard library:

Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.43
diff -u -r1.43 add_clause.m
--- compiler/add_clause.m	17 May 2007 03:52:38 -0000	1.43
+++ compiler/add_clause.m	29 May 2007 14:15:47 -0000
@@ -820,6 +820,26 @@
             !SInfo, !Specs),
         finish_call(!VarSet, !SInfo)
     ;
+        % check for a state var record assignment:
+        % !Var ^ field := Value
+        Name = unqualified(":="),
+        Args1 = [LHS0, RHS0],
+        LHS0 = functor(atom("^"), [StateVar0, Remainder], FieldListContext),
+        StateVar0 = functor(atom("!"), Args @ [variable(_, _)],
+                StateVarContext)
+    ->
+        prepare_for_call(!SInfo),
+        % !Var ^ field := Value is defined as !:Var = !.Var ^ field := Value.
+        LHS = functor(atom("!:"), Args, StateVarContext),
+        StateVar = functor(atom("!."), Args, StateVarContext),
+        FieldList = functor(atom("^"), [StateVar, Remainder],
+                FieldListContext),
+        RHS = functor(atom(":="), [FieldList, RHS0], Context),
+        transform_goal_2(unify_expr(LHS, RHS, Purity),
+            Context, Subst, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+            !SInfo, !Specs),
+        finish_call(!VarSet, !SInfo)
+    ;
         % check for a DCG field access goal:
         % get: Field =^ field
         % set: ^ field := Field
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.392
diff -u -r1.392 reference_manual.texi
--- doc/reference_manual.texi	25 May 2007 04:24:05 -0000	1.392
+++ doc/reference_manual.texi	29 May 2007 14:16:21 -0000
@@ -1018,6 +1018,17 @@
 some @var{Vars} transform(@var{Goal}, @var{X}, @var{ThisX}, @var{NextX})
 @end example

+ at item !@var{X} ^ @var{field_list} := @var{Term}
+A field update.
+Replaces a field in the argument.
+ at var{Term} must be a valid data-term.
+ at var{field_list} must be a valid field list.
+ at xref{Record syntax}.
+ at example
+transform((!@var{X} ^ @var{field_list} := @var{Term}), @var{X},
@var{ThisX}, @var{NextX}) =
+NextX = ThisX ^ field_list := Term
+ at end example
+
 @item @var{Call_or_Unification}
 If @samp{!:@var{X}} does not appear in @var{Call_or_Unification} then
 @example
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.315
diff -u -r1.315 Mmakefile
--- tests/hard_coded/Mmakefile	20 Apr 2007 05:18:39 -0000	1.315
+++ tests/hard_coded/Mmakefile	29 May 2007 14:16:31 -0000
@@ -204,6 +204,7 @@
 	string_suffix_bug \
 	string_various \
 	sv_nested_closures \
+	sv_record_update \
 	switch_detect \
 	system_sort \
 	target_mlobjs \
Index: tests/hard_coded/sv_record_update.exp
===================================================================
RCS file: tests/hard_coded/sv_record_update.exp
diff -N tests/hard_coded/sv_record_update.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sv_record_update.exp	29 May 2007 14:16:32 -0000
@@ -0,0 +1,2 @@
+type1(3, 12)
+type2(type1(5, 12), 13)
Index: tests/hard_coded/sv_record_update.m
===================================================================
RCS file: tests/hard_coded/sv_record_update.m
diff -N tests/hard_coded/sv_record_update.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sv_record_update.m	29 May 2007 14:16:32 -0000
@@ -0,0 +1,39 @@
+:- module sv_record_update.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+
+:- type type1 --->
+   type1(
+       field1::int,
+       field2::int
+   ).
+
+:- type type2 --->
+   type2(
+       type1::type1,
+       field3::int
+   ).
+
+main(!IO) :-
+   test1(type1(3,4), Type1),
+   io.write(Type1, !IO),
+   io.nl(!IO),
+   test2(type2(Type1, 5), Type2),
+   io.write(Type2, !IO),
+   io.nl(!IO).
+
+:- pred test1(type1::in, type1::out) is det.
+test1(!Type1) :-
+   !Type1 ^ field2 := 12.
+
+:- pred test2(type2::in, type2::out) is det.
+test2(!Type2) :-
+   !Type2 ^ type1 ^ field1 := 5,
+   !Type2 ^ field3 := 13.
+
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------