[m-rev.] For review: State Variables

Ralph Becket rafe at cs.mu.OZ.AU
Fri Jun 28 11:31:36 AEST 2002


Simon Taylor, Thursday, 27 June 2002:
> 
> I was talking about if-then-else _goals_, not expressions.

I beg your pardon.  I'd thought that the scoping rule extending
outer-most existential quantification in if-then-else expression
conditions to include the then-expression was an ite-expression specific
twist.  But I see that I was wrong about that.

Here's the interdiff:

diff -u make_hlds.m make_hlds.m
--- make_hlds.m	25 Jun 2002 06:45:05 -0000
+++ make_hlds.m	28 Jun 2002 01:24:23 -0000
@@ -5842,16 +5842,39 @@
 transform_goal_2(if_then_else(Vars0, A0, B0, C0), Context, VarSet0, Subst,
 		if_then_else(Vars, A, B, C) - GoalInfo, VarSet,
 		Info0, Info, SInfo0, SInfo) -->
+
 	{ substitute_vars(Vars0, Subst, Vars) },
-	transform_goal(A0, VarSet0, Subst, A,  VarSet1, Info0, Info1,
-		SInfo0, SInfoA),
-	transform_goal(B0, VarSet1, Subst, B1, VarSet2, Info1, Info2,
-		SInfoA, SInfoB),
-	transform_goal(C0, VarSet2, Subst, C1, VarSet3, Info2, Info,
+
+	{ if A0 = some_state_vars(StateVars0a, A0a) - _Ctxt then
+		substitute_vars(StateVars0a, Subst, StateVars),
+		A1        = A0a
+	  else
+	  	StateVars = [],
+		A1        = A0
+	},
+
+	{ prepare_for_if_then_else_goal(StateVars, VarSet0, VarSet1,
+		SInfo0, SInfoA0) },
+
+	transform_goal(A1, VarSet1, Subst, A,  VarSet2, Info0, Info1,
+		SInfoA0, SInfoA1),
+
+	{ finish_if_then_else_goal_condition(StateVars,
+		SInfo0, SInfoA1, SInfoA, SInfoB0) },
+
+	transform_goal(B0, VarSet2, Subst, B1, VarSet3, Info1, Info2,
+		SInfoB0, SInfoB1),
+
+	{ finish_if_then_else_goal_then_goal(StateVars,
+		SInfo0, SInfoB1, SInfoB) },
+
+	transform_goal(C0, VarSet3, Subst, C1, VarSet4, Info2, Info,
 		SInfo0, SInfoC),
+
 	{ goal_info_init(GoalInfo) },
+
 	{ finish_if_then_else(Context, GoalInfo, B1, B, C1, C,
-		SInfo0, SInfoA, SInfoB, SInfoC, SInfo, VarSet3, VarSet) }.
+		SInfo0, SInfoA, SInfoB, SInfoC, SInfo, VarSet4, VarSet) }.
 
 transform_goal_2(if_then(Vars0, A0, B0), Context, Subst, VarSet0,
 		Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
@@ -9269,8 +9292,8 @@
 :- mode finish_local_state_vars(in, out, in, in, out) is det.
 
 finish_local_state_vars(StateVars, Vars, SInfoBefore, SInfo0, SInfo) :-
-	Dots   = list__map(map__lookup(SInfo0 ^ dot),   StateVars),
-	Colons = list__map(map__lookup(SInfo0 ^ colon), StateVars),
+	Dots   = svar_mappings(SInfo0 ^ dot  , StateVars),
+	Colons = svar_mappings(SInfo0 ^ colon, StateVars),
 	Vars   = list__sort_and_remove_dups(Dots ++ Colons),
 	SInfo  = (( SInfo0 ^ dot   := del_locals(StateVars,
 							SInfoBefore ^ dot,
@@ -9280,13 +9303,24 @@
 							SInfo0 ^ colon) ).
 
 
+:- func svar_mappings(svar_map, svars) = svars.
+
+svar_mappings(_,   []                    ) = [].
+
+svar_mappings(Map, [StateVar | StateVars]) =
+	( if   Map ^ elem(StateVar) = Var
+	  then [Var | svar_mappings(Map, StateVars)]
+	  else svar_mappings(Map, StateVars)
+	).
+
+
 :- func del_locals(svars, svar_map, svar_map) = svar_map.
 
 del_locals(StateVars, MapBefore, Map) =
 	list__foldl(
 		func(K, M) =
-			( if   MapBefore ^ elem(K) = V
-			  then M ^ elem(K) := V
+			( if   MapBefore ^ elem(K) =  V
+			  then M         ^ elem(K) := V
 			  else map__delete(M, K)
 			),
 		StateVars,
@@ -9595,56 +9629,29 @@
 :- mode compare_svar_names(out, in, in) is det.
 
 compare_svar_names(R, A, B) :-
-	csvns_1(R, 1, A, length(A), B, length(B)).
+	compare(R, int_suffix_of(A), int_suffix_of(B)).
 
 
-	% First find the start of the numbers at the right hand end, if
-	% present.
+	% Find the number suffix at the end of a string as an int.
 	%
-:- pred csvns_1(comparison_result, int, string, int, string, int).
-:- mode csvns_1(out, in, in, in, in, in) is det.
+:- func int_suffix_of(string) = int.
 
-csvns_1(R, I, A, MaxA, B, MaxB) :-
-	( if I < MaxA, I < MaxB then
-		X = A `unsafe_index` (MaxA - I),
-		Y = B `unsafe_index` (MaxB - I),
-		( if is_digit(X), is_digit(Y)      then
-			csvns_1(R, I + 1, A, MaxA, B, MaxB)
-		  else if X = ('_'),   is_digit(Y) then
-		  	R = (<)
-		  else if is_digit(X), Y = ('_')   then
-		  	R = (>)
-		  else if X = ('_'),   Y = ('_')   then
-		  	csvns_2(R, I - 1, A, MaxA, B, MaxB)
-		  else if X = Y                    then
-		  	R = (=)
-		  else
-			error("make_hlds__compare_svar_names: \
-names are not in expected format")
-		)
-	  else
-		error("make_hlds__compare_svar_names: \
-names are not in expected format")
-	).
+int_suffix_of(S) = int_suffix_2(S, length(S) - 1, 1, 0).
 
 
-	% Decide the greater of the two numbers at the right hand end
-	% (both numbers will have the same number of digits.)
+	% int_suffix_2(String, Index, RadixOfIndexDigit, IntSoFar) = IntSuffix
 	%
-:- pred csvns_2(comparison_result, int, string, int, string, int).
-:- mode csvns_2(out, in, in, in, in, in) is det.
+:- func int_suffix_2(string, int, int, int) = int.
 
-csvns_2(R, I, A, MaxA, B, MaxB) :-
-	( if 0 < I then
-		X = A `unsafe_index` (MaxA - I) `with_type` char,
-		Y = B `unsafe_index` (MaxB - I) `with_type` char,
-		compare(RXY, X, Y),
-		(	RXY = (<),	R = (<)
-		;	RXY = (=),	csvns_2(R, I - 1, A, MaxA, B, MaxB)
-		;	RXY = (>),	R = (>)
-		)
+int_suffix_2(S, I, R, N) =
+	( if
+		0 =< I,
+		digit_to_int(S `unsafe_index` I, D),
+		D  < 10
+	  then
+		int_suffix_2(S, I - 1, 10 * R, (R * D) + N)
 	  else
-	  	R = (=)
+	  	N
 	).
 
 %------------------------------------------------------------------------------%
@@ -9704,6 +9711,35 @@
 	  else
 	  	error("make_hlds__finish_call: ctxt is not in_atom")
 	).
+
+%------------------------------------------------------------------------------%
+
+:- pred prepare_for_if_then_else_goal(svars, prog_varset, prog_varset,
+		svar_info, svar_info).
+:- mode prepare_for_if_then_else_goal(in, in, out, in, out) is det.
+
+prepare_for_if_then_else_goal(StateVars, VarSet0, VarSet, SInfo0, SInfo) :-
+	prepare_for_local_state_vars(StateVars, VarSet0, VarSet, SInfo0, SInfo).
+
+%------------------------------------------------------------------------------%
+
+:- pred finish_if_then_else_goal_condition(svars,
+		svar_info, svar_info, svar_info, svar_info).
+:- mode finish_if_then_else_goal_condition(in, in, in, out, out) is det.
+
+finish_if_then_else_goal_condition(StateVars,
+		SInfoBefore, SInfoA0, SInfoA, SInfoB) :-
+	SInfoB = SInfoA0,
+	finish_local_state_vars(StateVars, _, SInfoBefore, SInfoA0, SInfoA).
+
+%------------------------------------------------------------------------------%
+
+:- pred finish_if_then_else_goal_then_goal(svars,
+		svar_info, svar_info, svar_info).
+:- mode finish_if_then_else_goal_then_goal(in, in, in, out) is det.
+
+finish_if_then_else_goal_then_goal(StateVars, SInfoBefore, SInfoB0, SInfoB) :-
+	finish_local_state_vars(StateVars, _, SInfoBefore, SInfoB0, SInfoB).
 
 %------------------------------------------------------------------------------%
 

> I also haven't seen any test cases for quantified if-then-else
> goals or expressions.

In tests/general:

Index: state_vars_tests.m
===================================================================
RCS file: state_vars_tests.m
diff -N state_vars_tests.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ state_vars_tests.m	28 Jun 2002 01:26:41 -0000
@@ -0,0 +1,266 @@
+%------------------------------------------------------------------------------%
+% state_vars_tests.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Wed Apr  3 14:19:02 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_tests.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module std_util, string, int, list.
+
+%------------------------------------------------------------------------------%
+
+main(!IO) :-
+    unsorted_solutions(test, S),
+    io__print(list__reverse(S) `with_type` list(int), !IO),
+    io__nl(!IO).
+
+%------------------------------------------------------------------------------%
+
+:- pred test(int::out) is multi.
+
+test(X) :-
+    add(1, 0, X).
+
+test(X) :-
+    some [!A] (
+        add(2, 0, !:A), X = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0, add(3, !A), X = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 4, not fail, X = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 5, not (add(1, !A), !.A = 5), X = !.A
+    ).
+
+test(X) :-
+    some [!A, !B] (
+        !:A = 1, !:B = 1, add(1, !A), add(2, !B), X = !.A * !.B
+    ).
+
+test(X) :-
+    some [!A] (
+        ( if true then !:A = 7 else !:A = -1 ), X = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        ( if fail then !:A = -1 else !:A = 8 ), X = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0, ( if t(!.A, _) then !:A = 9 else !:A = -1 ), X = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0, ( if f(!.A, _) then !:A = -1 else !:A = 10 ), X = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        ( if ( f(!A) ; t(!A) ), !.A = 1 then !:A = 11 else !:A = -1 ),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        ( if ( t(!A) ; f(!A) ), !.A = 1 then !:A = 12 else !:A = -1 ),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        ( add(13, !A) ; add(14, !A) ),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A, !B] (
+        !:A = 1,
+        !:B = 1,
+        ( add(14, !A) ; add(15, !B) ),
+        X   = !.A * !.B
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        !:A = fn_a(17, !.A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        !:A = fn_b(18, !.A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        F   = ( func(!.B) = !:B :-
+                    !:B = !.B + 19 ),
+        !:A = F(!.A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        F   = ( func(!.B) = !.B + 20 ),
+        !:A = F(!.A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        F   = ( func(!.A) = !:A :-
+                    !:A = !.A + 21 ),
+        !:A = F(!.A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        F   = ( func(!.A) = !.A + 22 ),
+        !:A = F(!.A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        P   = ( pred(!.B :: in, !:B :: out) is det :- !:B = !.B + 23 ),
+        P(!A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        P   = ( pred(!.B :: in, (!.B + 24) :: out) is det ),
+        P(!A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        P   = ( pred(!.A :: in, !:A :: out) is det :- !:A = !.A + 25 ),
+        P(!A),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        P   = ( pred(!.A :: in, (!.A + 26) :: out) is det ),
+        P(!A),
+        X   = !.A
+    ).
+
+test(!:A * !:B) :-
+    !:A = 2,
+    add(1, !A),
+    !:B = 8,
+    add(1, !B).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        ( if   add(28, !A)
+          then true
+          else !:A = -1
+        ),
+        X   = !.A
+    ).
+
+test(X) :-
+    some [!A] (
+        !:A = 0,
+        ( if   add(0, !A)
+          then !:A = !.A + 29
+          else true
+        ),
+        X   = !.A
+    ).
+
+test(X) :-
+     X =
+        ( if   ( some [!A] !:A = 30 )
+          then !.A
+          else 0
+        ).
+
+test(X) :-
+    ( if   ( some [!A] !:A = 31 )
+      then X = !.A
+      else X = 0
+    ).
+
+%------------------------------------------------------------------------------%
+
+:- pred add(int::in, int::in, int::out) is det.
+
+add(N, X, X + N).
+
+
+:- pred t(int::in, int::out) is semidet.
+
+t(!X) :-
+    !:X = !.X + 1,
+    semidet_succeed.
+
+
+:- pred f(int::in, int::out) is semidet.
+
+f(!X) :-
+    X0  = !.X,
+    !:X = !.X + 1,
+    !.X = X0.
+
+
+:- func fn_a(int, int) = int.
+
+fn_a(N, !.X) = !:X :-
+    !:X = !.X + N.
+
+
+:- func fn_b(int, int) = int.
+
+fn_b(N, !.X) = !.X + N.
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
Index: state_vars_typeclasses.m
===================================================================
RCS file: state_vars_typeclasses.m
diff -N state_vars_typeclasses.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ state_vars_typeclasses.m	5 Jun 2002 07:04:44 -0000
@@ -0,0 +1,35 @@
+%------------------------------------------------------------------------------%
+% state_vars_typeclasses.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Fri May 31 14:28:03 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_typeclasses.
+
+:- interface.
+
+:- import_module io.
+
+
+:- pred main(io::di, io::uo) is det.
+
+
+:- implementation.
+
+:- import_module int, string, list.
+
+
+:- typeclass foo(T) where [ func f(T) = T, pred p(T::in, T::out) is det ].
+
+:- instance foo(int) where [
+    p(!X),
+    f(!.X) = !:X + 1
+].
+
+
+main(!IO) :-
+    p(1, A),
+    B = f(1),
+    format("p(1, %d).\nf(1) = %d.\n", [i(A), i(B)], !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
--------------------------------------------------------------------------



More information about the reviews mailing list