[m-rev.] Fix bug with state vars in promise_equivalent_solutions goals

Ralph Becket rafe at cs.mu.OZ.AU
Thu Apr 14 13:05:52 AEST 2005


Estimated hours taken: 4
Branches: main

Fix a bug where state variables in the variable list of a
promise_equivalent_solutions goal were not handled.

compiler/prog_data.m:
	Adjust the promise_equivalent_solutions data constructor to
	include extra fields for "dot" and "colon" state variables in
	the variable list.

compiler/make_hlds.m:
	Adjust the transformation of promise_equivalent_solutions goals
	to ensure that !.X and !:X in the variable list correspond to the
	"initial" and "final" versions, respectively, of state variable X in
	the transformed goal body.

compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/prog_io_goal.m:
compiler/prog_util.m:
	Adjust for the new promise_equivalent_solutions constructor fields.

compiler/prog_io_util.m:
	Add parse_vars_and_state_vars/4 to handle state variables
	appearing in the variable list of a promise_equivalent_solutions
	goal.

tests/hard_coded/Mmakefile:
tests/hard_coded/promise_equiv_with_svars.m:
tests/hard_coded/promise_equiv_with_svars.exp:
	Added test case.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.509
diff -u -r1.509 make_hlds.m
--- compiler/make_hlds.m	7 Apr 2005 06:32:09 -0000	1.509
+++ compiler/make_hlds.m	13 Apr 2005 07:45:42 -0000
@@ -6762,13 +6762,21 @@
         !SInfo, !IO),
     goal_info_init(GoalInfo).
 
