Allow mutable variables to be initialised by impure functions.

Branches: main, 11.07

Allow mutable variables to be initialised by impure functions.

Also fix bug #223.  Make thread.semaphore.init/1 and thread.mvar.init/1
impure, as they should be.  They were introduced to be used as mutable
initialisers, which led to the oversight of making them pure.

compiler/make_hlds_passes.m:
compiler/prog_mutable.m:
	Modify the generated mutable initialisation predicates such that the
	initial value may be the return value of a impure function call.

compiler/purity.m:
	Ignore warnings about unnecessary impure annotations on goals in
	generated mutable predicates.  These would now appear when
	a mutable is initialised by a call to a pure function, or
	by a constant.

doc/reference_manual.texi:
NEWS:
	Document the language change.

library/thread.mvar.m:
library/thread.semaphore.m:
	Make thread.semaphore.init/1 and thread.mvar.init/1 impure.

tests/hard_coded/Mmakefile:
tests/hard_coded/mutable_init_impure.exp:
tests/hard_coded/mutable_init_impure.m:
	Add test case.

NEWS

@@ -13,6 +13,9 @@ Changes to the Mercury language:
   (or XXXXXXXX) is a Unicode character code in hexadecimal, is replaced with
   the corresponding Unicode character.
 
+* Expressions used to initialise mutables may now contain impure
+  or semipure function calls.
+
 Changes to the Mercury standard library:
 
 * We have improved Unicode support in the standard library.

compiler/make_hlds_passes.m

@@ -2493,7 +2493,7 @@ add_ccsj_mutable_user_access_preds(ModuleName, MutableName, MutAttrs,
     list(error_spec)::in, list(error_spec)::out) is det.
 
 add_c_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
-        ModuleName, MutableName, MutVarset, InitSetPredName, InitTerm, Attrs,
+        ModuleName, MutableName, MutVarset0, InitSetPredName, InitTerm, Attrs,
         Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
     % Add the `:- initialise' declaration for the mutable initialisation
     % predicate.
@@ -2506,11 +2506,16 @@ add_c_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
     add_item_pass_3(InitItem, !Status, !ModuleInfo, !QualInfo, !Specs),
 
     % Add the clause for the mutable initialisation predicate.
+    varset.new_named_var("X", X, MutVarset0, MutVarset),
+    UnifyExpr =
+        unify_expr(variable(X, Context), InitTerm, purity_impure)
+            - Context,
     (
         IsConstant = yes,
-        InitClauseExpr =
-            call_expr(InitSetPredName, [InitTerm], purity_impure)
-                - Context
+        CallExpr =
+            call_expr(InitSetPredName, [variable(X, Context)], purity_impure)
+                - Context,
+        InitClauseExpr = conj_expr(UnifyExpr, CallExpr) - Context
     ;
         IsConstant = no,
         (
@@ -2549,9 +2554,10 @@ add_c_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
         CallPreInitExpr =
             call_expr(PreInitPredName, [], purity_impure) - Context,
         CallSetPredExpr =
-            call_expr(InitSetPredName, [InitTerm], purity_impure) - Context,
-        InitClauseExpr = conj_expr(CallPreInitExpr, CallSetPredExpr)
-            - Context
+            call_expr(InitSetPredName, [variable(X, Context)], purity_impure)
+                - Context,
+        InitClauseExpr = goal_list_to_conj(Context,
+            [CallPreInitExpr, UnifyExpr, CallSetPredExpr])
     ),
 
     % See the comments for prog_io.parse_mutable_decl for the reason
@@ -2833,7 +2839,7 @@ add_csharp_java_mutable_primitive_preds(Lang, TargetMutableName, ModuleName,
     module_info::in, module_info::out, qual_info::in, qual_info::out,
     list(error_spec)::in, list(error_spec)::out) is det.
 
-add_csharp_java_mutable_initialisation(ModuleName, MutableName, MutVarset,
+add_csharp_java_mutable_initialisation(ModuleName, MutableName, MutVarset0,
         CallPreInitExpr, InitSetPredName, InitTerm,
         Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
     % Add the `:- initialise' declaration for the mutable initialisation
