[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