[m-rev.] Add `:- mutable' declaration to the language.

[Julien Fischer]

On Thu, 1 Sep 2005, Ralph Becket wrote:

> 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'.
>
My preferred option here would be that it mutables be untrailed
by default.

>
>
> 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/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:
> +%
s/yntax/syntax/

> +% :- 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:
> +%
Delete "eventually".

> +% :- 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).

Perhaps we should just support impure initialisation predicates.
(Is the io module import implicity or do we rely on the user for it.)

> +%
> +% 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.
> +
Shouldn't that be "if `untrailed' appears in the mutable declaration..."

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

You should mention that it is an error for a mutuable variable to
appear in the interface of a module.

> + 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}.
s/with type/of type/

More to come (I have to reboot earth)

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