@@ -2847,12 +2853,15 @@ add_csharp_java_mutable_initialisation(ModuleName, MutableName, MutVarset,
     add_item_pass_3(InitItem, !Status, !ModuleInfo, !QualInfo, !Specs),
 
     % Add the clause for the mutable initialisation predicate.
+    varset.new_named_var("X", X, MutVarset0, MutVarset),
+    UnifyExpr =
+        unify_expr(variable(X, Context), InitTerm, purity_impure)
+            - Context,
     CallSetPredExpr =
-        call_expr(InitSetPredName, [InitTerm], purity_impure)
-            - Context,
-    InitClauseExpr =
-        conj_expr(CallPreInitExpr, CallSetPredExpr)
+        call_expr(InitSetPredName, [variable(X, Context)], purity_impure)
             - Context,
+    InitClauseExpr = goal_list_to_conj(Context,
+        [CallPreInitExpr, UnifyExpr, CallSetPredExpr]),
 
     % See the comments for prog_io.parse_mutable_decl for the reason
     % why we _must_ use MutVarset here.
@@ -3081,7 +3090,7 @@ erlang_mutable_set_code(TargetMutableName) =
     list(error_spec)::in, list(error_spec)::out) is det.
 
 add_erlang_mutable_initialisation(ModuleName, MutableName,
-        MutVarset, InitSetPredName, InitTerm,
+        MutVarset0, InitSetPredName, InitTerm,
         Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
     % Add the `:- initialise' declaration for the mutable initialisation
     % predicate.
@@ -3096,11 +3105,16 @@ add_erlang_mutable_initialisation(ModuleName, MutableName,
     %
     % See the comments for prog_io.parse_mutable_decl for the reason
     % why we _must_ use MutVarset here.
+    varset.new_named_var("X", X, MutVarset0, MutVarset),
+    UnifyExpr =
+        unify_expr(variable(X, Context), InitTerm, purity_impure)
+            - Context,
+    CallExpr =
+        call_expr(InitSetPredName, [variable(X, Context)], purity_impure)
+            - Context,
+    InitClauseExpr = conj_expr(UnifyExpr, CallExpr) - Context,
     PredItemClause = item_clause_info(compiler(mutable_decl), MutVarset,
-        pf_predicate, InitPredName, [],
-        call_expr(InitSetPredName, [InitTerm], purity_impure) - Context,
-        Context, -1
-    ),
+        pf_predicate, InitPredName, [], InitClauseExpr, Context, -1),
     PredItem = item_clause(PredItemClause),
     add_item_pass_3(PredItem, !Status, !ModuleInfo, !QualInfo, !Specs).
 

compiler/prog_mutable.m

@@ -58,7 +58,8 @@
 %
 %   initialise_mutable_<varname> :-
 %       impure pre_initialise_mutable_<varname>,
-%       impure set_<varname>(<initval>).
+%       impure X = <initval>,
+%       impure set_<varname>(X).
 % 
 %   :- impure pred pre_initialise_mutable_<varname> is det.
 %   :- pragma foreign_proc("C",
@@ -209,7 +210,8 @@
 %   :- impure pred initialise_mutable_<varname> is det.
 %
 %   initialise_mutable_<varname> :-
-%       impure secret_initialization_only_set_<varname>(<initval>).
+%       impure X = <initval>,
+%       impure secret_initialization_only_set_<varname>(X).
 %
 %-----------------------------------------------------------------------------%
 %
@@ -230,7 +232,8 @@
 %   :- impure pred initialise_mutable_<varname> is det.
 %
 %   initialise_mutable_<varname> :-
-%       impure set_<varname>(<initval>).
+%       impure X = <initval>,
+%       impure set_<varname>(X).
 %
 % <JType> is either `int' or `java.lang.Object' (all other types).
 %
@@ -335,7 +338,8 @@
 %   :- impure pred initialise_mutable_<varname> is det.
 %
 %   initialise_mutable_<varname> :-
-%       impure secret_initialization_only_set_<varname>(<initval>).
+%       impure X = <initval>,
+%       impure secret_initialization_only_set_<varname>(X).
 %
 %-----------------------------------------------------------------------------%
 %
@@ -358,7 +362,8 @@
 %
 %   initialise_mutable_<varname> :-
 %       impure pre_initialise_mutable_<varname>,
-%       impure set_<varname>(<initvalue>).
+%       impure X = <initvalue>,
+%       impure set_<varname>(X).
 %
 %   :- pragma foreign_proc("C#",
 %       pre_initialise_mutable_<varname>,
@@ -407,7 +412,8 @@
 %   :- impure pred initialise_mutable_<varname> is det.
 %
 %   initialise_mutable_<varname> :-
-%       impure set_<varname>(<initval>).
+%       impure X = <initval>,
+%       impure set_<varname>(X).
 %
 %   :- impure pred set_<varname>(<vartype>::in(<varinst>)) is det.
 %   :- pragma foreign_proc("Erlang",
@@ -464,7 +470,8 @@
 %   :- impure pred initialise_mutable_<varname> is det.
 %
 %   initialise_mutable_<varname> :-
-%       impure secret_initialization_only_set_<varname>(<initval>).
+%       impure X = <initval>,
+%       impure secret_initialization_only_set_<varname>(X).
 %
 % The transformation for thread_local mutables has not been decided (we need a
 % way for spawned processes to inherit all the thread-local mutable values of

compiler/purity.m

@@ -855,20 +855,20 @@ check_higher_order_purity(GoalInfo, ConsId, Var, Args, ActualPurity, !Info) :-
     % variable's type.
     VarTypes = !.Info ^ pi_vartypes,
     map.lookup(VarTypes, Var, TypeOfVar),
+    PredInfo = !.Info ^ pi_pred_info,
+    pred_info_get_markers(PredInfo, CallerMarkers),
     Context = goal_info_get_context(GoalInfo),
     (
         ConsId = cons(PName, _, _),
         type_is_higher_order_details(TypeOfVar, TypePurity, PredOrFunc,
             _EvalMethod, VarArgTypes)
     ->
-        PredInfo = !.Info ^ pi_pred_info,
         pred_info_get_typevarset(PredInfo, TVarSet),
         pred_info_get_exist_quant_tvars(PredInfo, ExistQTVars),
         pred_info_get_head_type_params(PredInfo, HeadTypeParams),
         map.apply_to_list(Args, VarTypes, ArgTypes0),
         list.append(ArgTypes0, VarArgTypes, PredArgTypes),
         ModuleInfo = !.Info ^ pi_module_info,
-        pred_info_get_markers(PredInfo, CallerMarkers),
         (
             get_pred_id_by_types(calls_are_fully_qualified(CallerMarkers),
                 PName, PredOrFunc, TVarSet, ExistQTVars, PredArgTypes,
@@ -897,8 +897,14 @@ check_higher_order_purity(GoalInfo, ConsId, Var, Args, ActualPurity, !Info) :-
         ( DeclaredPurity = purity_semipure
         ; DeclaredPurity = purity_impure
         ),
-        Spec = impure_unification_expr_error(Context, DeclaredPurity),
-        purity_info_add_message(Spec, !Info)
+        % Don't warn about bogus purity annotations in compiler-generated
+        % mutable predicates.
+        ( check_marker(CallerMarkers, marker_mutable_access_pred) ->
+            true
+        ;
+            Spec = impure_unification_expr_error(Context, DeclaredPurity),
+            purity_info_add_message(Spec, !Info)
+        )
     ;
         DeclaredPurity = purity_pure
     ).
@@ -1034,12 +1040,16 @@ perform_goal_purity_checks(Context, PredId, DeclaredPurity, ActualPurity,
         % We don't warn about exaggerated impurity decls in class methods
         % or instance methods --- it just means that the predicate provided
         % as an implementation was more pure than necessary.
+        % Don't warn about exaggerated impurity decls in compiler-generated
+        % mutable predicates either.
 
         pred_info_get_markers(PredInfo, Markers),
         (
             check_marker(Markers, marker_class_method)
         ;
             check_marker(Markers, marker_class_instance_method)
+        ;
+            check_marker(Markers, marker_mutable_access_pred)
         )
     ->
         true

doc/reference_manual.texi

@@ -4795,7 +4795,7 @@ are equivalent to, the builtin insts @samp{free}, @samp{unique},
 
 The initial value of a mutable, @samp{initial_value}, may be any Mercury
 expression with type @samp{vartype} and inst @samp{varinst} subject to
-the above restrictions.
+the above restrictions. It may be impure or semipure.
 
 The following @samp{attributes} must be supported:
 

library/thread.mvar.m

@@ -33,7 +33,7 @@
 
     % Create an empty mvar.
     %
-:- func mvar.init = (mvar(T)::uo) is det.
+:- impure func mvar.init = (mvar(T)::uo) is det.
 
     % Create an empty mvar.
     %
@@ -84,14 +84,15 @@
                 mutvar(T)   % data
             ).
 
-mvar.init(mvar.init, !IO).
+mvar.init(Mvar, !IO) :-
+    promise_pure (
+        impure Mvar = mvar.init
+    ).
 
 mvar.init = mvar(Full, Empty, Ref) :-
-    promise_pure (
-        Full = semaphore.init(0),
-        Empty = semaphore.init(1),      % Initially a mvar starts empty.
-        impure new_mutvar0(Ref)
-    ).
+    impure Full = semaphore.init(0),
+    impure Empty = semaphore.init(1),   % Initially a mvar starts empty.
+    impure new_mutvar0(Ref).
 
 mvar.take(mvar(Full, Empty, Ref), Data, !IO) :-
     promise_pure (

tests/hard_coded/Mmakefile

@@ -184,6 +184,7 @@ ORDINARY_PROGS=	\
 	multi_map_test \
 	multimode \
 	multimode_addr \
+	mutable_init_impure \
 	mutable_init_order \
 	myset_test \
 	name_mangling \

tests/hard_coded/mutable_init_impure.exp

@@ -0,0 +1,2 @@
+Testing...
+Success.

tests/hard_coded/mutable_init_impure.m

@@ -0,0 +1,46 @@
+% Test initialisation of mutables by impure functions.
+
+:- module mutable_init_impure.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module thread.
+:- import_module thread.semaphore.
+
+:- mutable(sem1, semaphore, init_sem, ground, [untrailed, attach_to_io_state]).
+:- mutable(sem2, semaphore, init_sem, ground, [untrailed, constant]).
+
+:- impure func init_sem = semaphore.
+
+init_sem = Sem :-
+    impure Sem = semaphore.init(1).
+
+:- mutable(foo, string, init_foo, ground, [untrailed, constant]).
+
+:- semipure func init_foo = string.
+
+init_foo = X :-
+    promise_semipure X = "Testing...".
+
+main(!IO) :-
+    get_sem1(Sem1, !IO),
+    semaphore.wait(Sem1, !IO),
+
+    get_sem2(Sem2),
+    semaphore.wait(Sem2, !IO),
+
+    get_foo(Foo),
+    io.write_string(Foo, !IO),
+    io.nl(!IO),
+
+    io.write_string("Success.\n", !IO).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et