[m-rev.] diff: atomic scope state variable fix

[Peter Wang]

Branches: main

Fix a problem when one or more of the goals in an atomic scope does not mention
the inner state variable.  The other goals would have bogus unifications added
to them, where the non-final version of the state variable would be used
(a mode error as those variables are clobbered).

compiler/state_var.m:
	In svar_start_inner_atomic_scope, call
	new_dot_state_var/new_colon_state_var instead of new_local_state_var
	which calls new_final_state_var.  new_final_state_var produces names
	which cannot be compared by compare_svar_names, which is used by
	svar_finish_disjunction to tell which variable is higher numbered.

	Add a sanity check.

tests/stm/Mmakefile:
tests/stm/atomic_mvar.exp:
tests/stm/atomic_mvar.m:
	Add a test case.

diff --git a/compiler/state_var.m b/compiler/state_var.m
index d053957..b7bbfb4 100644
--- a/compiler/state_var.m
+++ b/compiler/state_var.m
@@ -693,7 +693,8 @@ svar_finish_outer_atomic_scope(OuterScopeInfo, !SInfo) :-
 
 svar_start_inner_atomic_scope(_Context, InnerStateVar, InnerScopeInfo,
         !VarSet, !SInfo, !Specs) :-
-    new_local_state_var(InnerStateVar, InnerDI, _, !VarSet, !SInfo),
+    new_dot_state_var(InnerStateVar, InnerDI, !VarSet, !SInfo),
+    new_colon_state_var(InnerStateVar, _, !VarSet, !SInfo),
     InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDI,
         !.SInfo).
 
@@ -718,6 +719,12 @@ svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
         ;
             unexpected(this_file, "transform_goal_2: |Vars| != 2")
         )
+    ),
+    ( InnerDI = InnerUO ->
+        unexpected(this_file,
+            "svar_inner_atomic_scope_info: InnerDI = InnerUO")
+    ;
+        true
     ).
 
 %-----------------------------------------------------------------------------%
diff --git a/tests/stm/Mmakefile b/tests/stm/Mmakefile
index c0e9781..69676fe 100644
--- a/tests/stm/Mmakefile
+++ b/tests/stm/Mmakefile
@@ -14,6 +14,7 @@ VALID_PROGS = 			\
 	atomic_or_else		\
 	atomic_conj			\
 	atomic_ite			\
+	atomic_mvar			\
 	#demo				\
 	par-asm_test7		\
 	par-asm_test8		\
diff --git a/tests/stm/atomic_mvar.exp b/tests/stm/atomic_mvar.exp
new file mode 100644
index 0000000..7ecb56e
--- /dev/null
+++ b/tests/stm/atomic_mvar.exp
@@ -0,0 +1 @@
+no
diff --git a/tests/stm/atomic_mvar.m b/tests/stm/atomic_mvar.m
new file mode 100644
index 0000000..3a43d9f
--- /dev/null
+++ b/tests/stm/atomic_mvar.m
@@ -0,0 +1,79 @@
+% Test that the state variable transformation works on an atomic goal that
+% doesn't mention the inner state variable (e.g. try_put_mvar).
+
+:- module atomic_mvar.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool.
+:- import_module maybe.
+:- import_module stm_builtin.
+
+:- type mvar(T)
+    --->    mvar(
+                stm_var(maybe(T))
+            ).
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    new_mvar(MVar, !IO),
+    atomic [outer(!IO), inner(!STM)] (
+        put_mvar(MVar, "one", !STM)
+    ),
+    atomic [outer(!IO), inner(!STM)] (
+        try_put_mvar(MVar, "two", Success, !STM)
+    ),
+    io.write(Success, !IO),
+    io.nl(!IO).
+
+:- pred new_mvar(mvar(T)::out, io::di, io::uo) is det.
+
+new_mvar(mvar(TVar), !IO) :-
+    new_stm_var(no, TVar, !IO).
+
+:- pred take_mvar(mvar(T)::in, T::out, stm::di, stm::uo) is det.
+
+take_mvar(mvar(TVar), T, !STM) :-
+    read_stm_var(TVar, Maybe, !STM),
+    (
+        Maybe = yes(T),
+        write_stm_var(TVar, no, !STM)
+    ;
+        Maybe = no,
+        retry(!.STM)
+    ).
+
+:- pred put_mvar(mvar(T)::in, T::in, stm::di, stm::uo) is det.
+
+put_mvar(mvar(TVar), T, !STM) :-
+    read_stm_var(TVar, Maybe, !STM),
+    (
+        Maybe = yes(_),
+        retry(!.STM)
+    ;
+        Maybe = no,
+        write_stm_var(TVar, yes(T), !STM)
+    ).
+
+:- pred try_put_mvar(mvar(T)::in, T::in, bool::out, stm::di, stm::uo) is cc_multi.
+
+try_put_mvar(MVar, T, Success, !STM) :-
+    atomic [outer(!STM), inner(!STM1)] (
+        put_mvar(MVar, T, !STM1),
+        Success = yes
+    or_else
+        % !STM1 not mentioned.
+        Success = no
+    ).
+
+%-----------------------------------------------------------------------------%
+% 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
--------------------------------------------------------------------------