[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