From c8d82022248ce80eb029f06c8d793430eaacf460 Mon Sep 17 00:00:00 2001 From: Peter Wang Date: Thu, 3 Nov 2011 01:01:36 +0000 Subject: [PATCH] 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 | 3 ++ compiler/make_hlds_passes.m | 48 +++++++++++++++--------- compiler/prog_mutable.m | 21 +++++++---- compiler/purity.m | 18 +++++++-- doc/reference_manual.texi | 2 +- library/thread.mvar.m | 15 ++++---- tests/hard_coded/Mmakefile | 1 + tests/hard_coded/mutable_init_impure.exp | 2 + tests/hard_coded/mutable_init_impure.m | 46 +++++++++++++++++++++++ 9 files changed, 120 insertions(+), 36 deletions(-) create mode 100644 tests/hard_coded/mutable_init_impure.exp create mode 100644 tests/hard_coded/mutable_init_impure.m diff --git a/NEWS b/NEWS index 4714e1f3e..637995d56 100644 --- a/NEWS +++ b/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. diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m index dce9932e9..f7247937b 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. + 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). diff --git a/compiler/prog_mutable.m b/compiler/prog_mutable.m index ec54f8e0b..5e2a2e213 100644 --- a/compiler/prog_mutable.m +++ b/compiler/prog_mutable.m @@ -58,7 +58,8 @@ % % initialise_mutable_ :- % impure pre_initialise_mutable_, -% impure set_(). +% impure X = , +% impure set_(X). % % :- impure pred pre_initialise_mutable_ is det. % :- pragma foreign_proc("C", @@ -209,7 +210,8 @@ % :- impure pred initialise_mutable_ is det. % % initialise_mutable_ :- -% impure secret_initialization_only_set_(). +% impure X = , +% impure secret_initialization_only_set_(X). % %-----------------------------------------------------------------------------% % @@ -230,7 +232,8 @@ % :- impure pred initialise_mutable_ is det. % % initialise_mutable_ :- -% impure set_(). +% impure X = , +% impure set_(X). % % is either `int' or `java.lang.Object' (all other types). % @@ -335,7 +338,8 @@ % :- impure pred initialise_mutable_ is det. % % initialise_mutable_ :- -% impure secret_initialization_only_set_(). +% impure X = , +% impure secret_initialization_only_set_(X). % %-----------------------------------------------------------------------------% % @@ -358,7 +362,8 @@ % % initialise_mutable_ :- % impure pre_initialise_mutable_, -% impure set_(). +% impure X = , +% impure set_(X). % % :- pragma foreign_proc("C#", % pre_initialise_mutable_, @@ -407,7 +412,8 @@ % :- impure pred initialise_mutable_ is det. % % initialise_mutable_ :- -% impure set_(). +% impure X = , +% impure set_(X). % % :- impure pred set_(::in()) is det. % :- pragma foreign_proc("Erlang", @@ -464,7 +470,8 @@ % :- impure pred initialise_mutable_ is det. % % initialise_mutable_ :- -% impure secret_initialization_only_set_(). +% impure X = , +% impure secret_initialization_only_set_(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 d65957f0e..7d35a2daa 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 edc27bd6a..d5b8b4d78 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 or semipure. The following @samp{attributes} must be supported: diff --git a/library/thread.mvar.m b/library/thread.mvar.m index 6da8c969c..18b695fc5 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,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 ( diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile index 05af31d8a..9a785a66c 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 000000000..6f60bcaf0 --- /dev/null +++ b/tests/hard_coded/mutable_init_impure.exp @@ -0,0 +1,2 @@ +Testing... +Success. diff --git a/tests/hard_coded/mutable_init_impure.m b/tests/hard_coded/mutable_init_impure.m new file mode 100644 index 000000000..d3221ee1f --- /dev/null +++ b/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