[m-rev.] for review: don't opt-export table reset and statistics preds

[Peter Wang]

Branches: main

The bodies of table reset and statistics procedures generated by the
compiler were being written to `.opt' files.  However, those procedures
need access to C variables which are local to their defining modules.

compiler/add_pragma.m:
	Set the `may_not_duplicate' attribute on table reset and
	statistics procedures.

compiler/intermod.m:
	Don't write foreign procedures to `.opt' files if they have the
	`may_not_duplicate' attribute.

tests/tabling/Mercury.options:
tests/tabling/Mmakefile:
tests/tabling/reset_stats_intermod.exp:
tests/tabling/reset_stats_intermod.m:
tests/tabling/reset_stats_intermod_2.m:
	Add test case.

diff --git a/compiler/add_pragma.m b/compiler/add_pragma.m
index 0281c34..77ae0c1 100644
--- a/compiler/add_pragma.m
+++ b/compiler/add_pragma.m
@@ -2798,6 +2798,7 @@ create_tabling_statistics_pred(ProcId, Context, SimpleCallId, SingleProc,
         set_may_call_mercury(proc_may_call_mercury, !Attrs),
         set_thread_safe(proc_thread_safe, !Attrs),
         set_purity(purity_pure, !Attrs),
+        set_may_duplicate(yes(proc_may_not_duplicate), !Attrs),
         varset.init(!:VarSet),
         svvarset.new_named_var("Stats", Stats, !VarSet),
         svvarset.new_named_var("IO0", IO0, !VarSet),
@@ -2855,6 +2856,7 @@ create_tabling_reset_pred(ProcId, Context, SimpleCallId, SingleProc,
         set_may_call_mercury(proc_will_not_call_mercury, !Attrs),
         set_thread_safe(proc_thread_safe, !Attrs),
         set_purity(purity_pure, !Attrs),
+        set_may_duplicate(yes(proc_may_not_duplicate), !Attrs),
         varset.init(!:VarSet),
         svvarset.new_named_var("IO0", IO0, !VarSet),
         svvarset.new_named_var("IO", IO, !VarSet),
diff --git a/compiler/intermod.m b/compiler/intermod.m
index 4605a29..6dd297e 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -520,8 +520,22 @@ intermod_traverse_goal_expr(if_then_else(Vars, Cond0, Then0, Else0),
     bool.and_list([DoWrite1, DoWrite2, DoWrite3], DoWrite).
     % Inlineable exported pragma_foreign_code goals can't use any
     % non-exported types, so we just write out the clauses.
-intermod_traverse_goal_expr(Goal @ call_foreign_proc(_, _, _, _, _, _, _),
-        Goal, yes, !Info).
+intermod_traverse_goal_expr(Goal @ call_foreign_proc(Attrs, _, _, _, _, _, _),
+        Goal, DoWrite, !Info) :-
+    MaybeMayDuplicate = get_may_duplicate(Attrs),
+    (
+        MaybeMayDuplicate = yes(MayDuplicate),
+        (
+            MayDuplicate = proc_may_duplicate,
+            DoWrite = yes
+        ;
+            MayDuplicate = proc_may_not_duplicate,
+            DoWrite = no
+        )
+    ;
+        MaybeMayDuplicate = no,
+        DoWrite = yes
+    ).
 intermod_traverse_goal_expr(shorthand(ShortHand0), shorthand(ShortHand),
         DoWrite, !Info) :-
     (
diff --git a/tests/tabling/Mercury.options b/tests/tabling/Mercury.options
index 9e94a97..2d60698 100644
--- a/tests/tabling/Mercury.options
+++ b/tests/tabling/Mercury.options
@@ -2,3 +2,6 @@
 # tc_minimal works on some machines even in the presence of a known bug
 # if inlining is turned on, so we turn inlining off to make the test tougher.
 MCFLAGS-tc_minimal	=	--no-inlining
+
+MCFLAGS-reset_stats_intermod    = --intermodule-optimisation
+MCFLAGS-reset_stats_intermod_2  = --intermodule-optimisation
diff --git a/tests/tabling/Mmakefile b/tests/tabling/Mmakefile
index a552fdc..94771e3 100644
--- a/tests/tabling/Mmakefile
+++ b/tests/tabling/Mmakefile
@@ -23,6 +23,7 @@ SIMPLE_NONLOOP_PROGS = \
 	mercury_java_parser_dead_proc_elim_bug \
 	mercury_java_parser_dead_proc_elim_bug2 \
 	oota \
+	reset_stats_intermod \
 	specified_hidden_arg \
 	table_foreign_output \
 	table_foreign_enum \
diff --git a/tests/tabling/reset_stats_intermod.exp b/tests/tabling/reset_stats_intermod.exp
new file mode 100644
index 0000000..9766475
--- /dev/null
+++ b/tests/tabling/reset_stats_intermod.exp
@@ -0,0 +1 @@
+ok
diff --git a/tests/tabling/reset_stats_intermod.m b/tests/tabling/reset_stats_intermod.m
new file mode 100644
index 0000000..57d3b47
--- /dev/null
+++ b/tests/tabling/reset_stats_intermod.m
@@ -0,0 +1,27 @@
+% Regression test.  The bodies of generated table reset and statistics were
+% being written to .opt files but they refer to C variables only accessible
+% from the defining module.
+
+:- module reset_stats_intermod.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module reset_stats_intermod_2.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    reset(!IO),
+    statistics(!IO),
+    io.write_string("ok\n", !IO).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
diff --git a/tests/tabling/reset_stats_intermod_2.m b/tests/tabling/reset_stats_intermod_2.m
new file mode 100644
index 0000000..80ecdc0
--- /dev/null
+++ b/tests/tabling/reset_stats_intermod_2.m
@@ -0,0 +1,29 @@
+%-----------------------------------------------------------------------------%
+
+:- module reset_stats_intermod_2.
+:- interface.
+
+:- import_module int.
+:- import_module io.
+
+:- func plus1(int) = int.
+:- pred reset(io::di, io::uo) is det.
+:- pred statistics(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma memo(plus1/1, [allow_reset, statistics]).
+
+plus1(X) = X + 1.
+
+reset(!IO) :-
+    table_reset_for_plus1_1(!IO).
+
+statistics(!IO) :-
+    table_statistics_for_plus1_1(_Stats, !IO).
+
+%-----------------------------------------------------------------------------%
+% 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
--------------------------------------------------------------------------