[m-rev.] for review: fix stm expansion of or_else alternatives

[Peter Wang]

Branches: main

Fix a problem with the STM transformation of or_else alternatives.  Input
variables which are needed for later alternatives but not the "main" atomic
goal weren't being passed down through the generated predicates.

compiler/stm_expand.m:
	As above.

	Add a missing call to stm_discard_transaction_log in the generated
	code.

	Fix some typos.

library/stm_builtin.m:
	Fix a branch of branch of or_else/5 which called stm_unlock when the
	STM lock would not be acquired in that code path.

tests/stm/Mmakefile:
tests/stm/atomic_or_else2.exp:
tests/stm/atomic_or_else2.m:
	Add test case for the main fix.

diff --git a/compiler/stm_expand.m b/compiler/stm_expand.m
index d8a61c3..8dce332 100644
--- a/compiler/stm_expand.m
+++ b/compiler/stm_expand.m
@@ -39,8 +39,8 @@
 %       IO0 = IO.
 %
 %
-%   :- pred 'StmExpaded_rollback_0_0_0'(int::in, int::out) is cc_multi.
-%   'StmExpaded_rollback_0_0_0'(X, Y) :-
+%   :- pred 'StmExpanded_rollback_0_0_0'(int::in, int::out) is cc_multi.
+%   'StmExpanded_rollback_0_0_0'(X, Y) :-
 %       promise_pure (
 %           impure stm_create_trasaction_log(STM0),
 %           Closure = 'StmExpanded_wrapper_0_0_0'(X),
@@ -548,6 +548,13 @@ order_vars_into_groups_2(ModuleInfo, [Var|Vars], InitInstmap, FinalInstmap,
     order_vars_into_groups_2(ModuleInfo, Vars, InitInstmap, FinalInstmap,
         !LocalVars, !InputVars, !OutputVars).
 
+    % Return the var sets for the first atomic goal in the list, taking the
+    % union of the input var sets of all the goals.  If the first atomic goal
+    % does not succeed, we will try the later goals, so inputs to the later
+    % goals must also be inputs of the first goal.
+    %
+    % XXX This probably could done directly in calc_pred_variables_list.
+    %
 :- pred common_goal_vars_from_list(list(stm_goal_vars)::in, stm_goal_vars::out)
     is det.
 
@@ -817,11 +824,10 @@ create_top_level_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO,
 
 create_top_level_pred(AtomicGoalVarList, OuterDI, OuterUO, AtomicGoal,
         OrElseGoals, HldsGoal, !StmInfo) :-
-    AtomicGoalVars = list.det_head(AtomicGoalVarList),
-
     create_rollback_pred(AtomicGoalVarList, WrapperCall, AtomicGoal,
         OrElseGoals, !StmInfo),
 
+    common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars),
     get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars),
     get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, OutputTypes),
     get_input_output_modes(AtomicGoalVars, InputModes, OutputModes),
@@ -1036,7 +1042,12 @@ create_validate_exception_goal(StmVar, ExceptionVar, ReturnType, RecursiveCall,
         HldsGoal_ExceptionThrow_Call, !NewPredInfo),
     create_plain_conj(CreateTypeInfoGoals ++ [HldsGoal_ExceptionThrow_Call],
         HldsGoal_ValidBranch),
-    create_plain_conj([RecursiveCall], HldsGoal_InvalidBranch),
+    create_simple_call(mercury_stm_builtin_module,
+        "stm_discard_transaction_log",
+        pf_predicate, only_mode, detism_det, purity_impure, [StmVar], [],
+        instmap_delta_from_assoc_list([StmVar - ground(clobbered, none)]),
+        DropStateCall, !NewPredInfo),
+    create_plain_conj([DropStateCall, RecursiveCall], HldsGoal_InvalidBranch),
     template_lock_and_validate(StmVar, yes, HldsGoal_ValidBranch,
         HldsGoal_InvalidBranch, HldsGoals, !NewPredInfo),
     create_plain_conj(HldsGoals, HldsGoal).
