[m-rev.] for review: make private_builtin.store_at_ref impure

[Peter Wang]

These would be committed over some period of time.

=============================================================================

Branches: main

`private_builtin.store_at_ref' is currently pure but should be impure.
There would be bootstrapping problems if we just made it impure, as it is
a builtin that the compiler needs to recognise.  Instead, we will add a
new predicate `store_at_ref_impure' to take its place.  This needs to be
done in three steps:

1. Get the compiler to recognise `store_at_ref_impure' as a builtin.

2. After step 1 has bootstrapped, add the predicate declaration for
   `store_at_ref_impure'.  Change generated code to call it.

3. After step 2 has bootstrapped, delete `store_at_ref'.  The stage1
   compiler in step 2 could be built by a compiler that still generates
   references to `store_at_ref' so we couldn't just delete it at step 2.


This is also part of fixing Mantis bug #42.  The bug there is that we
didn't generate a valid definition for `store_at_ref'; the procedure
existed but had an empty body.  Calls to `store_at_ref' introduced by the
LCMC optimisation are normally replaced by inline code, but with
`--no-inlining-builtins' we would call the procedure, which did nothing.


compiler/builtin_ops.m:
	Add a builtin translation for `store_at_ref_impure'.

library/private_builtin.m:
	Add the declaration of `store_at_ref_impure', commented out for now.

compiler/add_pred.m:
	Generate non-no-op procedures for `private_builtin.store_at_ref'
	and `private_builtin.store_at_ref_impure'.

compiler/term_constr_initial.m:
mdbcomp/program_representation.m:
	Handle `store_at_ref_impure' in a couple of spots.

compiler/options.m:
	Add a option that we can use to check if the bootstrap compiler
	recognises `store_at_ref_impure'.

diff --git a/compiler/add_pred.m b/compiler/add_pred.m
index fe2309c..14d4259 100644
--- a/compiler/add_pred.m
+++ b/compiler/add_pred.m
@@ -240,13 +240,10 @@ add_builtin(PredId, Types, !PredInfo) :-
 
     goal_info_init(Context, GoalInfo0),
     NonLocals = proc_arg_vector_to_set(HeadVars),