-transform_goal_2(promise_equivalent_solutions(Vars0, Goal0), _, Subst,
+transform_goal_2(
+        promise_equivalent_solutions(Vars0, DotSVars0, ColonSVars0, Goal0),
+        Context, Subst,
         scope(promise_equivalent_solutions(Vars), Goal) - GoalInfo,
         !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
-    substitute_vars(Vars0, Subst, Vars),
+    substitute_vars(Vars0, Subst, Vars1),
+    substitute_vars(DotSVars0, Subst, DotSVars1),
+    convert_dot_state_vars(Context, DotSVars1, DotSVars, !VarSet, !SInfo, !IO),
     transform_goal(Goal0, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo,
         !SInfo, !IO),
-    goal_info_init(GoalInfo).
+    goal_info_init(GoalInfo),
+    substitute_vars(ColonSVars0, Subst, ColonSVars1),
+    convert_dot_state_vars(Context, ColonSVars1, ColonSVars, !VarSet,
+        !SInfo, !IO),
+    Vars = Vars1 ++ DotSVars ++ ColonSVars.
 
 transform_goal_2(if_then_else(Vars0, StateVars0, Cond0, Then0, Else0), Context,
         Subst, if_then_else(Vars, Cond, Then, Else) - GoalInfo,
@@ -6956,6 +6964,31 @@
             !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
         finish_call(!VarSet, !SInfo)
     ).
+
+
+:- pred convert_dot_state_vars(prog_context::in, prog_vars::in, prog_vars::out,
+        prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+        io::di, io::uo) is det.
+
+convert_dot_state_vars(_Context, [], [], !VarSet, !SInfo, !IO).
+
+convert_dot_state_vars(Context, [Dot0 | Dots0], [Dot | Dots],
+        !VarSet, !SInfo, !IO) :-
+    dot(Context, Dot0, Dot, !VarSet, !SInfo, !IO),
+    convert_dot_state_vars(Context, Dots0, Dots, !VarSet, !SInfo, !IO).
+
+
+:- pred convert_colon_state_vars(prog_context::in,
+        prog_vars::in, prog_vars::out, prog_varset::in, prog_varset::out,
+        svar_info::in, svar_info::out, io::di, io::uo) is det.
+
+convert_colon_state_vars(_Context, [], [], !VarSet, !SInfo, !IO).
+
+convert_colon_state_vars(Context, [Colon0 | Colons0], [Colon | Colons],
+        !VarSet, !SInfo, !IO) :-
+    colon(Context, Colon0, Colon, !VarSet, !SInfo, !IO),
+    convert_colon_state_vars(Context, Colons0, Colons, !VarSet, !SInfo, !IO).
+
 
 :- pred report_svar_unify_error(prog_context::in, prog_varset::in, svar::in,
     io::di, io::uo) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.256
diff -u -r1.256 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	7 Apr 2005 06:32:11 -0000	1.256
+++ compiler/mercury_to_mercury.m	13 Apr 2005 06:07:10 -0000
@@ -2548,17 +2548,40 @@
         io__write_string(")", !IO)
     ).
 
-mercury_output_goal_2(promise_equivalent_solutions(Vars, Goal), VarSet,
+mercury_output_goal_2(
+        promise_equivalent_solutions(Vars, DotSVars, ColonSVars, Goal), VarSet,
         Indent, !IO) :-
     (
         Vars = [],
+        DotSVars = [],
+        ColonSVars = []
+    ->
         % This should have been caught be prog_io_goal when reading in
         % the term, but there is no point in aborting here.
         mercury_output_goal(Goal, VarSet, Indent, !IO)
     ;
-        Vars = [_ | _],
         io__write_string("promise_equivalent_solutions [", !IO),
         mercury_output_vars(Vars, VarSet, no, !IO),
+        (
+            Vars \= [],
+            DotSVars \= []
+        ->
+            io.write_string(", ", !IO)
+        ;
+            true
+        ),
+        mercury_output_state_vars_using_prefix(DotSVars, "!.", VarSet, no,
+            !IO),
+        (
+            ( Vars \= [] ; DotSVars \= [] ),
+            ColonSVars \= []
+        ->
+            io.write_string(", ", !IO)
+        ;
+            true
+        ),
+        mercury_output_state_vars_using_prefix(ColonSVars, "!:", VarSet, no,
+            !IO),
         io__write_string("] (", !IO),
         Indent1 = Indent + 1,
         mercury_output_newline(Indent1, !IO),
@@ -2657,6 +2680,27 @@
     mercury_output_term(A, VarSet, no, !IO),
     io__write_string(" = ", !IO),
     mercury_output_term(B, VarSet, no, next_to_graphic_token, !IO).
+
+
+:- pred mercury_output_state_vars_using_prefix(prog_vars::in, string::in,
+        prog_varset::in, bool::in, io::di, io::uo) is det.
+
+mercury_output_state_vars_using_prefix([], _BangPrefix, _VarSet,
+        _AppendVarnums, !IO).
+mercury_output_state_vars_using_prefix([SVar | SVars], BangPrefix, VarSet,
+        AppendVarnums, !IO) :-
+    io__write_string(BangPrefix, !IO),
+    mercury_format_var(SVar, VarSet, AppendVarnums, !IO),
+    (
+        SVars \= []
+    ->
+        io__write_string(", ", !IO)
+    ;
+        true
+    ),
+    mercury_output_state_vars_using_prefix(SVars, BangPrefix, VarSet,
+        AppendVarnums, !IO).
+
 
 :- pred mercury_output_call(sym_name::in, list(prog_term)::in, prog_varset::in,
     int::in, io::di, io::uo) is det.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.102
diff -u -r1.102 module_qual.m
--- compiler/module_qual.m	7 Apr 2005 06:32:12 -0000	1.102
+++ compiler/module_qual.m	13 Apr 2005 06:25:26 -0000
@@ -486,7 +486,8 @@
 	process_assert(G, Symbols, Success).
 process_assert(promise_purity(_I, _P, G) - _, Symbols, Success) :-
 	process_assert(G, Symbols, Success).
-process_assert(promise_equivalent_solutions(_V, G) - _, Symbols, Success) :-
+process_assert(promise_equivalent_solutions(_V, _D, _C, G) - _,
+		Symbols, Success) :-
 	process_assert(G, Symbols, Success).
 process_assert(implies(GA, GB) - _, Symbols, Success) :-
 	process_assert(GA, SymbolsA, SuccessA),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.124
diff -u -r1.124 prog_data.m
--- compiler/prog_data.m	7 Apr 2005 06:32:13 -0000	1.124
+++ compiler/prog_data.m	13 Apr 2005 03:28:56 -0000
@@ -1099,7 +1099,9 @@
 
 	% other scopes
 	;	promise_purity(implicit_purity_promise, purity, goal)
-	;	promise_equivalent_solutions(prog_vars, goal)
+	;	promise_equivalent_solutions(prog_vars, prog_vars, prog_vars,
+			goal)	% (OrdinaryVars, DotStateVars, ColonStateVars,
+				% Goal)
 
 	% implications
 	;	implies(goal, goal)	% A => B
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.32
diff -u -r1.32 prog_io_goal.m
--- compiler/prog_io_goal.m	24 Mar 2005 05:34:13 -0000	1.32
+++ compiler/prog_io_goal.m	13 Apr 2005 03:20:51 -0000
@@ -255,9 +255,11 @@
 
 parse_goal_2("promise_equivalent_solutions", [OVars, A0], GoalExpr, !V):-
 	parse_goal(A0, A, !V),
-	parse_vars(OVars, Vars0),
+	parse_vars_and_state_vars(OVars, Vars0, DotSVars0, ColonSVars0),
 	list__map(term__coerce_var, Vars0, Vars),
-	GoalExpr = promise_equivalent_solutions(Vars, A).
+	list__map(term__coerce_var, DotSVars0, DotSVars),
+	list__map(term__coerce_var, ColonSVars0, ColonSVars),
+	GoalExpr = promise_equivalent_solutions(Vars, DotSVars, ColonSVars, A).
 
 parse_goal_2("promise_pure", [A0], GoalExpr, !V):-
 	parse_goal(A0, A, !V),
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.35
diff -u -r1.35 prog_io_util.m
--- compiler/prog_io_util.m	24 Mar 2005 05:34:13 -0000	1.35
+++ compiler/prog_io_util.m	13 Apr 2005 03:20:08 -0000
@@ -79,6 +79,16 @@
 	%
 :- pred parse_vars(term(T)::in, list(var(T))::out) is semidet.
 
+	% parse_vars_and_state_vars(Term, OrdinaryVars, DotStateVars,
+	% 	ColonStateVars).
+	% Similar to parse_vars, but also allow state variables to appear
+	% in the list.  The outputs separate the parsed variables into
+	% ordinary variables, state variables listed as !.X, and state
+	% variables listed as !:X.
+	%
+:- pred parse_vars_and_state_vars(term(T)::in, list(var(T))::out,
+	list(var(T))::out, list(var(T))::out) is semidet.
+
 :- pred parse_name_and_arity(module_name::in, term(_T)::in,
 	sym_name::out, arity::out) is semidet.
 
@@ -587,6 +597,24 @@
 	parse_vars(T, !:Vs),
 	H = variable(V),
 	!:Vs = [V | !.Vs].
+
+parse_vars_and_state_vars(functor(atom("[]"),  [],     _), [],   [],   []).
+parse_vars_and_state_vars(functor(atom("[|]"), [H, T], _), !:Os, !:Ds, !:Cs) :-
+	parse_vars_and_state_vars(T, !:Os, !:Ds, !:Cs),
+	(
+		H = functor(atom("!"), [variable(V)], _),
+		!:Ds = [V | !.Ds],
+		!:Cs = [V | !.Cs]
+	;
+		H = functor(atom("!."), [variable(V)], _),
+		!:Ds = [V | !.Ds]
+	;
+		H = functor(atom("!:"), [variable(V)], _),
+		!:Cs = [V | !.Cs]
+	;
+		H = variable(V),
+		!:Os = [V | !.Os]
+	).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.75
diff -u -r1.75 prog_util.m
--- compiler/prog_util.m	2 Apr 2005 17:10:01 -0000	1.75
+++ compiler/prog_util.m	13 Apr 2005 06:34:54 -0000
@@ -436,9 +436,13 @@
 		promise_purity(Implicit, Purity, Goal)) :-
 	prog_util__rename_in_goal(OldVar, NewVar, Goal0, Goal).
 prog_util__rename_in_goal_expr(OldVar, NewVar,
-		promise_equivalent_solutions(Vars0, Goal0),
-		promise_equivalent_solutions(Vars, Goal)) :-
+		promise_equivalent_solutions(Vars0, DotSVars0, ColonSVars0,
+		Goal0),
+		promise_equivalent_solutions(Vars, DotSVars, ColonSVars,
+		Goal)) :-
 	prog_util__rename_in_vars(OldVar, NewVar, Vars0, Vars),
+	prog_util__rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
+	prog_util__rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
 	prog_util__rename_in_goal(OldVar, NewVar, Goal0, Goal).
 prog_util__rename_in_goal_expr(OldVar, NewVar, implies(GoalA0, GoalB0),
 		implies(GoalA, GoalB)) :-
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.253
diff -u -r1.253 Mmakefile
--- tests/hard_coded/Mmakefile	24 Mar 2005 05:34:32 -0000	1.253
+++ tests/hard_coded/Mmakefile	14 Apr 2005 02:26:06 -0000
@@ -133,6 +133,7 @@
 	pragma_inline \
 	pretty_printing \
 	promise_equivalent_solutions_test \
+	promise_equiv_with_svars \
 	qual_adv_test \
 	qual_basic_test \
 	qual_is_test \
Index: tests/hard_coded/promise_equiv_with_svars.exp
===================================================================
RCS file: tests/hard_coded/promise_equiv_with_svars.exp
diff -N tests/hard_coded/promise_equiv_with_svars.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/promise_equiv_with_svars.exp	14 Apr 2005 02:25:34 -0000
@@ -0,0 +1 @@
+[1, 2, 3, 4]
Index: tests/hard_coded/promise_equiv_with_svars.m
===================================================================
RCS file: tests/hard_coded/promise_equiv_with_svars.m
diff -N tests/hard_coded/promise_equiv_with_svars.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/promise_equiv_with_svars.m	14 Apr 2005 02:25:34 -0000
@@ -0,0 +1,67 @@
+%-----------------------------------------------------------------------------%
+% promise_equiv_with_svars.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Wed Apr 13 17:38:55 EST 2005
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% Test that promise_equivalent_solutions does the right thing if
+% state variables are included in the variable list.
+%
+%-----------------------------------------------------------------------------%
+
+:- module promise_equiv_with_svars.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io :: di, io :: uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int, list.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    p1(A),
+    p2(B),
+    p3(C, D),
+    io.print([A, B, C, D], !IO),
+    io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred p1(int::out) is det.
+
+p1(!.X) :-
+    promise_equivalent_solutions [!.X] (
+        !.X = 1
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred p2(int::out) is det.
+
+p2(!:X) :-
+    promise_equivalent_solutions [!:X] (
+        !:X = 2
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred p3(int::out, int::out) is det.
+
+p3(!X) :-
+    promise_equivalent_solutions [!X] (
+        !.X = 3,
+        !:X = !.X + 1
+    ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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