[m-rev.] for review: mutables and intermodule-optimization (again)
Julien Fischer
juliensf at cs.mu.OZ.AU
Wed Sep 21 03:27:11 AEST 2005
For review by anyone.
This is an expanded version of the diff I posted the other day - it
also resolves the problems with name mangling and mutables.
Estimated hours taken: 6
Branches: main
Make the declarations for the globals variables used to implement mutables
visible across module boundaries. Not doing so means that we cannot inline
the access predicates across module boundaries (this is currently causing
the tests for mutables and sub-modules to fail on that compile with
--intermodule-optimization).
Doing so requires us to module qualify the globals in the generated code, this
diff also fixes an earlier XXX about not mangling the names of mutables.
Add another mutable attribute, foreign_name, that allows the user to override
the compiler's choice of name for the global variable. This is useful where
foreign code needs also needs to access the mutable, e.g. in library
bindings. Currently, we only support this facility in the C backends.
(Actually, it's almost implemented for the other backends as well, but
there's no way to test it at the moment).
Support `trailed' and `not_thread_safe' as mutable attributes. These are
the defaults so in practice the will probably rarely be used.
compiler/make_hlds_passes.m:
If there is a foreign_name attribute for a mutable, the use that name
rather than a compiler generated one.
Make sure that there is a declaration for the global variable in the
module's .mh file.
Emit an error message if an attempt is made to use a trailed mutable
in a non-trailing grade.
compiler/prog_mutable.m:
Append the module name to the name of the global variable used to
implement the mutable.
compiler/prog_data.m:
Make the set of mutable attributes into an abstract type. Handle this
in a similar fashion to foreign code attributes.
Add access predicates for the above type.
Fix the positioning of comments and section headings in this module.
Unrelated change: add a comment explaining why we the intermediate
form of the constraints in the termination2_info pragmas is necessary.
compiler/prog_io.m:
Parse the new mutable attributes.
Update the description of the source-to-source transformation used to
implement mutable variables.
compiler/prog_io_pragma.m:
Export the predicate parse_foreign_language/2. It is now needed
by the code that parses mutable declarations.
compiler/globals.m:
Add a function that returns the compilation target as a string.
doc/reference_manual.m:
Document the new attributes.
tests/invalid/Mmakefile:
tests/invalid/Mercury.options:
tests/invalid/trailed_mutable.m:
tests/invalid/trailed_mutable.err_exp:
Test the error message that results if a trailed mutable is used in a
non-trailing grade.
tests/hard_coded/bad_mutable.{m,err_exp}:
Extend this test case to cover the new attributes.
tests/hard_coded/Mmakefile:
tests/hard_coded/foreign_name_mutable.{m,exp}:
tests/hard_coded/unusual_name_mutable.{m,exp}:
Further test for mutable variables.
Julien.
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.69
diff -u -r1.69 globals.m
--- compiler/globals.m 14 Sep 2005 05:26:37 -0000 1.69
+++ compiler/globals.m 20 Sep 2005 07:15:47 -0000
@@ -53,6 +53,11 @@
; java
; il.
+ % A string representation of the compilation target suitable
+ % for use in human-readable error messages.
+ %
+:- func compilation_target_string(compilation_target) = string.
+
% A string representation of the foreign language suitable
% for use in human-readable error messages.
%
@@ -325,6 +330,11 @@
convert_maybe_thread_safe("yes", yes).
convert_maybe_thread_safe("no", no).
+compilation_target_string(c) = "C".
+compilation_target_string(il) = "IL".
+compilation_target_string(java) = "Java".
+compilation_target_string(asm) = "asm".
+
foreign_language_string(c) = "C".
foreign_language_string(managed_cplusplus) = "Managed C++".
foreign_language_string(csharp) = "C#".
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.10
diff -u -r1.10 make_hlds_passes.m
--- compiler/make_hlds_passes.m 15 Sep 2005 07:38:43 -0000 1.10
+++ compiler/make_hlds_passes.m 20 Sep 2005 16:37:10 -0000
@@ -568,7 +568,7 @@
true
).
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
- Item = mutable(Name, _Type, _InitTerm, _Inst, _MutAttrs),
+ Item = mutable(Name, _Type, _InitTerm, _Inst, Attrs),
!.Status = item_status(ImportStatus, _),
( ImportStatus = exported ->
error_is_exported(Context, "`mutable' declaration", !IO),
@@ -582,17 +582,104 @@
% duplicating the definition of the global variable in any submodules.
%
( status_defined_in_this_module(ImportStatus, yes) ->
+ mutable_var_maybe_foreign_names(Attrs) = MaybeForeignNames,
+ (
+ MaybeForeignNames = no,
+ TargetMutableName = mutable_c_var_name(ModuleName, Name)
+ ;
+ MaybeForeignNames = yes(ForeignNames),
+ %
+ % Report any errors with the foreign_name attributes during
+ % this pass.
+ %
+ ReportErrors = yes,
+ get_global_name_from_foreign_names(ReportErrors, Context,
+ ModuleName, Name, ForeignNames, TargetMutableName, !IO)
+ ),
%
% XXX We don't currently support languages other than C.
%
+ module_info_name(!.ModuleInfo, ModuleName),
ForeignDecl = pragma(compiler(mutable_decl),
- foreign_decl(c, foreign_decl_is_local,
- "MR_Word " ++ mutable_c_var_name(Name) ++ ";")),
- add_item_decl_pass_2(ForeignDecl, Context, !Status, !ModuleInfo, !IO)
+ foreign_decl(c, foreign_decl_is_exported,
+ "extern MR_Word " ++
+ TargetMutableName ++ ";")),
+ add_item_decl_pass_2(ForeignDecl, Context, !Status, !ModuleInfo, !IO),
+ ForeignCode = pragma(compiler(mutable_decl),
+ foreign_code(c, "MR_Word " ++
+ TargetMutableName ++ ";")),
+ add_item_decl_pass_2(ForeignCode, Context, !Status, !ModuleInfo, !IO)
;
true
).
+ % Check to see if there is a valid foreign_name attribute for this
+ % backend. If so, use it as the name of the global variable in
+ % the target code, otherwise take the Mercury name for the mutable
+ % and mangle it into an appropriate variable name.
+ %
+ :- pred get_global_name_from_foreign_names(bool::in, prog_context::in,
+ module_name::in, string::in, list(foreign_name)::in, string::out,
+ io::di, io::uo) is det.
+
+get_global_name_from_foreign_names(ReportErrors, Context, ModuleName,
+ MercuryMutableName, ForeignNames, TargetMutableName, !IO) :-
+ globals.io_get_target(CompilationTarget, !IO),
+ %
+ % XXX We don't currently support the foreign_name attribute for languages
+ % other than C.
+ %
+ ( CompilationTarget = c ->
+ solutions(get_matching_foreign_name(ForeignNames, c),
+ TargetMutableNames),
+ (
+ TargetMutableNames = [],
+ TargetMutableName = mutable_c_var_name(ModuleName,
+ MercuryMutableName)
+ ;
+ TargetMutableNames = [foreign_name(_, TargetMutableName)]
+ % XXX We should really check that this is a valid identifier
+ % in the target language here.
+ ;
+ TargetMutableNames = [_, _ | _],
+ MultipleNamesError = [
+ words("Error: multiple foreign_name attributes specified"),
+ words("for the"),
+ fixed(compilation_target_string(CompilationTarget)),
+ words("backend.")
+ ],
+ write_error_pieces(Context, 0, MultipleNamesError, !IO),
+ TargetMutableName = mutable_c_var_name(ModuleName,
+ MercuryMutableName)
+ )
+ ;
+ (
+ ReportErrors = yes,
+ NYIError = [
+ words("Error: foreign_name mutable attribute not yet"),
+ words("implemented for the"),
+ fixed(compilation_target_string(CompilationTarget)),
+ words("backend.")
+ ],
+ write_error_pieces(Context, 0, NYIError, !IO)
+ ;
+ ReportErrors = no
+ ),
+ %
+ % This is just a dummy value - we only get here if an error
+ % has occurred.
+ %
+ TargetMutableName = mutable_c_var_name(ModuleName,
+ MercuryMutableName)
+ ).
+
+:- pred get_matching_foreign_name(list(foreign_name)::in,
+ foreign_language::in, foreign_name::out) is nondet.
+
+get_matching_foreign_name(ForeignNames, ForeignLanguage, ForeignName) :-
+ list.member(ForeignName, ForeignNames),
+ ForeignName = foreign_name(ForeignLanguage, _).
+
%-----------------------------------------------------------------------------%
add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO) :-
@@ -890,9 +977,7 @@
varset__new_named_var(varset__init, "X", X, VarSet),
Attrs0 = default_attributes(c),
set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs1),
- (
- list__member(thread_safe, MutAttrs)
- ->
+ ( mutable_var_thread_safe(MutAttrs) = thread_safe ->
set_thread_safe(thread_safe, Attrs1, Attrs)
;
Attrs = Attrs1
@@ -906,28 +991,56 @@
[InitTerm], (impure)) - Context),
add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
!IO),
+ mutable_var_maybe_foreign_names(MutAttrs) = MaybeForeignNames,
+ (
+ MaybeForeignNames = no,
+ TargetMutableName = mutable_c_var_name(ModuleName, Name)
+ ;
+ MaybeForeignNames = yes(ForeignNames),
+ ReportErrors = no, % We've already reported them during pass 2.
+ get_global_name_from_foreign_names(ReportErrors, Context,
+ ModuleName, Name, ForeignNames, TargetMutableName, !IO)
+ ),
set_purity((semipure), Attrs, GetAttrs),
GetClause = pragma(compiler(mutable_decl), 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) ++ ";",
+ ordinary("X = " ++ TargetMutableName ++ ";",
yes(Context)))),
add_item_clause(GetClause, !Status, Context, !ModuleInfo, !QualInfo,
!IO),
+ TrailMutableUpdates = mutable_var_trailed(MutAttrs),
(
- list__member(untrailed, MutAttrs)
- ->
+ TrailMutableUpdates = untrailed,
TrailCode = ""
;
- TrailCode =
- "MR_trail_current_value(&" ++
- mutable_c_var_name(Name) ++
- ");\n"
+ TrailMutableUpdates = trailed,
+ %
+ % If we require that the mutable to be trailed then
+ % we ened to be compiling in a trailing grade.
+ %
+ globals.io_lookup_bool_option(use_trail, UseTrail, !IO),
+ (
+ UseTrail = yes,
+ TrailCode = "MR_trail_current_value(&" ++
+ TargetMutableName ++ ");\n"
+ ;
+ UseTrail = no,
+ NonTrailingError = [
+ words("Error: trailed mutable in non-trailing grade.")
+ ],
+ write_error_pieces(Context, 0, NonTrailingError, !IO),
+ %
+ % This is just a dummy value.
+ %
+ TrailCode = ""
+ )
),
SetClause = pragma(compiler(mutable_decl), 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;",
+ ordinary(TrailCode ++ TargetMutableName
+ ++ " = X;",
yes(Context)))),
add_item_clause(SetClause, !Status, Context, !ModuleInfo, !QualInfo,
!IO)
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.137
diff -u -r1.137 prog_data.m
--- compiler/prog_data.m 12 Sep 2005 05:24:20 -0000 1.137
+++ compiler/prog_data.m 20 Sep 2005 16:35:49 -0000
@@ -203,7 +203,7 @@
mut_type :: (type),
mut_init_value :: prog_term,
mut_inst :: (inst),
- mut_attrs :: list(mutable_attr)
+ mut_attrs :: mutable_var_attributes
)
; nothing(
@@ -212,15 +212,9 @@
% 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.
+ %
:- type promise_type
% promise ex declarations
---> exclusive % each disjunct is mutually exclusive
@@ -244,6 +238,7 @@
% The `determinism' type specifies how many solutions a given
% procedure may have. Procedures for manipulating this type
% are defined in det_analysis.m and hlds_data.m.
+ %
:- type determinism
---> det
; semidet
@@ -257,6 +252,7 @@
% The `is_solver_type' type specifies whether a type is a "solver" type,
% for which `any' insts are interpreted as "don't know", or a non-solver
% type for which `any' is the same as `bound(...)'.
+ %
:- type is_solver_type
---> non_solver_type
% The inst `any' is always `bound' for this type.
@@ -275,6 +271,49 @@
%-----------------------------------------------------------------------------%
%
+% Mutable variables
+%
+
+ % Indicates if updates to the mutable are trailed or untrailed.
+ %
+:- type trailed ---> trailed ; untrailed.
+
+ % Has the user specified a name for us to use on the target code side
+ % of the FLI?
+ %
+:- type foreign_name
+ ---> foreign_name(
+ foreign_name_lang :: foreign_language,
+ foreign_name_name :: string
+ ).
+
+ % An abstract type for representing a set of mutable variable
+ % attributes.
+ %
+:- type mutable_var_attributes.
+
+ % Return the default attributes for a mutable variable.
+ %
+:- func default_mutable_attributes = mutable_var_attributes.
+
+ % Access functions for the `mutable_var_attributes' structure.
+ %
+:- func mutable_var_thread_safe(mutable_var_attributes) = thread_safe.
+:- func mutable_var_trailed(mutable_var_attributes) = trailed.
+:- func mutable_var_maybe_foreign_names(mutable_var_attributes)
+ = maybe(list(foreign_name)).
+
+:- pred set_mutable_var_thread_safe(thread_safe::in,
+ mutable_var_attributes::in, mutable_var_attributes::out) is det.
+
+:- pred set_mutable_var_trailed(trailed::in,
+ mutable_var_attributes::in, mutable_var_attributes::out) is det.
+
+:- pred set_mutable_add_foreign_name(foreign_name::in,
+ mutable_var_attributes::in, mutable_var_attributes::out) is det.
+
+%-----------------------------------------------------------------------------%
+%
% Pragmas
%
@@ -580,23 +619,21 @@
mode_check_clause_arity :: arity
).
+%-----------------------------------------------------------------------------%
%
-% Stuff for the foreign interfacing pragmas.
+% Stuff for the foreign language interface pragmas
%
- %
% A foreign_language_type represents a type that is defined in a
% foreign language and accessed in Mercury (most likely through
% pragma foreign_type).
% Currently we only support foreign_language_types for IL.
%
-
- %
% It is important to distinguish between IL value types and
% reference types, the compiler may need to generate different code
% for each of these cases.
%
-
+ %
:- type foreign_language_type
---> il(il_foreign_type)
; c(c_foreign_type)
@@ -625,6 +662,7 @@
---> reference
; value.
+%-----------------------------------------------------------------------------%
%
% Stuff for tabling pragmas
%
@@ -681,6 +719,7 @@
% by itself; it can have no Mercury
% descendants.
+%-----------------------------------------------------------------------------%
%
% Stuff for the `aditi_index' pragma
%
@@ -699,6 +738,7 @@
---> unique_B_tree
; non_unique_B_tree.
+%-----------------------------------------------------------------------------%
%
% Stuff for the `termination_info' pragma.
% See term_util.m.
@@ -724,15 +764,20 @@
:- type pragma_arg_size_info == generic_arg_size_info(unit).
:- type pragma_termination_info == generic_termination_info(unit, unit).
+%-----------------------------------------------------------------------------%
%
-% Stuff for the `termination2_info' pragma.
+% Stuff for the `termination2_info' pragma
%
-
+
% This is the form in which termination information from other
% modules (imported via `.opt' or `.trans_opt' files) comes.
% We convert this to an intermediate form and let the termination
% analyser convert it to the correct form.
-
+ %
+ % NOTE: the reason that we cannot convert it to the correct form
+ % is that we don't have complete information about how many typeinfo
+ % related arguments there are until after the polymorphism pass.
+ %
:- type arg_size_constr
---> le(list(arg_size_term), rat)
; eq(list(arg_size_term), rat).
@@ -741,8 +786,9 @@
:- type pragma_constr_arg_size_info == list(arg_size_constr).
+%-----------------------------------------------------------------------------%
%
-% Stuff for the `unused_args' pragma.
+% Stuff for the `unused_args' pragma
%
% This `mode_num' type is only used for mode numbers written out in
@@ -753,8 +799,9 @@
% (prog_data.m) should not depend on the HLDS.
:- type mode_num == int.
+%-----------------------------------------------------------------------------%
%
-% Stuff for the `exceptions' pragma.
+% Stuff for the `exceptions' pragma
%
:- type exception_status
@@ -766,6 +813,7 @@
% This procedure may throw an exception
% The exception is classified by the
% `exception_type' type.
+
; conditional.
% Whether the procedure will not throw an
% exception depends upon the value of one
@@ -785,17 +833,20 @@
% user-defined equality or comparison) or
% propagating an exception from them.
+%-----------------------------------------------------------------------------%
%
-% Stuff for the `type_spec' pragma.
+% Stuff for the `type_spec' pragma
%
% The type substitution for a `pragma type_spec' declaration.
% Elsewhere in the compiler we generally use the `tsubst' type
% which is a map rather than an assoc_list.
+ %
:- type type_subst == assoc_list(tvar, type).
+%-----------------------------------------------------------------------------%
%
-% Stuff for `foreign_code' pragma.
+% Stuff for `foreign_code' pragma
%
% This type holds information about the implementation details
@@ -809,8 +860,10 @@
% program.
% The context is missing if the foreign code was constructed by
% the compiler.
- % Note that nondet pragma foreign definitions might not be
+ %
+ % NOTE: nondet pragma foreign definitions might not be
% possible in all foreign languages.
+ %
:- type pragma_foreign_code_impl
---> ordinary( % This is a foreign language
% definition of a model_det
@@ -1016,11 +1069,12 @@
%-----------------------------------------------------------------------------%
%
-% Some more stuff for `pragma c_code'.
+% Some more stuff for the foreign language interface
%
- % an abstract type for representing a set of
- % `pragma_c_code_attribute's.
+ % An abstract type for representing a set of
+ % `pragma_foreign_proc_attribute's.
+ %
:- type pragma_foreign_proc_attributes.
:- func default_attributes(foreign_language) = pragma_foreign_proc_attributes.
@@ -1111,6 +1165,7 @@
% This type specifies the termination property of a procedure
% defined using pragma c_code or pragma foreign_proc.
+ %
:- type terminates
---> terminates
% The foreign code will terminate for all input.
@@ -1272,7 +1327,7 @@
% designed to be used in only two ways: for translation to their HLDS
% equivalents by the unshroud functions in hlds_pred.m, and for
% printing for diagnostics.
-
+ %
:- type shrouded_pred_id ---> shrouded_pred_id(int).
:- type shrouded_proc_id ---> shrouded_proc_id(int).
:- type shrouded_pred_proc_id ---> shrouded_pred_proc_id(int, int).
@@ -1513,9 +1568,8 @@
%-----------------------------------------------------------------------------%
%
-% Kinds.
+% Kinds
%
-
% Note that we don't support any kind other than `star' at the
% moment. The other kinds are intended for the implementation
% of constructor classes.
@@ -1551,14 +1605,14 @@
%-----------------------------------------------------------------------------%
%
-% insts and modes
+% Insts and modes
%
% This is how instantiatednesses and modes are represented.
% Note that while we use the normal term data structure to represent
% type terms (see above), we need a separate data structure for inst
% terms.
-
+ %
:- type (inst)
---> any(uniqueness)
; free
@@ -1665,7 +1719,7 @@
% Note that `typed_ground' is a special case of `typed_inst',
% and `ground_inst' and `any_inst' are special cases of `unify_inst'.
% The reason for having the special cases is efficiency.
-
+ %
:- type inst_name
---> user_inst(sym_name, list(inst))
; merge_inst(inst, inst)
@@ -1677,9 +1731,10 @@
; typed_ground(uniqueness, type)
; typed_inst(type, inst_name).
- % Note: `is_live' records liveness in the sense used by
+ % NOTE: `is_live' records liveness in the sense used by
% mode analysis. This is not the same thing as the notion of liveness
% used by code generation. See compiler/notes/glossary.html.
+ %
:- type is_live ---> live ; dead.
% Unifications of insts fall into two categories, "real" and "fake".
@@ -1698,7 +1753,7 @@
% But these fake unifications must be allowed to unify with `clobbered'
% insts. Hence we pass down a flag to `abstractly_unify_inst' which
% specifies whether or not to allow unifications with clobbered values.
-
+ %
:- type unify_is_real
---> real_unify
; fake_unify.
@@ -1723,7 +1778,7 @@
% This is how module-system declarations (such as imports
% and exports) are represented.
-
+ %
:- type module_defn
---> module(module_name)
; end_module(module_name)
@@ -1883,6 +1938,11 @@
:- import_module string.
+%-----------------------------------------------------------------------------%
+%
+% Some more stuff for the foreign language interface
+%
+
:- type pragma_foreign_proc_attributes
---> attributes(
foreign_language :: foreign_language,
@@ -2015,6 +2075,44 @@
"max_stack_size(" ++ string__int_to_string(Size) ++ ")".
%-----------------------------------------------------------------------------%
+%
+% Mutable variables
+%
+
+ % Attributes for mutable variables.
+ %
+:- type mutable_var_attributes
+ ---> mutable_var_attributes(
+ mutable_trailed :: trailed,
+ mutable_thread_safe :: thread_safe,
+ mutable_foreign_names :: maybe(list(foreign_name))
+ ).
+
+default_mutable_attributes =
+ mutable_var_attributes(trailed, not_thread_safe, no).
+
+mutable_var_thread_safe(MVarAttrs) = MVarAttrs ^ mutable_thread_safe.
+mutable_var_trailed(MVarAttrs) = MVarAttrs ^ mutable_trailed.
+mutable_var_maybe_foreign_names(MVarAttrs) = MVarAttrs ^ mutable_foreign_names.
+
+set_mutable_var_thread_safe(ThreadSafe, !Attributes) :-
+ !:Attributes = !.Attributes ^ mutable_thread_safe := ThreadSafe.
+set_mutable_var_trailed(Trailed, !Attributes) :-
+ !:Attributes = !.Attributes ^ mutable_trailed := Trailed.
+set_mutable_add_foreign_name(ForeignName, !Attributes) :-
+ MaybeForeignNames0 = !.Attributes ^ mutable_foreign_names,
+ (
+ MaybeForeignNames0 = no,
+ MaybeForeignNames = yes([ForeignName])
+ ;
+ MaybeForeignNames0 = yes(ForeignNames0),
+ ForeignNames = [ ForeignName | ForeignNames0],
+ MaybeForeignNames = yes(ForeignNames)
+ ),
+ !:Attributes =
+ !.Attributes ^ mutable_foreign_names := MaybeForeignNames.
+
+%-----------------------------------------------------------------------------%
tvarset_merge_renaming(TVarSetA, TVarSetB, TVarSet, Renaming) :-
varset__merge_subst(TVarSetA, TVarSetB, TVarSet, Subst),
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.249
diff -u -r1.249 prog_io.m
--- compiler/prog_io.m 12 Sep 2005 08:20:26 -0000 1.249
+++ compiler/prog_io.m 20 Sep 2005 16:51:04 -0000
@@ -1819,11 +1819,12 @@
% Mutable declaration syntax:
%
-% :- mutable(name, type, value, inst, [untrailed, promise_thread_safe]).
+% :- mutable(name, type, value, inst, <attribute_list>).
% (The list of attributes at the end is optional.)
%
-% E.g.:
-% :- mutable(counter, int, 0, ground, [promise_thread_safe]).
+% e.g.:
+%
+% :- mutable(counter, int, 0, ground, [thread_safe]).
%
% This is converted into the following:
%
@@ -1840,18 +1841,21 @@
% "MR_trail_current_value(&mutable_counter);
% mutable_counter = X;").
%
-% :- pragma foreign_decl("C", "MR_Word mutable_counter;").
+% :- pragma foreign_decl("C", "extern MR_Word mutable_counter;").
+% :- pragma foreign_code("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 `untrailed' appears in the mutable declaration
-% attributes.
+% If the `thread_safe' attribute is specified in <attribute_list>
+% then foreign_procs are created that have the thread_safe attribute
+% set. If the `untrailed' attribute is specified in <attribute_list>
+% then the code for trailing the mutable variable in the set predicate
+% is omitted.
:- pred parse_mutable_decl(module_name::in, varset::in, list(term)::in,
maybe1(item)::out) is semidet.
@@ -1864,7 +1868,7 @@
parse_mutable_inst(InstTerm, InstResult),
(
OptMutAttrsTerm = [],
- MutAttrsResult = ok([])
+ MutAttrsResult = ok(default_mutable_attributes)
;
OptMutAttrsTerm = [MutAttrsTerm],
parse_mutable_attrs(MutAttrsTerm, MutAttrsResult)
@@ -1939,34 +1943,89 @@
InstTerm)
).
+:- type collected_mutable_attribute
+ ---> trailed(trailed)
+ ; thread_safe(thread_safe)
+ ; foreign_name(foreign_name).
-:- pred parse_mutable_attrs(term::in, maybe1(list(mutable_attr))::out) is det.
+:- pred parse_mutable_attrs(term::in,
+ maybe1(mutable_var_attributes)::out) is det.
parse_mutable_attrs(MutAttrsTerm, MutAttrsResult) :-
- (
- list_term_to_term_list(MutAttrsTerm, MutAttrTerms)
- ->
- map_parser(parse_mutable_attr, MutAttrTerms, MutAttrsResult)
+ Attributes0 = default_mutable_attributes,
+ ConflictingAttributes = [
+ thread_safe(thread_safe) - thread_safe(not_thread_safe),
+ trailed(trailed) - trailed(untrailed)
+ ],
+ (
+ list_term_to_term_list(MutAttrsTerm, MutAttrTerms),
+ map_parser(parse_mutable_attr, MutAttrTerms, MaybeAttrList),
+ MaybeAttrList = ok(CollectedMutAttrs)
+ ->
+ %
+ % We check for trailed/untrailed and
+ % thread_safe/not_thread_safe conflicts here and deal
+ % with conflicting foreign_name attributes during
+ % make_hlds_passes.m.
+ %
+ (
+ list.member(Conflict1 - Conflict2,
+ ConflictingAttributes),
+ list.member(Conflict1, CollectedMutAttrs),
+ list.member(Conflict2, CollectedMutAttrs)
+ ->
+ MutAttrsResult = error("conflicting attributes " ++
+ "in attribute list", MutAttrsTerm)
+ ;
+ list.foldl(process_mutable_attribute,
+ CollectedMutAttrs, Attributes0, Attributes),
+ MutAttrsResult = ok(Attributes)
+ )
;
MutAttrsResult = error("malformed attribute list in " ++
"mutable declaration", MutAttrsTerm)
).
-:- pred parse_mutable_attr(term::in, maybe1(mutable_attr)::out) is det.
+:- pred process_mutable_attribute(collected_mutable_attribute::in,
+ mutable_var_attributes::in, mutable_var_attributes::out) is det.
+
+process_mutable_attribute(thread_safe(ThreadSafe), !Attributes) :-
+ set_mutable_var_thread_safe(ThreadSafe, !Attributes).
+process_mutable_attribute(trailed(Trailed), !Attributes) :-
+ set_mutable_var_trailed(Trailed, !Attributes).
+process_mutable_attribute(foreign_name(ForeignName), !Attributes) :-
+ set_mutable_add_foreign_name(ForeignName, !Attributes).
+
+:- pred parse_mutable_attr(term::in,
+ maybe1(collected_mutable_attribute)::out) is det.
parse_mutable_attr(MutAttrTerm, MutAttrResult) :-
(
MutAttrTerm = term__functor(term__atom(String), [], _),
(
String = "untrailed",
- MutAttr = untrailed
+ MutAttr = trailed(untrailed)
+ ;
+ String = "trailed",
+ MutAttr = trailed(trailed)
;
String = "thread_safe",
- MutAttr = thread_safe
+ MutAttr = thread_safe(thread_safe)
+ ;
+ String = "not_thread_safe",
+ MutAttr = thread_safe(not_thread_safe)
)
->
MutAttrResult = ok(MutAttr)
;
+ MutAttrTerm = term.functor(term.atom("foreign_name"), Args, _),
+ Args = [LangTerm, ForeignNameTerm],
+ parse_foreign_language(LangTerm, Lang),
+ ForeignNameTerm = term.functor(term.string(ForeignName), [], _)
+ ->
+ MutAttr = foreign_name(foreign_name(Lang, ForeignName)),
+ MutAttrResult = ok(MutAttr)
+ ;
MutAttrResult = error("unrecognised attribute in mutable " ++
"declaration", MutAttrTerm)
).
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.88
diff -u -r1.88 prog_io_pragma.m
--- compiler/prog_io_pragma.m 12 Sep 2005 08:20:26 -0000 1.88
+++ compiler/prog_io_pragma.m 20 Sep 2005 05:38:29 -0000
@@ -15,6 +15,7 @@
:- interface.
+:- import_module libs__globals.
:- import_module mdbcomp__prim_data.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_io_util.
@@ -30,12 +31,15 @@
:- pred parse_pragma(module_name::in, varset::in, list(term)::in,
maybe1(item)::out) is semidet.
+ % Parse a term that represents a foreign language.
+ %
+:- pred parse_foreign_language(term::in, foreign_language::out) is semidet.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module libs__globals.
:- import_module libs__lp_rational.
:- import_module libs__rat.
:- import_module parse_tree__prog_io.
@@ -276,8 +280,6 @@
IsLocal = foreign_decl_is_exported
).
-:- pred parse_foreign_language(term::in, foreign_language::out) is semidet.
-
parse_foreign_language(term__functor(term__string(String), _, _), Lang) :-
globals__convert_foreign_language(String, Lang).
parse_foreign_language(term__functor(term__atom(String), _, _), Lang) :-
Index: compiler/prog_mutable.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_mutable.m,v
retrieving revision 1.1
diff -u -r1.1 prog_mutable.m
--- compiler/prog_mutable.m 15 Sep 2005 07:38:45 -0000 1.1
+++ compiler/prog_mutable.m 16 Sep 2005 08:08:47 -0000
@@ -36,13 +36,14 @@
:- func mutable_init_pred_sym_name(sym_name, string) = sym_name.
-:- func mutable_c_var_name(string) = string.
+:- func mutable_c_var_name(sym_name, string) = string.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_mode.
:- import_module list.
:- import_module std_util.
@@ -91,7 +92,10 @@
mutable_init_pred_sym_name(ModuleName, Name) =
qualified(ModuleName, "initialise_mutable_" ++ Name).
-mutable_c_var_name(Name) = "mutable_variable_" ++ Name.
+mutable_c_var_name(ModuleName, Name) = MangledCVarName :-
+ RawCVarName = "mutable_variable_" ++ Name,
+ QualifiedCVarName = qualified(ModuleName, RawCVarName),
+ MangledCVarName = sym_name_mangle(QualifiedCVarName).
%-----------------------------------------------------------------------------%
:- end_module prog_mutable.
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.327
diff -u -r1.327 reference_manual.texi
--- doc/reference_manual.texi 16 Sep 2005 05:42:53 -0000 1.327
+++ doc/reference_manual.texi 20 Sep 2005 16:47:26 -0000
@@ -4590,17 +4590,45 @@
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 (see
- at ref{Foreign code attributes}), and @samp{untrailed}, meaning that the effects
-of calls to @samp{set_varname/1} should not be undone on backtracking.
+The following @samp{attributes} must be supported:
-Note that it is an error for a @samp{mutable} directive to appear in the
-interface section of a module.
+ at table @asis
+
+ at item @samp{thread_safe}/@samp{not_thread_safe}
+This attribute declares if it is safe for multiple threads to
+access the mutable concurrently. The default, in case none is
+specified, is @samp{not_thread_safe}. (See @ref{Foreign code attributes}
+for further details.)
+
+ at item @samp{trailed}/@samp{untrailed}
+This attribute declares if the implementation should generate code so that
+the effects of @samp{set_varname/1} can be undone on backtracking. The
+default, in case none is specified, is @samp{trailed}.
+
+ at end table
+
+The Melbourne Mercury compiler also supports the following attribute.
-Foreign code in the same module can access the mutable variable using the name
- at samp{mutable_variable_varname}, which is a global variable of type
- at samp{MR_Word}.
+ at table @asis
+
+ at item @samp{foreign_name(Lang, Name)}
+Allow foreign code to access the mutable variable in some implementation
+dependent manner. @samp{Lang} must be a valid target language for
+this Mercury implementation. @samp{Name} must be a valid identifier in
+that language. It is an error to specify more than one foreign name
+attribute for each language.
+
+For the C backends this attribute allows foreign code to access
+the mutable variable as an external variable called @samp{Name}.
+This variable has type @samp{MR_Word}.
+
+This attribute is not currently implemented for the non-C backends.
+
+ at end table
+
+Note that it is an error for a @samp{mutable} directive to appear in the
+interface section of a module. The usual visibility rules for sub-modules
+apply to the mutable variable access predicates.
@node Type classes
@chapter Type classes
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.267
diff -u -r1.267 Mmakefile
--- tests/hard_coded/Mmakefile 9 Sep 2005 07:00:56 -0000 1.267
+++ tests/hard_coded/Mmakefile 20 Sep 2005 14:43:58 -0000
@@ -71,6 +71,7 @@
float_rounding_bug \
foreign_and_mercury \
foreign_import_module \
+ foreign_name_mutable \
foreign_type \
foreign_type2 \
foreign_type3 \
@@ -199,6 +200,7 @@
unify_typeinfo_bug \
uniq_duplicate_call \
unused_float_box_test \
+ unusual_mutable_name \
user_compare \
user_defined_equality2 \
version_array_test \
Index: tests/hard_coded/foreign_name_mutable.exp
===================================================================
RCS file: tests/hard_coded/foreign_name_mutable.exp
diff -N tests/hard_coded/foreign_name_mutable.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_name_mutable.exp 20 Sep 2005 14:10:22 -0000
@@ -0,0 +1 @@
+X = 43
Index: tests/hard_coded/foreign_name_mutable.m
===================================================================
RCS file: tests/hard_coded/foreign_name_mutable.m
diff -N tests/hard_coded/foreign_name_mutable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_name_mutable.m 20 Sep 2005 14:10:22 -0000
@@ -0,0 +1,30 @@
+:- module foreign_name_mutable.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- mutable(foo, int, 42, ground, [untrailed, foreign_name("C", "FOO")]).
+
+main(!IO) :-
+ increment_global(!IO),
+ promise_pure (
+ semipure get_foo(X)
+ ),
+ io.write_string("X = ", !IO),
+ io.write_int(X, !IO),
+ io.nl(!IO).
+
+:- pred increment_global(io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ increment_global(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ FOO++;
+ IO = IO0;
+").
Index: tests/hard_coded/unusual_name_mutable.exp
===================================================================
RCS file: tests/hard_coded/unusual_name_mutable.exp
diff -N tests/hard_coded/unusual_name_mutable.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/unusual_name_mutable.exp 20 Sep 2005 14:42:08 -0000
@@ -0,0 +1 @@
+'123$%^abc 7' = 42
Index: tests/hard_coded/unusual_name_mutable.m
===================================================================
RCS file: tests/hard_coded/unusual_name_mutable.m
diff -N tests/hard_coded/unusual_name_mutable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/unusual_name_mutable.m 20 Sep 2005 14:42:41 -0000
@@ -0,0 +1,19 @@
+:- module unusual_name_mutable.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+
+:- mutable('123$%^abc 7', int, 42, ground, [untrailed, thread_safe]).
+
+main(!IO) :-
+ promise_pure ( semipure 'get_123$%^abc 7'(X)),
+ io.write_string("'123$%^abc 7' = ", !IO),
+ io.write_int(X, !IO),
+ io.nl(!IO).
Index: tests/invalid/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mercury.options,v
retrieving revision 1.11
diff -u -r1.11 Mercury.options
--- tests/invalid/Mercury.options 6 May 2005 08:42:32 -0000 1.11
+++ tests/invalid/Mercury.options 20 Sep 2005 08:50:20 -0000
@@ -69,6 +69,11 @@
MCFLAGS-record_syntax_errors = --verbose-error-messages
MCFLAGS-sub_c = --verbose-error-messages --no-intermodule-optimization \
--no-automatic-intermodule-optimization
+
+# Force this test to be compiled in a non-trailing grade since in this
+# case the error we want to report is the absence of trailing.
+MCFLAGS-trailed_mutable = --no-use-trail
+
MCFLAGS-test_nested = --no-intermodule-optimization \
--no-automatic-intermodule-optimization
MCFLAGS-transitive_import = --no-intermodule-optimization \
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.176
diff -u -r1.176 Mmakefile
--- tests/invalid/Mmakefile 13 Sep 2005 01:54:13 -0000 1.176
+++ tests/invalid/Mmakefile 20 Sep 2005 08:46:00 -0000
@@ -154,6 +154,7 @@
state_vars_test5 \
tc_err1 \
tc_err2 \
+ trailed_mutable \
tricky_assert1 \
typeclass_bogus_method \
typeclass_constraint_extra_var \
Index: tests/invalid/bad_mutable.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/bad_mutable.err_exp,v
retrieving revision 1.2
diff -u -r1.2 bad_mutable.err_exp
--- tests/invalid/bad_mutable.err_exp 14 Sep 2005 05:26:42 -0000 1.2
+++ tests/invalid/bad_mutable.err_exp 20 Sep 2005 13:40:17 -0000
@@ -1,4 +1,4 @@
-bad_mutable.m:015: Error: unrecognised attribute in mutable declaration: bad_attrib.
+bad_mutable.m:015: Error: malformed attribute list in mutable declaration: [untrailed, thread_safe, bad_attrib].
bad_mutable.m:017: Error: the type in a mutable declaration cannot contain variables: list(_1).
bad_mutable.m:011: In declaration for mutable `not_a_type':
bad_mutable.m:011: error: undefined type `no_type'/0.
Index: tests/invalid/bad_mutable.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/bad_mutable.m,v
retrieving revision 1.1
diff -u -r1.1 bad_mutable.m
--- tests/invalid/bad_mutable.m 12 Sep 2005 03:05:51 -0000 1.1
+++ tests/invalid/bad_mutable.m 20 Sep 2005 13:54:08 -0000
@@ -15,3 +15,10 @@
:- mutable(bad_attribute, int, 0, ground, [untrailed, thread_safe, bad_attrib]).
:- mutable(poly_type, list(T), [], ground, [untrailed, thread_safe]).
+
+:- mutable(conflicting_trail, int, 0, ground, [untrailed, trailed]).
+
+:- mutable(conflicting_thread, int, 0, ground, [thread_safe, not_thread_safe]).
+
+:- mutable(multiple_foreign, int, 0, ground,
+ [untrailed, foreign_name("C", one), foreign_name("C", two)]).
Index: tests/invalid/trailed_mutable.err_exp
===================================================================
RCS file: tests/invalid/trailed_mutable.err_exp
diff -N tests/invalid/trailed_mutable.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/trailed_mutable.err_exp 20 Sep 2005 08:45:35 -0000
@@ -0,0 +1 @@
+trailed_mutable.m:011: Error: trailed mutable in non-trailing grade.
Index: tests/invalid/trailed_mutable.m
===================================================================
RCS file: tests/invalid/trailed_mutable.m
diff -N tests/invalid/trailed_mutable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/trailed_mutable.m 20 Sep 2005 08:45:35 -0000
@@ -0,0 +1,11 @@
+:- module trailed_mutable.
+
+:- interface.
+
+:- type foo.
+
+:- implementation.
+
+:- type foo == int.
+
+:- mutable(global, int, 42, ground, [trailed]).
--------------------------------------------------------------------------
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