@@ -1183,8 +1194,7 @@ create_rollback_handler_goal(AtomicGoalVars, ReturnType, StmVarDI, StmVarUO,
 
 create_rollback_pred(AtomicGoalVarList, CallGoal, AtomicGoal, OrElseGoals,
         !StmInfo) :-
-    AtomicGoalVars = list.det_head(AtomicGoalVarList),
-
+    common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars),
     get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars),
     get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, OutputTypes),
     get_input_output_modes(AtomicGoalVars, InputModes, OutputModes),
@@ -1203,11 +1213,11 @@ create_rollback_pred(AtomicGoalVarList, CallGoal, AtomicGoal, OrElseGoals,
 
 create_rollback_pred_2(AtomicGoalVarList, RecCallGoal, AtomicGoal, OrElseGoals,
         !NewPredInfo, !StmInfo) :-
-    AtomicGoalVars = list.det_head(AtomicGoalVarList),
+    common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars),
 
     get_input_output_types(AtomicGoalVars, !.StmInfo, _, OutputTypes),
     make_return_type(OutputTypes, ResultType),
-    create_aux_variable(ResultType, yes("ResltVar"), ResultVar, !NewPredInfo),
+    create_aux_variable(ResultType, yes("ResultVar"), ResultVar, !NewPredInfo),
     create_aux_variable(stm_state_type, yes("STM0"), InnerDI, !NewPredInfo),
     create_aux_variable(stm_state_type, yes("STM"), InnerUO, !NewPredInfo),
 
diff --git a/library/stm_builtin.m b/library/stm_builtin.m
index 6a2f126..fc504da 100644
--- a/library/stm_builtin.m
+++ b/library/stm_builtin.m
@@ -530,7 +530,7 @@ or_else(TransA, TransB, Result, OuterSTM0, OuterSTM) :-
                         throw(rollback_invalid_transaction)
                     )
                 ;
-                    impure stm_unlock,
+                    impure stm_discard_transaction_log(InnerSTM_B),
                     rethrow(ResultB)
                 )
             )
diff --git a/tests/stm/Mmakefile b/tests/stm/Mmakefile
index 8b3f149..ff0b0b3 100644
--- a/tests/stm/Mmakefile
+++ b/tests/stm/Mmakefile
@@ -12,6 +12,7 @@ VALID_PROGS = 			\
 	nested				\
 	nested_or_else		\
 	atomic_or_else		\
+	atomic_or_else2		\
 	atomic_conj			\
 	atomic_ite			\
 	atomic_mvar			\
diff --git a/tests/stm/atomic_or_else2.exp b/tests/stm/atomic_or_else2.exp
new file mode 100644
index 0000000..27c65ac
--- /dev/null
+++ b/tests/stm/atomic_or_else2.exp
@@ -0,0 +1 @@
+TVar2 is non-zero
diff --git a/tests/stm/atomic_or_else2.m b/tests/stm/atomic_or_else2.m
new file mode 100644
index 0000000..82e3494
--- /dev/null
+++ b/tests/stm/atomic_or_else2.m
@@ -0,0 +1,43 @@
+%-----------------------------------------------------------------------------%
+
+:- module atomic_or_else2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module stm_builtin.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    new_stm_var(0, TVar1, !IO),
+    new_stm_var(1, TVar2, !IO),
+    atomic [outer(!IO), inner(!STM)] (
+        nonzero(TVar1, !STM),
+        Msg = "TVar1 is non-zero"
+    or_else
+        nonzero(TVar2, !STM),
+        Msg = "TVar2 is non-zero"
+    ),
+    io.write_string(Msg, !IO),
+    io.nl(!IO).
+
+:- pred nonzero(stm_var(int)::in, stm::di, stm::uo) is det.
+
+nonzero(TVar, !STM) :-
+    read_stm_var(TVar, X, !STM),
+    ( X = 0 ->
+        retry(!.STM)
+    ;
+        true
+    ).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------