-    goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
+    goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo1),
     (
         Module = mercury_private_builtin_module,
         (
-            Name = "store_at_ref",
-            StubPrime = no
-        ;
             ( Name = "builtin_compound_eq"
             ; Name = "builtin_compound_lt"
             ),
@@ -254,6 +251,7 @@ add_builtin(PredId, Types, !PredInfo) :-
         )
     ->
         GoalExpr = conj(plain_conj, []),
+        GoalInfo = GoalInfo1,
         ExtraVars = [],
         ExtraTypes = [],
         VarSet = VarSet0,
@@ -292,6 +290,7 @@ add_builtin(PredId, Types, !PredInfo) :-
 
         Reason = promise_purity(dont_make_implicit_promises, purity_semipure),
         GoalExpr = scope(Reason, ConjGoal),
+        GoalInfo = GoalInfo1,
         Stub = no
     ;
         Module = mercury_private_builtin_module,
@@ -301,6 +300,7 @@ add_builtin(PredId, Types, !PredInfo) :-
         ConjGoal = hlds_goal(ConjExpr, GoalInfo),
         Reason = promise_purity(dont_make_implicit_promises, purity_impure),
         GoalExpr = scope(Reason, ConjGoal),
+        GoalInfo = GoalInfo1,
         ExtraVars = [],
         ExtraTypes = [],
         VarSet = VarSet0,
@@ -314,6 +314,8 @@ add_builtin(PredId, Types, !PredInfo) :-
         % XXX ARGVEC
         GoalExpr = plain_call(PredId, ModeId, HeadVarList, inline_builtin,
             MaybeUnifyContext, SymName),
+        pred_info_get_purity(!.PredInfo, Purity),
+        goal_info_set_purity(Purity, GoalInfo1, GoalInfo),
         ExtraVars = [],
         ExtraTypes = [],
         VarSet = VarSet0,
diff --git a/compiler/builtin_ops.m b/compiler/builtin_ops.m
index 82d099b..4080468 100644
--- a/compiler/builtin_ops.m
+++ b/compiler/builtin_ops.m
@@ -181,6 +181,8 @@ builtin_translation("private_builtin", "trace_set_io_state", 0, [_X],
 
 builtin_translation("private_builtin", "store_at_ref", 0, [X, Y],
     ref_assign(X, Y)).
+builtin_translation("private_builtin", "store_at_ref_impure", 0, [X, Y],
+    ref_assign(X, Y)).
 
     % Note that the code we generate for unsafe_type_cast is not type-correct.
     % Back-ends that require type-correct intermediate code (e.g. the MLDS
diff --git a/compiler/options.m b/compiler/options.m
index cdef083..028c6c3 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -2615,6 +2615,8 @@ long_option("foreign-enum-switch-fix",
                                     compiler_sufficiently_recent).
 long_option("failing-disjunct-in-switch-dup-fix",
                                     compiler_sufficiently_recent).
+long_option("store-at-ref-impure-2008-09-04",
+                                    compiler_sufficiently_recent).
 long_option("experiment",           experiment).
 long_option("feedback-file",        feedback_file).
 
diff --git a/compiler/term_constr_initial.m b/compiler/term_constr_initial.m
index 2494e08..77cf632 100644
--- a/compiler/term_constr_initial.m
+++ b/compiler/term_constr_initial.m
@@ -558,6 +558,7 @@ process_no_type_info_builtin(PredName, HeadVars, SizeVarMap) = Constraints :-
             ConstraintsPrime = [make_vars_eq_constraint(SizeVar1, SizeVar2)]
         ;
             ( PredName = "store_at_ref"
+            ; PredName = "store_at_ref_impure"
             ; PredName = "builtin_compound_eq"
             ; PredName = "builtin_compound_lt"
             )
diff --git a/library/private_builtin.m b/library/private_builtin.m
index d6dedd7..3c9c3ec 100644
--- a/library/private_builtin.m
+++ b/library/private_builtin.m
@@ -1450,6 +1450,7 @@ const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_pseudo_type_info = {
     % will happen if this is used in programs.
     %
 :- pred store_at_ref(store_at_ref_type(T)::in, T::in) is det.
+% :- impure pred store_at_ref_impure(store_at_ref_type(T)::in, T::in) is det.
 
     % This type should be used only by the program transformation that
     % introduces calls to store_at_ref. Any other use is will cause bad things
diff --git a/mdbcomp/program_representation.m b/mdbcomp/program_representation.m
index e4fa56c..7e533a4 100644
--- a/mdbcomp/program_representation.m
+++ b/mdbcomp/program_representation.m
@@ -1558,6 +1558,7 @@ no_type_info_builtin(ModuleName, PredName, Arity) :-
     is semidet.
 
 no_type_info_builtin_2(private_builtin, "store_at_ref", 2).
+no_type_info_builtin_2(private_builtin, "store_at_ref_impure", 2).
 no_type_info_builtin_2(private_builtin, "unsafe_type_cast", 2).
 no_type_info_builtin_2(builtin, "unsafe_promise_unique", 2).
 no_type_info_builtin_2(private_builtin,

=============================================================================

Branches: main

Step 2 in replacing `private_builtin.store_at_ref' by an impure
`private_builtin.store_at_ref_impure' predicate.

configure.in:
	Check that the bootstrap compiler recognises `store_at_ref_impure'.

library/private_builtin.m:
	Add the predicate declaration for `store_at_ref_impure'.

compiler/lco.m:
	Make generated code call `store_at_ref_impure'.

tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/lco_no_inline.exp:
tests/hard_coded/lco_no_inline.m:
	Add test case for Mantis bug #42.

diff --git a/compiler/lco.m b/compiler/lco.m
index a8a9918..508eb3a 100644
--- a/compiler/lco.m
+++ b/compiler/lco.m
@@ -1021,17 +1021,9 @@ is_grounding(ModuleInfo, InstMap0, InstMap, Var - _AddrVar) :-
     hlds_goal::out) is det.
 
 make_store_goal(ModuleInfo, Var - AddrVar, Goal) :-
-    generate_simple_call(mercury_private_builtin_module, "store_at_ref",
-        pf_predicate, only_mode, detism_det, purity_pure, [AddrVar, Var],
-        [], [], ModuleInfo, term.context_init, Goal0),
-    %
-    % XXX the following hack is used to stop simplify from trying to
-    %      optimise the introduced call away.  store_at_ref/2 should
-    %      really be declared to be impure.
-    %
-    Goal0 = hlds_goal(GoalExpr, GoalInfo0),
-    goal_info_set_purity(purity_impure, GoalInfo0, GoalInfo),
-    Goal  = hlds_goal(GoalExpr, GoalInfo).
+    generate_simple_call(mercury_private_builtin_module, "store_at_ref_impure",
+        pf_predicate, only_mode, detism_det, purity_impure, [AddrVar, Var],
+        [], [], ModuleInfo, term.context_init, Goal).
 
 %-----------------------------------------------------------------------------%
 
diff --git a/configure.in b/configure.in
index e2ed501..b490fa0 100644
--- a/configure.in
+++ b/configure.in
@@ -347,6 +347,7 @@ EOF
             --no-no-det-warning-compound-compare-2007-07-17 \
             --foreign-enum-switch-fix \
             --no-ssdb \
+            --store-at-ref-impure-2008-09-04 \
             </dev/null >&AC_FD_CC 2>&1 &&
         test "`./conftest 2>&1 | tr -d '\015'`" = "Hello, world" &&
         # Test for the --record-term-sizes-as-words option.
diff --git a/library/private_builtin.m b/library/private_builtin.m
index 3c9c3ec..73f1e2f 100644
--- a/library/private_builtin.m
+++ b/library/private_builtin.m
@@ -1446,11 +1446,15 @@ const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_pseudo_type_info = {
 
 :- pred unsafe_type_cast(T1::in, T2::out) is det.
 
-    % store_at_ref/2 is used internally by the compiler. Bad things
+    % store_at_ref_impure/2 is used internally by the compiler. Bad things
     % will happen if this is used in programs.
     %
+:- impure pred store_at_ref_impure(store_at_ref_type(T)::in, T::in) is det.
+
+    % This is deprecated. The compiler should now generate calls to
+    % store_at_ref_impure.
+    %
 :- pred store_at_ref(store_at_ref_type(T)::in, T::in) is det.
-% :- impure pred store_at_ref_impure(store_at_ref_type(T)::in, T::in) is det.
 
     % This type should be used only by the program transformation that
     % introduces calls to store_at_ref. Any other use is will cause bad things
diff --git a/tests/hard_coded/Mercury.options b/tests/hard_coded/Mercury.options
index f08bc36..9b84734 100644
--- a/tests/hard_coded/Mercury.options
+++ b/tests/hard_coded/Mercury.options
@@ -38,6 +38,7 @@ MCFLAGS-intermod_type_qual =	--intermodule-optimization
 MCFLAGS-intermod_type_qual2 =	--intermodule-optimization
 MCFLAGS-intermod_multimode =	--intermodule-optimization
 MCFLAGS-intermod_multimode_main = --intermodule-optimization
+MCFLAGS-lco_no_inline	    =	--optimize-constructor-last-call --no-inline-builtins
 MCFLAGS-reuse_ho            =	--ctgc --no-optimise-higher-order
 MCFLAGS-sharing_comb	    =	--ctgc --structure-sharing-widening 2
 MCFLAGS-uncond_reuse	    =	--ctgc
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index df68298..b79487a 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -137,6 +137,7 @@ ORDINARY_PROGS=	\
 	intermod_type_qual \
 	intermod_unused_args \
 	join_list \
+	lco_no_inline \
 	list_series_int \
 	loop_inv_test \
 	loop_inv_test1 \
diff --git a/tests/hard_coded/lco_no_inline.exp b/tests/hard_coded/lco_no_inline.exp
new file mode 100644
index 0000000..4cb83cb
--- /dev/null
+++ b/tests/hard_coded/lco_no_inline.exp
@@ -0,0 +1 @@
+["one", "two", "two"]
diff --git a/tests/hard_coded/lco_no_inline.m b/tests/hard_coded/lco_no_inline.m
new file mode 100644
index 0000000..f24f380
--- /dev/null
+++ b/tests/hard_coded/lco_no_inline.m
@@ -0,0 +1,42 @@
+% Regression test.  There was no out-of-line definition of
+% private_builtin.store_at_ref which is required for
+% --optimise-constructor-last-call and --no-inline-builtins to work together.
+
+%-----------------------------------------------------------------------------%
+
+:- module lco_no_inline.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module pair.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    AL = ["one" - 1, "two" - 2],
+    to_list_2(AL, L),
+    io.write(L, !IO),
+    io.nl(!IO).
+
+:- pred to_list_2(list(pair(string, int))::in, list(string)::out) is det.
+
+to_list_2([], []).
+to_list_2([X - Int | Xs], Out) :-
+    ( Int =< 0 ->
+        to_list_2(Xs, Out)
+    ;
+        NewInt = Int - 1,
+        to_list_2([X - NewInt | Xs], Out0),
+        Out = [X | Out0]
+    ).
+
+%-----------------------------------------------------------------------------%

=============================================================================

Branches: main

Step 3 in replacing `private_builtin.store_at_ref' by an impure
`private_builtin.store_at_ref_impure' predicate.

compiler/builtin_ops.m:
compiler/term_constr_initial.m:
library/private_builtin.m:
mdbcomp/program_representation.m:
	Delete references to `private_builtin.store_at_ref'.

diff --git a/compiler/builtin_ops.m b/compiler/builtin_ops.m
index 4080468..714295a 100644
--- a/compiler/builtin_ops.m
+++ b/compiler/builtin_ops.m
@@ -179,8 +179,6 @@ builtin_translation("private_builtin", "trace_get_io_state", 0, [X],
 builtin_translation("private_builtin", "trace_set_io_state", 0, [_X],
     noop([])).
 
-builtin_translation("private_builtin", "store_at_ref", 0, [X, Y],
-    ref_assign(X, Y)).
 builtin_translation("private_builtin", "store_at_ref_impure", 0, [X, Y],
     ref_assign(X, Y)).
 
diff --git a/compiler/term_constr_initial.m b/compiler/term_constr_initial.m
index 77cf632..faf0dfc 100644
--- a/compiler/term_constr_initial.m
+++ b/compiler/term_constr_initial.m
@@ -557,8 +557,7 @@ process_no_type_info_builtin(PredName, HeadVars, SizeVarMap) = Constraints :-
             SizeVar2 = prog_var_to_size_var(SizeVarMap, HVar2),
             ConstraintsPrime = [make_vars_eq_constraint(SizeVar1, SizeVar2)]
         ;
-            ( PredName = "store_at_ref"
-            ; PredName = "store_at_ref_impure"
+            ( PredName = "store_at_ref_impure"
             ; PredName = "builtin_compound_eq"
             ; PredName = "builtin_compound_lt"
             )
diff --git a/library/private_builtin.m b/library/private_builtin.m
index 73f1e2f..5ae56de 100644
--- a/library/private_builtin.m
+++ b/library/private_builtin.m
@@ -1451,14 +1451,9 @@ const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_pseudo_type_info = {
     %
 :- impure pred store_at_ref_impure(store_at_ref_type(T)::in, T::in) is det.
 
-    % This is deprecated. The compiler should now generate calls to
-    % store_at_ref_impure.
-    %
-:- pred store_at_ref(store_at_ref_type(T)::in, T::in) is det.
-
     % This type should be used only by the program transformation that
-    % introduces calls to store_at_ref. Any other use is will cause bad things
-    % to happen.
+    % introduces calls to store_at_ref_impure. Any other use will cause bad
+    % things to happen.
 :- type store_at_ref_type(T)
     --->    store_at_ref_type(int).
 
diff --git a/mdbcomp/program_representation.m b/mdbcomp/program_representation.m
index 7e533a4..419c451 100644
--- a/mdbcomp/program_representation.m
+++ b/mdbcomp/program_representation.m
@@ -1557,7 +1557,6 @@ no_type_info_builtin(ModuleName, PredName, Arity) :-
 :- pred no_type_info_builtin_2(builtin_mod::out, string::in, int::in)
     is semidet.
 
-no_type_info_builtin_2(private_builtin, "store_at_ref", 2).
 no_type_info_builtin_2(private_builtin, "store_at_ref_impure", 2).
 no_type_info_builtin_2(private_builtin, "unsafe_type_cast", 2).
 no_type_info_builtin_2(builtin, "unsafe_promise_unique", 2).


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