[m-rev.] Add `:- mutable' declaration to the language.
Ralph Becket
rafe at cs.mu.OZ.AU
Thu Sep 1 13:54:13 AEST 2005
Estimated hours taken: 24
Branches: main
Add `:- mutable' directives to the language, providing modules with private
mutable variables. A directives
:- mutable(x, int, 0, ground, [thread_safe]).
leads to the compiler generating the following:
:- semipure pred get_x(int::out(ground)) is det.
:- impure pred set_x(int::in(ground)) is det.
:- pred initialise_mutable_x(io::di, io::uo) is det.
:- initialise initialise_mutable_x/2.
initialise_mutable_x(!IO) :-
promise_pure(
impure set_x(0)
).
:- pragma foreign_decl("C", "MR_Word mutable_variable_x;").
:- pragma foreign_proc("C", get_x(X::out(ground)), [thread_safe],
"MR_trail_current_value(&mutable_variable_x); X = x;").
:- pragma foreign_proc("C", set_x(X::in(ground)), [thread_safe],
"x = X;").
Possible attributes for a mutable variable are `thread_safe' and
`untrailed'.
NEWS:
Mention the new language feature.
compiler/make_hlds_passes.m:
Handle the new mutable/5 item.
Pass 1 expands a mutable directives into the pred
declaration items.
Pass 2 expands a mutable directives into the initialise
and foreign_decl declaration items.
Pass 3 expands a mutable directives into the initialise
declaration and the clauses for the preds.
compiler/mercury_to_mercury.m:
compiler/mercury_qual.m:
compiler/modules.m:
compiler/recompilation.check.m:
compiler/recompilation.version.m:
Cover the new mutable/5 item.
compiler/prog_data.m:
Add a new mutable/5 program item.
compiler/prog_io.m:
Parse `:- mutable' directives.
compiler/prog_io_typeclass.m:
compiler/prog_io_util.m:
Move list_term_to_term_list from prog_io_typeclass to prog_io_util
(it's a generally useful predicate).
doc/reference_manual.texi:
Document the new `:- mutable' directive.
tests/hard_coded/Mmakefile:
tests/hard_coded/mutable_decl.m:
tests/hard_coded/mutable_decl.exp:
Added a test case.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.382
diff -u -r1.382 NEWS
--- NEWS 29 Aug 2005 03:22:16 -0000 1.382
+++ NEWS 1 Sep 2005 03:49:50 -0000
@@ -8,6 +8,9 @@
* We have added support for optional module initialisation. See the
"Optional module initialisation" section of the Mercury Language Refence
Manual for details.
+* We have added support for impure module-local mutable variables.
+ See the "Module-local mutable variables" section of the Mercury Language
+ Refence Manual for details.
Changes to the Mercury standard library:
* We have added an `injection' module, for reversible maps that are injective.
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.4
diff -u -r1.4 make_hlds_passes.m
--- compiler/make_hlds_passes.m 29 Aug 2005 03:22:20 -0000 1.4
+++ compiler/make_hlds_passes.m 31 Aug 2005 07:24:29 -0000
@@ -432,6 +432,36 @@
add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !IO) :-
% We add initialise declarations on the second pass.
Item = initialise(_).
+add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !IO) :-
+ % We add the initialise decl and the foreign_decl on the second pass and
+ % the foreign_code clauses on the third pass.
+ Item = mutable(Name, Type, _InitValue, Inst, _Attrs),
+ module_info_name(!.ModuleInfo, ModuleName),
+ VarSet = varset__init,
+ InstVarSet = varset__init,
+ ExistQVars = [],
+ Constraints = constraints([], []),
+ IOType = term__functor(term__atom("."), [
+ term__functor(term__atom("io"), [], Context),
+ term__functor(term__atom("state"), [], Context)], Context),
+ GetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+ mutable_get_pred_sym_name(ModuleName, Name),
+ [type_and_mode(Type, out_mode(Inst))],
+ no /* with_type */, no /* with_inst */, yes(det),
+ true /* condition */, (semipure), Constraints),
+ add_item_decl_pass_1(GetPredDecl, Context, !Status, !ModuleInfo, _, !IO),
+ SetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+ mutable_set_pred_sym_name(ModuleName, Name),
+ [type_and_mode(Type, in_mode(Inst))],
+ no /* with_type */, no /* with_inst */, yes(det),
+ true /* condition */, (impure), Constraints),
+ add_item_decl_pass_1(SetPredDecl, Context, !Status, !ModuleInfo, _, !IO),
+ InitPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+ mutable_init_pred_sym_name(ModuleName, Name),
+ [type_and_mode(IOType, di_mode), type_and_mode(IOType, uo_mode)],
+ no /* with_type */, no /* with_inst */, yes(det),
+ true /* condition */, (pure), Constraints),
+ add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _, !IO).
%-----------------------------------------------------------------------------%
@@ -518,6 +548,36 @@
PragmaExportItem =
pragma(export(SymName, predicate, [di_mode, uo_mode], CName)),
add_item_decl_pass_2(PragmaExportItem, Context, !Status, !ModuleInfo, !IO).
+add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
+ Item = mutable(Name, _Type, _InitTerm, _Inst, _MutAttrs),
+ module_info_name(!.ModuleInfo, ModuleName),
+ InitDecl = initialise(mutable_init_pred_sym_name(ModuleName, Name)),
+ add_item_decl_pass_2(InitDecl, Context, !Status, !ModuleInfo, !IO),
+ ForeignDecl = pragma(foreign_decl(c, foreign_decl_is_local,
+ "MR_Word " ++ mutable_c_var_name(Name) ++ ";")),
+ add_item_decl_pass_2(ForeignDecl, Context, !Status, !ModuleInfo, !IO).
+
+
+ % XXX We should probably mangle Name for safety...
+ %
+:- func mutable_get_pred_sym_name(sym_name, string) = sym_name.
+
+mutable_get_pred_sym_name(ModuleName, Name) =
+ qualified(ModuleName, "get_" ++ Name).
+
+:- func mutable_set_pred_sym_name(sym_name, string) = sym_name.
+
+mutable_set_pred_sym_name(ModuleName, Name) =
+ qualified(ModuleName, "set_" ++ Name).
+
+:- func mutable_init_pred_sym_name(sym_name, string) = sym_name.
+
+mutable_init_pred_sym_name(ModuleName, Name) =
+ qualified(ModuleName, "initialise_mutable_" ++ Name).
+
+:- func mutable_c_var_name(string) = string.
+
+mutable_c_var_name(Name) = "mutable_variable_" ++ Name.
%-----------------------------------------------------------------------------%
@@ -737,6 +797,50 @@
"not have a corresponding pred declaration.")], !IO),
module_info_incr_errors(!ModuleInfo)
).
+add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO) :-
+ Item = mutable(Name, _Type, InitTerm, Inst, MutAttrs),
+ module_info_name(!.ModuleInfo, ModuleName),
+ varset__new_named_var(varset__init, "X", X, VarSet),
+ DefaultAttrs = default_attributes(c),
+ (
+ list__member(thread_safe, MutAttrs)
+ ->
+ set_thread_safe(thread_safe, DefaultAttrs, Attrs)
+ ;
+ Attrs = DefaultAttrs
+ ),
+ add_item_clause(initialise(mutable_init_pred_sym_name(ModuleName, Name)),
+ !Status, Context, !ModuleInfo, !QualInfo, !IO),
+ InitClause = clause(VarSet, predicate,
+ mutable_init_pred_sym_name(ModuleName, Name),
+ [term__variable(X), term__variable(X)],
+ promise_purity(dont_make_implicit_promises, (pure),
+ call(mutable_set_pred_sym_name(ModuleName, Name),
+ [InitTerm], (impure)) - Context
+ ) - Context),
+ add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo, !IO),
+ set_purity((semipure), Attrs, GetAttrs),
+ GetClause = pragma(foreign_proc(GetAttrs,
+ mutable_get_pred_sym_name(ModuleName, Name), predicate,
+ [pragma_var(X, "X", out_mode(Inst))], VarSet,
+ ordinary("X = " ++ mutable_c_var_name(Name) ++ ";",
+ yes(Context)))),
+ add_item_clause(GetClause, !Status, Context, !ModuleInfo, !QualInfo, !IO),
+ (
+ list__member(untrailed, MutAttrs)
+ ->
+ TrailCode = ""
+ ;
+ TrailCode =
+ "MR_trail_current_value(&" ++ mutable_c_var_name(Name) ++ ");\n"
+ ),
+ SetClause = pragma(foreign_proc(Attrs,
+ mutable_set_pred_sym_name(ModuleName, Name), predicate,
+ [pragma_var(X, "X", in_mode(Inst))], VarSet,
+ ordinary(TrailCode ++ mutable_c_var_name(Name) ++ " = X;",
+ yes(Context)))),
+ add_item_clause(SetClause, !Status, Context, !ModuleInfo, !QualInfo, !IO).
+
% If a module_defn updates the import_status, return the new status
% and whether uses of the following items must be module qualified,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.263
diff -u -r1.263 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 29 Aug 2005 03:22:22 -0000 1.263
+++ compiler/mercury_to_mercury.m 30 Aug 2005 04:33:33 -0000
@@ -762,7 +762,20 @@
io__write_string(".\n", !IO).
mercury_output_item(_, initialise(PredSymName), _, !IO) :-
io__write_string(":- initialise ", !IO),
- mercury_output_sym_name(PredSymName, !IO).
+ mercury_output_sym_name(PredSymName, !IO),
+ io__write_string(".\n", !IO).
+mercury_output_item(_, mutable(Name, Type, InitTerm, Inst, Attrs), _, !IO) :-
+ io__write_string(":- mutable(", !IO),
+ io__write_string(Name, !IO),
+ io__write_string(", ", !IO),
+ mercury_output_term(Type, varset__init, no, !IO),
+ io__write_string(", ", !IO),
+ mercury_output_term(InitTerm, varset__init, no, !IO),
+ io__write_string(", ", !IO),
+ mercury_output_inst(Inst, varset__init, !IO),
+ io__write_string(", ", !IO),
+ io__print(Attrs, !IO),
+ io__write_string(").\n", !IO).
:- func mercury_to_string_promise_type(promise_type) = string.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.109
diff -u -r1.109 module_qual.m
--- compiler/module_qual.m 29 Aug 2005 03:22:23 -0000 1.109
+++ compiler/module_qual.m 30 Aug 2005 05:23:46 -0000
@@ -335,6 +335,7 @@
).
collect_mq_info_2(instance(_, _, _, _, _, _), !Info).
collect_mq_info_2(initialise(_), !Info).
+collect_mq_info_2(mutable(_, _, _, _, _), !Info).
:- pred collect_mq_info_qualified_symname(sym_name::in,
mq_info::in, mq_info::out) is det.
@@ -721,6 +722,13 @@
initialise(PredSymName) - Context,
initialise(PredSymName) - Context,
!Info, yes, !IO).
+
+module_qualify_item(
+ mutable(Name, Type0, InitTerm, Inst0, Attrs) - Context,
+ mutable(Name, Type, InitTerm, Inst, Attrs) - Context,
+ !Info, yes, !IO) :-
+ qualify_type(Type0, Type, !Info, !IO),
+ qualify_inst(Inst0, Inst, !Info, !IO).
:- pred update_import_status(module_defn::in, mq_info::in, mq_info::out,
bool::out) is det.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.336
diff -u -r1.336 modules.m
--- compiler/modules.m 29 Aug 2005 03:22:23 -0000 1.336
+++ compiler/modules.m 30 Aug 2005 05:47:55 -0000
@@ -7283,6 +7283,7 @@
item_needs_imports(instance(_, _, _, _, _, _)) = yes.
item_needs_imports(promise(_, _, _, _)) = yes.
item_needs_imports(initialise(_)) = yes.
+item_needs_imports(mutable(_, _, _, _, _)) = yes.
item_needs_imports(nothing(_)) = no.
:- pred item_needs_foreign_imports(item::in, foreign_language::out) is nondet.
@@ -7628,6 +7629,7 @@
reorderable_item(pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _)) = no.
reorderable_item(pred_or_func_mode(_, _, _, _, _, _, _)) = no.
reorderable_item(initialise(_)) = no.
+reorderable_item(mutable(_, _, _, _, _)) = no.
:- pred is_chunkable(item_and_context::in) is semidet.
@@ -7713,6 +7715,7 @@
chunkable_item(instance(_, _, _, _, _, _)) = yes.
chunkable_item(clause(_, _, _, _, _)) = yes.
chunkable_item(initialise(_)) = yes.
+chunkable_item(mutable(_, _, _, _, _)) = no.
chunkable_item(nothing(_)) = yes.
% Given a list of items for which symname_ordered succeeds, we need to keep
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.133
diff -u -r1.133 prog_data.m
--- compiler/prog_data.m 29 Aug 2005 03:22:25 -0000 1.133
+++ compiler/prog_data.m 30 Aug 2005 07:26:56 -0000
@@ -166,11 +166,27 @@
% :- initialise(pred_name).
; initialise(sym_name)
+ % :- mutable(var_name, type, inst, value, attrs).
+ ; mutable(
+ mut_name :: string,
+ mut_type :: (type),
+ mut_init_value :: prog_term,
+ mut_inst :: (inst),
+ mut_attrs :: list(mutable_attr)
+ )
+
; nothing(
nothing_maybe_warning :: maybe(item_warning)
).
% used for items that should be ignored (for the
% purposes of backwards compatibility etc)
+
+ % Attributes that a mutable can have (part of the `:- mutable'
+ % declaration).
+ %
+:- type mutable_attr
+ ---> untrailed % Updates are not trailed.
+ ; thread_safe. % Access is considered thread safe.
% Indicates the type of information the compiler should get from the
% declaration's clause.
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.244
diff -u -r1.244 prog_io.m
--- compiler/prog_io.m 29 Aug 2005 03:22:25 -0000 1.244
+++ compiler/prog_io.m 31 Aug 2005 06:06:10 -0000
@@ -1422,10 +1422,14 @@
)
).
-process_decl(ModuleName, VarSet, "initialise", Args, Attributes, Result):-
+process_decl(ModuleName, VarSet, "initialise", Args, Attributes, Result) :-
parse_initialise_decl(ModuleName, VarSet, Args, Result0),
check_no_attributes(Result0, Attributes, Result).
+process_decl(ModuleName, VarSet, "mutable", Args, Attributes, Result) :-
+ parse_mutable_decl(ModuleName, VarSet, Args, Result0),
+ check_no_attributes(Result0, Attributes, Result).
+
:- pred parse_decl_attribute(string::in, list(term)::in, decl_attribute::out,
term::out) is semidet.
@@ -1796,6 +1800,162 @@
"an arity 2 predicate", Term)
)
)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+% Mutable declaration yntax:
+%
+% :- mutable(name, type, value, inst, [untrailed, promise_thread_safe]).
+% (The list of attributes at the end is optional.)
+%
+% E.g.:
+% :- mutable(counter, int, 0, ground, [promise_thread_safe]).
+%
+% This is eventually converted into the following:
+%
+% :- semipure pred get_counter(int::out(ground)) is det.
+% :- pragma foreign_proc("C",
+% get_counter(X::out(ground)),
+% [promise_semipure, will_not_call_mercury, thread_safe],
+% "X = mutable_counter;").
+%
+% :- impure pred set_counter(int::in(ground)) is det.
+% :- pragma foreign_proc("C",
+% set_counter(X::in(ground)),
+% [will_not_call_mercury, thread_safe],
+% "MR_trail_current_value(&mutable_counter);
+% mutable_counter = X;").
+%
+% :- pragma foreign_decl("C", "MR_Word mutable_counter;").
+%
+% :- import_module io.
+% :- initialise initialise_counter.
+% :- impure pred initialise_mutable_counter(io::di, io::uo) is det.
+% initialise_mutable_counter(!IO) :-
+% impure set_counter(0).
+%
+% The `thread_safe' attributes are omitted if it is not listed in
+% the mutable declaration attributes. Similarly, MR_trail_current_value()
+% does not appear if `promise_thread_safe' appears in the mutable
+% declaration attributes.
+
+:- pred parse_mutable_decl(module_name::in, varset::in, list(term)::in,
+ maybe1(item)::out) is semidet.
+
+parse_mutable_decl(_ModuleName, _VarSet, Terms, Result) :-
+ Terms = [NameTerm, TypeTerm, ValueTerm, InstTerm | OptMutAttrsTerm],
+ parse_mutable_name(NameTerm, NameResult),
+ parse_mutable_type(TypeTerm, TypeResult),
+ term__coerce(ValueTerm, Value),
+ parse_mutable_inst(InstTerm, InstResult),
+ (
+ OptMutAttrsTerm = [],
+ MutAttrsResult = ok([])
+ ;
+ OptMutAttrsTerm = [MutAttrsTerm],
+ parse_mutable_attrs(MutAttrsTerm, MutAttrsResult)
+ ),
+ (
+ NameResult = ok(Name),
+ TypeResult = ok(Type),
+ InstResult = ok(Inst),
+ MutAttrsResult = ok(MutAttrs)
+ ->
+ Result = ok(mutable(Name, Type, Value, Inst, MutAttrs))
+ ;
+ NameResult = error(Msg, Term)
+ ->
+ Result = error(Msg, Term)
+ ;
+ TypeResult = error(Msg, Term)
+ ->
+ Result = error(Msg, Term)
+ ;
+ InstResult = error(Msg, Term)
+ ->
+ Result = error(Msg, Term)
+ ;
+ MutAttrsResult = error(Msg, Term)
+ ->
+ Result = error(Msg, Term)
+ ;
+ error("prog_io.parse_mutable_decl: shouldn't be here!")
+ ).
+
+
+:- pred parse_mutable_name(term::in, maybe1(string)::out) is det.
+
+parse_mutable_name(NameTerm, NameResult) :-
+ (
+ NameTerm = term__functor(atom(Name), [], _)
+ ->
+ NameResult = ok(Name)
+ ;
+ NameResult = error("invalid mutable name", NameTerm)
+ ).
+
+
+:- pred parse_mutable_type(term::in, maybe1(type)::out) is det.
+
+parse_mutable_type(TypeTerm, TypeResult) :-
+ (
+ term__contains_var(TypeTerm, _)
+ ->
+ TypeResult = error("the type in a mutable declaration " ++
+ "cannot contain variables", TypeTerm)
+ ;
+ parse_type(TypeTerm, TypeResult)
+ ).
+
+
+:- pred parse_mutable_inst(term::in, maybe1(inst)::out) is det.
+
+parse_mutable_inst(InstTerm, InstResult) :-
+ (
+ term__contains_var(InstTerm, _)
+ ->
+ InstResult = error("the inst in a mutable declaration " ++
+ "cannot contain variables", InstTerm)
+ ;
+ convert_inst(no_allow_constrained_inst_var, InstTerm, Inst)
+ ->
+ InstResult = ok(Inst)
+ ;
+ InstResult = error("invalid inst in mutable declaration",
+ InstTerm)
+ ).
+
+
+:- pred parse_mutable_attrs(term::in, maybe1(list(mutable_attr))::out) is det.
+
+parse_mutable_attrs(MutAttrsTerm, MutAttrsResult) :-
+ (
+ list_term_to_term_list(MutAttrsTerm, MutAttrTerms)
+ ->
+ map_parser(parse_mutable_attr, MutAttrTerms, MutAttrsResult)
+ ;
+ MutAttrsResult = error("malformed attribute list in " ++
+ "mutable declaration", MutAttrsTerm)
+ ).
+
+:- pred parse_mutable_attr(term::in, maybe1(mutable_attr)::out) is det.
+
+parse_mutable_attr(MutAttrTerm, MutAttrResult) :-
+ (
+ MutAttrTerm = term__functor(term__atom(String), [], _),
+ (
+ String = "untrailed",
+ MutAttr = untrailed
+ ;
+ String = "thread_safe",
+ MutAttr = thread_safe
+ )
+ ->
+ MutAttrResult = ok(MutAttr)
+ ;
+ MutAttrResult = error("unrecognised attribute in mutable " ++
+ "declaration", MutAttrTerm)
).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.39
diff -u -r1.39 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 3 Aug 2005 11:26:54 -0000 1.39
+++ compiler/prog_io_typeclass.m 31 Aug 2005 06:01:52 -0000
@@ -270,18 +270,6 @@
Result = error("expected list of class methods", Methods)
).
-:- pred list_term_to_term_list(term::in, list(term)::out) is semidet.
-
-list_term_to_term_list(Methods, MethodList) :-
- (
- Methods = term__functor(term__atom("[|]"), [Head, Tail0], _),
- list_term_to_term_list(Tail0, Tail),
- MethodList = [Head|Tail]
- ;
- Methods = term__functor(term__atom("[]"), [], _),
- MethodList = []
- ).
-
:- pred item_to_class_method(maybe2(item, prog_context)::in, term::in,
maybe1(class_method)::out) is det.
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.36
diff -u -r1.36 prog_io_util.m
--- compiler/prog_io_util.m 14 Apr 2005 06:51:01 -0000 1.36
+++ compiler/prog_io_util.m 31 Aug 2005 06:02:09 -0000
@@ -153,6 +153,8 @@
:- pred map_parser(parser(T)::parser, list(term)::in, maybe1(list(T))::out)
is det.
+:- pred list_term_to_term_list(term::in, list(term)::out) is semidet.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -614,6 +616,18 @@
;
H = variable(V),
!:Os = [V | !.Os]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+list_term_to_term_list(Methods, MethodList) :-
+ (
+ Methods = term__functor(term__atom("[|]"), [Head, Tail0], _),
+ list_term_to_term_list(Tail0, Tail),
+ MethodList = [Head|Tail]
+ ;
+ Methods = term__functor(term__atom("[]"), [], _),
+ MethodList = []
).
%-----------------------------------------------------------------------------%
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.14
diff -u -r1.14 recompilation.check.m
--- compiler/recompilation.check.m 29 Aug 2005 03:22:26 -0000 1.14
+++ compiler/recompilation.check.m 30 Aug 2005 06:30:28 -0000
@@ -957,6 +957,7 @@
check_for_ambiguities(_, _, _, module_defn(_, _) - _, !Info).
check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _, !Info).
check_for_ambiguities(_, _, _, initialise(_) - _, !Info).
+check_for_ambiguities(_, _, _, mutable(_, _, _, _, _) - _, !Info).
check_for_ambiguities(_, _, _, nothing(_) - _, !Info).
:- pred item_is_new_or_changed(timestamp::in, item_version_numbers::in,
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.21
diff -u -r1.21 recompilation.version.m
--- compiler/recompilation.version.m 29 Aug 2005 03:22:26 -0000 1.21
+++ compiler/recompilation.version.m 30 Aug 2005 06:32:13 -0000
@@ -577,6 +577,7 @@
% the class, not the module containing the instance).
item_to_item_id_2(instance(_, _, _, _, _, _), no).
item_to_item_id_2(initialise(_), no).
+item_to_item_id_2(mutable(_, _, _, _, _), no).
item_to_item_id_2(nothing(_), no).
:- type maybe_pred_or_func_id == pair(maybe(pred_or_func), sym_name_and_arity).
@@ -736,6 +737,8 @@
item_is_unchanged(nothing(A), Item2) = ( Item2 = nothing(A) -> yes ; no ).
item_is_unchanged(initialise(A), Item2) =
( Item2 = initialise(A) -> yes ; no ).
+item_is_unchanged(mutable(A, B, C, D, E), Item2) =
+ ( Item2 = mutable(A, B, C, D, E) -> yes ; no ).
item_is_unchanged(Item1, Item2) = Result :-
Item1 = pred_or_func(TVarSet1, _, ExistQVars1, PredOrFunc,
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.322
diff -u -r1.322 reference_manual.texi
--- doc/reference_manual.texi 29 Aug 2005 03:22:28 -0000 1.322
+++ doc/reference_manual.texi 1 Sep 2005 03:48:07 -0000
@@ -558,6 +558,7 @@
:- pragma
:- promise
:- initialise
+:- mutable
:- module
:- interface
:- implementation
@@ -4237,6 +4238,7 @@
* An example module::
* Sub-modules::
* Optional module initialisation::
+* Module-local mutable variables::
@end menu
@node The module system
@@ -4582,6 +4584,44 @@
order in which they are specified, although no order may be assumed between
different modules or submodules.
+ at node Module-local mutable variables
+ at section Module-local mutable variables
+
+Certain special cases require a module to have one or more mutable (i.e.
+destructively updatable) variables, for example to hold the constraint
+store for a solver type.
+
+A mutable variable can be declared in the implementation section of
+a module using the @samp{mutable} directive:
+
+ at example
+:- mutable(varname, vartype, initial_value, varinst, [attribute, ...]).
+ at end example
+
+This has the effect of constructing a new mutable variable with access
+predicates with the following signatures:
+
+ at example
+:- semipure get_varname(vartype::out(varinst)) is det.
+:- impure set_varname(vartype::in(varinst)) is det.
+ at end example
+
+The initial value of @samp{varname} is @samp{initial_value}, which is set
+before the program's @samp{main/2} predicate is executed. The type
+ at samp{vartype} is not allowed to contain any type variables and the inst
+ at samp{varinst} is not allowed to contain any inst variables or have any type
+class constraints; @samp{initial_value} can be any Mercury expression with
+type @samp{vartype} and inst @samp{varinst}.
+
+The possible @samp{attributes} are @samp{thread_safe}, meaning that
+access to the mutable need not be protected in parallel grades, and
+ at samp{untrailed}, meaning that the effects of calls to
+ at samp{set_varname/1} should not be undone on backtracking.
+
+C code in the same module can access the mutable variable using the name
+ at samp{mutable_variable_varname}, which is a global variable with type
+ at samp{MR_Word}.
+
@node Type classes
@chapter Type classes
@@ -5690,7 +5730,7 @@
@dfn{strict sequential} operational semantics. In this semantics,
the program is executed top-down, starting from @samp{main/2}
preceded by any module initialisation goals
-(as per @xref{Optional module initialisation}),
+(as per @ref{Optional module initialisation}),
and function calls within a goal, conjunctions and disjunctions are all
executed in depth-first left-to-right order.
Conjunctions and function calls are ``minimally'' reordered as required
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.262
diff -u -r1.262 Mmakefile
--- tests/hard_coded/Mmakefile 29 Aug 2005 03:22:30 -0000 1.262
+++ tests/hard_coded/Mmakefile 31 Aug 2005 07:30:10 -0000
@@ -116,6 +116,7 @@
mode_choice \
multi_map_test \
multimode \
+ mutable_decl \
myset_test \
name_mangling \
no_fully_strict \
Index: tests/hard_coded/mutable_decl.exp
===================================================================
RCS file: tests/hard_coded/mutable_decl.exp
diff -N tests/hard_coded/mutable_decl.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/mutable_decl.exp 31 Aug 2005 07:39:18 -0000
@@ -0,0 +1,3 @@
+0, 1, 2
+0
+5
Index: tests/hard_coded/mutable_decl.m
===================================================================
RCS file: tests/hard_coded/mutable_decl.m
diff -N tests/hard_coded/mutable_decl.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/mutable_decl.m 31 Aug 2005 07:38:55 -0000
@@ -0,0 +1,60 @@
+%-----------------------------------------------------------------------------%
+% mutable_decl.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Wed Aug 31 15:19:58 EST 2005
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% Test the `:- mutable(...)' declaration.
+%
+%-----------------------------------------------------------------------------%
+
+:- module mutable_decl.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- impure pred main(io :: di, io :: uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int, list, std_util, string.
+
+%-----------------------------------------------------------------------------%
+
+:- mutable(x, int, 0, ground, [thread_safe]).
+
+:- mutable(y, int, 0, ground, [untrailed, thread_safe]).
+
+main(!IO) :-
+ semipure get_x(X0), impure set_x(X0 + 1),
+ semipure get_x(X1), impure set_x(X1 + 1),
+ semipure get_x(X2), impure set_x(X2 + 1),
+ io.write_list([X0, X1, X2], ", ", io.write_int, !IO),
+ io.nl(!IO),
+ impure set_x(0),
+ ( if impure my_member(1, [2, 3, 4, 5, 6])
+ then io.print("what the?!\n", !IO)
+ else true
+ ),
+ semipure get_x(X), io.write_int(X, !IO), io.nl(!IO),
+ semipure get_y(Y), io.write_int(Y, !IO), io.nl(!IO).
+
+:- impure pred my_member(int::in, list(int)::in) is nondet.
+
+my_member(A, [B | Bs]) :-
+ semipure get_x(X), impure set_x(X + 1),
+ semipure get_y(Y), impure set_y(Y + 1),
+ (
+ A = B
+ ;
+ impure my_member(A, Bs)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list