[m-rev.] for review: allow mutable init by impure functions
Peter Wang
novalazy at gmail.com
Wed Oct 26 17:44:18 AEDT 2011
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.
diff --git a/NEWS b/NEWS
index 4714e1f..c68031e 100644
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,8 @@ Changes to the Mercury language:
(or XXXXXXXX) is a Unicode character code in hexadecimal, is replaced with
the corresponding Unicode character.
+* Mutables may now be initialised by impure functions.
+
Changes to the Mercury standard library:
* We have improved Unicode support in the standard library.
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index dce9932..f724793 100644
--- a/compiler/make_hlds_passes.m
+++ b/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.
- CallSetPredExpr =
- call_expr(InitSetPredName, [InitTerm], purity_impure)
+ varset.new_named_var("X", X, MutVarset0, MutVarset),
+ UnifyExpr =
+ unify_expr(variable(X, Context), InitTerm, purity_impure)
- Context,
- InitClauseExpr =
- conj_expr(CallPreInitExpr, CallSetPredExpr)
+ 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).
diff --git a/compiler/prog_mutable.m b/compiler/prog_mutable.m
index ec54f8e..5e2a2e2 100644
--- a/compiler/prog_mutable.m
+++ b/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
diff --git a/compiler/purity.m b/compiler/purity.m
index d65957f..7d35a2d 100644
--- a/compiler/purity.m
+++ b/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
diff --git a/doc/reference_manual.texi b/doc/reference_manual.texi
index 04938ab..c917eba 100644
--- a/doc/reference_manual.texi
+++ b/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.
The following @samp{attributes} must be supported:
diff --git a/library/thread.mvar.m b/library/thread.mvar.m
index 6da8c96..18b695f 100644
--- a/library/thread.mvar.m
+++ b/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,15 +84,16 @@
mutvar(T) % data
).
-mvar.init(mvar.init, !IO).
-
-mvar.init = mvar(Full, Empty, Ref) :-
+mvar.init(Mvar, !IO) :-
promise_pure (
- Full = semaphore.init(0),
- Empty = semaphore.init(1), % Initially a mvar starts empty.
- impure new_mutvar0(Ref)
+ impure Mvar = mvar.init
).
+mvar.init = mvar(Full, Empty, 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 (
semaphore.wait(Full, !IO),
diff --git a/library/thread.semaphore.m b/library/thread.semaphore.m
index 6f18517..19c2004 100644
--- a/library/thread.semaphore.m
+++ b/library/thread.semaphore.m
@@ -40,12 +40,12 @@
% Returns a new semaphore `Sem' with its counter initialized to Count.
%
-:- func semaphore.init(int::in) = (semaphore::uo) is det.
+:- impure func semaphore.init(int::in) = (semaphore::uo) is det.
% A synonym for the above.
%
:- pragma obsolete(semaphore.new/1).
-:- func semaphore.new(int::in) = (semaphore::uo) is det.
+:- impure func semaphore.new(int::in) = (semaphore::uo) is det.
% wait(Sem, !IO) blocks until the counter associated with `Sem'
% becomes greater than 0, whereupon it wakes, decrements the
@@ -118,14 +118,17 @@ ML_finalize_semaphore(void *obj, void *cd);
new(Semaphore, !IO) :-
init(Semaphore, !IO).
-new(Count) = init(Count).
+new(Count) = Semaphore :-
+ impure Semaphore = init(Count).
init(Semaphore, !IO) :-
- Semaphore = init(0).
+ promise_pure (
+ impure Semaphore = init(0)
+ ).
:- pragma foreign_proc("C",
init(Count::in) = (Semaphore::uo),
- [promise_pure, will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, thread_safe],
"
ML_Semaphore *sem;
@@ -155,7 +158,7 @@ init(Semaphore, !IO) :-
:- pragma foreign_proc("C#",
init(Count::in) = (Semaphore::uo),
- [promise_pure, will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, thread_safe],
"
Semaphore = new thread__semaphore.ML_Semaphore();
Semaphore.count = Count;
@@ -163,7 +166,7 @@ init(Semaphore, !IO) :-
:- pragma foreign_proc("Java",
init(Count::in) = (Semaphore::uo),
- [promise_pure, will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, thread_safe],
"
Semaphore = new java.util.concurrent.Semaphore(Count);
").
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 05af31d..9a785a6 100644
--- a/tests/hard_coded/Mmakefile
+++ b/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 \
diff --git a/tests/hard_coded/mutable_init_impure.exp b/tests/hard_coded/mutable_init_impure.exp
new file mode 100644
index 0000000..a9d787c
--- /dev/null
+++ b/tests/hard_coded/mutable_init_impure.exp
@@ -0,0 +1 @@
+Success.
diff --git a/tests/hard_coded/mutable_init_impure.m b/tests/hard_coded/mutable_init_impure.m
new file mode 100644
index 0000000..8ed82b8
--- /dev/null
+++ b/tests/hard_coded/mutable_init_impure.m
@@ -0,0 +1,35 @@
+% 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).
+
+main(!IO) :-
+ get_sem1(Sem1, !IO),
+ semaphore.wait(Sem1, !IO),
+
+ get_sem2(Sem2),
+ semaphore.wait(Sem2, !IO),
+
+ io.write_string("Success.\n", !IO).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 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
--------------------------------------------------------------------------
More information about the reviews
mailing list