[m-rev.] diff: move mutable transformation into a separate module
Julien Fischer
juliensf at csse.unimelb.edu.au
Mon May 28 16:58:46 AEST 2007
Estimated hours taken: 2
Branches: main
Shift the code that implements the source-to-source transformation for
mutables into a separate sub-module of make_hlds. This should make
it easier to maintain / modify since it is no longer spread throughout
make_hlds_passes.m. There are no changes to any algorithms.
compiler/add_mutable.m:
New module. Move the code that implements the mutable
source-to-source transformation to here.
compiler/make_hlds_passes.m:
Delete the predicates that implement the source-to-source
transformation for mutables from here and instead call the new
versions in add_mutable.
compiler/prog_item.m:
Add a utility inst for sub-typing on the item/0 type.
compiler/notes/compiler_design.html:
Mention the new module.
Julien.
Index: compiler/add_mutable.m
===================================================================
RCS file: compiler/add_mutable.m
diff -N compiler/add_mutable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/add_mutable.m 28 May 2007 06:56:02 -0000
@@ -0,0 +1,904 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: add_mutable.m.
+%
+% This module contains predicates that implement the source-to-source
+% transformation for mutables described in the comment at the top of
+% prog_mutable.m.
+%
+%-----------------------------------------------------------------------------%
+
+:- module hlds.make_hlds.add_mutable.
+:- interface.
+
+%-----------------------------------------------------------------------------%
+
+:- inst item_mutable
+ ---> item_mutable(ground, ground, ground, ground, ground, ground).
+
+:- pred add_mutable_pass_1(item::in(item_mutable), prog_context::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+:- pred add_mutable_pass_2(item::in(item_mutable), prog_context::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+:- pred add_mutable_clauses(item::in(item_mutable),
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module backend_libs.
+:- import_module backend_libs.foreign.
+:- import_module hlds.hlds_code_util.
+:- import_module hlds.hlds_out.
+:- import_module hlds.make_hlds.add_pragma.
+:- import_module hlds.make_hlds.make_hlds_error.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module libs.globals.
+:- import_module libs.options.
+:- import_module parse_tree.prog_mode.
+:- import_module parse_tree.prog_mutable.
+:- import_module parse_tree.prog_util.
+
+:- import_module pair.
+:- import_module solutions.
+:- import_module string.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+%
+% Code to add access pred. decls
+%
+
+add_mutable_pass_1(Item, Context, !Status, !ModuleInfo, !Specs) :-
+ Item = item_mutable(Name, Type, _InitValue, Inst, MutAttrs, _MutVarset),
+ !.Status = item_status(ImportStatus, _),
+ DefinedThisModule = status_defined_in_this_module(ImportStatus),
+ (
+ DefinedThisModule = yes,
+ module_info_get_name(!.ModuleInfo, ModuleName),
+ %
+ % Create the initialisation predicate and the mutex initialisation
+ % predicate. The latter is called by the former.
+ %
+ InitPredDecl = mutable_init_pred_decl(ModuleName, Name),
+ add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
+ !Specs),
+ IsConstant = mutable_var_constant(MutAttrs),
+ (
+ IsConstant = no,
+
+ % Create the pre-initialisation predicate. This is called
+ % by the mutable initialisation predicate.
+ PreInitPredDecl = mutable_pre_init_pred_decl(ModuleName, Name),
+ add_item_decl_pass_1(PreInitPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+
+ % Create the primitive access and locking predicates.
+ LockPredDecl = lock_pred_decl(ModuleName, Name),
+ add_item_decl_pass_1(LockPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ UnlockPredDecl = unlock_pred_decl(ModuleName, Name),
+ add_item_decl_pass_1(UnlockPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ UnsafeGetPredDecl = unsafe_get_pred_decl(ModuleName, Name,
+ Type, Inst),
+ add_item_decl_pass_1(UnsafeGetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ UnsafeSetPredDecl = unsafe_set_pred_decl(ModuleName, Name,
+ Type, Inst),
+ add_item_decl_pass_1(UnsafeSetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+
+ % Create the standard, non-pure access predicates. These are
+ % always created for non-constant mutables, even if the
+ % `attach_to_io_state' attribute has been specified.
+ StdGetPredDecl = std_get_pred_decl(ModuleName, Name, Type, Inst),
+ add_item_decl_pass_1(StdGetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ StdSetPredDecl = std_set_pred_decl(ModuleName, Name, Type, Inst),
+ add_item_decl_pass_1(StdSetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+
+ % If requested, create the pure access predicates using
+ % the I/O state as well.
+ CreateIOInterface = mutable_var_attach_to_io_state(MutAttrs),
+ (
+ CreateIOInterface = yes,
+ IOGetPredDecl = io_get_pred_decl(ModuleName, Name, Type, Inst),
+ add_item_decl_pass_1(IOGetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ IOSetPredDecl = io_set_pred_decl(ModuleName, Name, Type, Inst),
+ add_item_decl_pass_1(IOSetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs)
+ ;
+ CreateIOInterface = no
+ )
+ ;
+ IsConstant = yes,
+
+ % We create the "get" access predicate, which is pure since
+ % it always returns the same value, but we must also create
+ % a secret "set" predicate for use by the initialization code.
+ ConstantGetPredDecl = constant_get_pred_decl(ModuleName, Name,
+ Type, Inst),
+ add_item_decl_pass_1(ConstantGetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ ConstantSetPredDecl = constant_set_pred_decl(ModuleName, Name,
+ Type, Inst),
+ add_item_decl_pass_1(ConstantSetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs)
+ )
+ ;
+ DefinedThisModule = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
+add_mutable_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
+ Item = item_mutable(Name, _Type, _InitTerm, Inst, MutAttrs, _MutVarset),
+ !.Status = item_status(ImportStatus, _),
+ ( ImportStatus = status_exported ->
+ error_is_exported(Context, "`mutable' declaration", !Specs)
+ ;
+ true
+ ),
+ %
+ % We don't implement the `mutable' declaration unless it is defined in
+ % this module. Not having this check means that we might end up up
+ % duplicating the definition of the global variable in any submodules.
+ %
+ DefinedThisModule = status_defined_in_this_module(ImportStatus),
+ (
+ DefinedThisModule = yes,
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.get_target(Globals, CompilationTarget),
+
+ % XXX We don't currently support the foreign_name attribute
+ % for languages other than C.
+ (
+ CompilationTarget = target_c,
+ mutable_var_maybe_foreign_names(MutAttrs) = MaybeForeignNames,
+ module_info_get_name(!.ModuleInfo, ModuleName),
+ (
+ MaybeForeignNames = no
+ ;
+ MaybeForeignNames = yes(ForeignNames),
+
+ % Report any errors with the foreign_name attributes
+ % during this pass.
+ ReportErrors = yes,
+ get_global_name_from_foreign_names(!.ModuleInfo, ReportErrors,
+ Context, ModuleName, Name, ForeignNames,
+ _TargetMutableName, !Specs)
+ ),
+
+ % If we are creating the I/O version of the set predicate then we
+ % need to add a promise_pure pragma for it. This needs to be done
+ % here (in stage 2) rather than in stage 3 where the rest of the
+ % mutable transformation is.
+
+ IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
+ (
+ IOStateInterface = yes,
+ SetPredName = mutable_set_pred_sym_name(ModuleName, Name),
+ IOSetPromisePurePragma = pragma_promise_pure(SetPredName, 3),
+ add_pragma(compiler(mutable_decl), IOSetPromisePurePragma,
+ Context, !Status, !ModuleInfo, !Specs)
+ ;
+ IOStateInterface = no
+ )
+ ;
+ ( CompilationTarget = target_il
+ ; CompilationTarget = target_java
+ ; CompilationTarget = target_asm
+ ; CompilationTarget = target_x86_64
+ ; CompilationTarget = target_erlang
+ ),
+ Pieces = [words("Error: foreign_name mutable attribute not yet"),
+ words("implemented for the"),
+ fixed(compilation_target_string(CompilationTarget)),
+ words("backend."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ),
+ %
+ % Check that the inst in the mutable declaration is a valid inst for a
+ % mutable declaration.
+ %
+ ( is_valid_mutable_inst(!.ModuleInfo, Inst) ->
+ true
+ ;
+ % It is okay to pass a dummy varset in here since any attempt
+ % to use inst variables in a mutable declaration should already
+ % been dealt with when the mutable declaration was parsed.
+ DummyInstVarset = varset.init,
+ InstStr = mercury_expanded_inst_to_string(Inst, DummyInstVarset,
+ !.ModuleInfo),
+ InvalidInstPieces = [
+ words("Error: the inst"),
+ quote(InstStr),
+ words("is not a valid inst for a mutable declaration.")
+ ],
+ % XXX we could provide more information about exactly *why* the
+ % inst was not valid here as well.
+ InvalidInstMsg = simple_msg(Context, [always(InvalidInstPieces)]),
+ InvalidInstSpec = error_spec(severity_error,
+ phase_parse_tree_to_hlds, [InvalidInstMsg]),
+ !:Specs = [ InvalidInstSpec | !.Specs ]
+ )
+ ;
+ DefinedThisModule = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
+add_mutable_clauses(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ Item = item_mutable(MercuryMutableName, Type, InitTerm, Inst,
+ MutAttrs, MutVarset),
+
+ % The transformation here is documented in the comments at the
+ % beginning of prog_mutable.m.
+
+ DefinedThisModule = status_defined_in_this_module(!.Status),
+ (
+ DefinedThisModule = yes,
+ module_info_get_name(!.ModuleInfo, ModuleName),
+ IsConstant = mutable_var_constant(MutAttrs),
+ IsThreadLocal = mutable_var_thread_local(MutAttrs),
+
+ % Work out what name to give the global in the target language.
+ decide_mutable_target_var_name(!.ModuleInfo, MutAttrs, ModuleName,
+ MercuryMutableName, Context, TargetMutableName, !Specs),
+
+ % Add foreign_decl and foreign_code items that declare/define the
+ % global variable used to implement the mutable. If the mutable is
+ % not constant then add a mutex to synchronize access to it as well.
+ add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant,
+ IsThreadLocal, Context, !QualInfo, !ModuleInfo, !Specs),
+
+ % Set up the default attributes for the foreign_procs used for the
+ % access predicates.
+ % XXX Handle target languages other than C here.
+ Attrs0 = default_attributes(lang_c),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
+ (
+ AlwaysBoxed = yes,
+ BoxPolicy = always_boxed
+ ;
+ AlwaysBoxed = no,
+ BoxPolicy = native_if_possible
+ ),
+ set_box_policy(BoxPolicy, Attrs0, Attrs1),
+ set_may_call_mercury(proc_will_not_call_mercury, Attrs1, Attrs),
+
+ (
+ IsConstant = yes,
+ InitSetPredName = mutable_secret_set_pred_sym_name(ModuleName,
+ MercuryMutableName),
+ add_constant_mutable_access_preds(TargetMutableName,
+ ModuleName, MercuryMutableName, Attrs, Inst, BoxPolicy,
+ Context, !Status, !QualInfo, !ModuleInfo, !Specs)
+ ;
+ IsConstant = no,
+ InitSetPredName = mutable_set_pred_sym_name(ModuleName,
+ MercuryMutableName),
+ TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
+ !.ModuleInfo, Type),
+ add_mutable_primitive_preds(TargetMutableName, ModuleName,
+ MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
+ Context, !Status, !QualInfo, !ModuleInfo, !Specs),
+ add_mutable_user_access_preds(ModuleName, MercuryMutableName,
+ MutAttrs, Context, !Status, !QualInfo, !ModuleInfo, !Specs)
+ ),
+ add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
+ ModuleName, MercuryMutableName, MutVarset, InitSetPredName,
+ InitTerm, Attrs, !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ DefinedThisModule = no
+ ).
+
+ % Decide what the name of the underlying global used to implement the
+ % mutable should be. If there is a foreign_name attribute then use that
+ % otherwise construct one based on the Mercury name for the mutable
+ %
+:- pred decide_mutable_target_var_name(module_info::in,
+ mutable_var_attributes::in, module_name::in, string::in, prog_context::in,
+ string::out, list(error_spec)::in, list(error_spec)::out) is det.
+
+decide_mutable_target_var_name(ModuleInfo, MutAttrs, ModuleName, Name, Context,
+ TargetMutableName, !Specs) :-
+ 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(ModuleInfo, ReportErrors, Context,
+ ModuleName, Name, ForeignNames, TargetMutableName, !Specs)
+ ).
+
+ % Add the foreign_decl and foreign_code items that declare/define
+ % the global variable used to hold the mutable.
+ %
+:- pred add_mutable_defn_and_decl(string::in, mer_type::in, bool::in,
+ mutable_thread_local::in, prog_context::in, qual_info::in, qual_info::out,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant, IsThreadLocal,
+ Context, !QualInfo, !ModuleInfo, !Specs) :-
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.get_target(Globals, CompilationTarget),
+
+ % We add the foreign code declaration and definition here rather than
+ % in pass 2 because the target-language-specific type name depends on
+ % whether there are any foreign_type declarations for Type.
+ (
+ CompilationTarget = target_c,
+ get_mutable_global_foreign_decl_defn(!.ModuleInfo, Type,
+ TargetMutableName, IsConstant, IsThreadLocal,
+ ForeignDecl, ForeignDefn),
+ ItemStatus0 = item_status(status_local, may_be_unqualified),
+ ForeignDecl = item_pragma(ForeignDeclOrigin, ForeignDeclPragma),
+ add_pragma(ForeignDeclOrigin, ForeignDeclPragma, Context,
+ ItemStatus0, _, !ModuleInfo, !Specs),
+ ForeignDefn = item_pragma(ForeignDefnOrigin, ForeignDefnPragma),
+ add_pragma(ForeignDefnOrigin, ForeignDefnPragma, Context,
+ ItemStatus0, _, !ModuleInfo, !Specs)
+ ;
+ % The error message was printed in pass 2.
+ ( CompilationTarget = target_il
+ ; CompilationTarget = target_java
+ ; CompilationTarget = target_asm
+ ; CompilationTarget = target_x86_64
+ ; CompilationTarget = target_erlang
+ ),
+ true
+ ).
+
+ % Add the access predicates for constant mutables.
+ %
+:- pred add_constant_mutable_access_preds(string::in, module_name::in,
+ string::in, pragma_foreign_proc_attributes::in, mer_inst::in,
+ box_policy::in, prog_context::in, import_status::in, import_status::out,
+ qual_info::in, qual_info::out, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_constant_mutable_access_preds(TargetMutableName, ModuleName, Name,
+ Attrs, Inst, BoxPolicy, Context, !Status, !QualInfo, !ModuleInfo,
+ !Specs) :-
+ varset.new_named_var(varset.init, "X", X, ProgVarSet),
+ InstVarSet = varset.init,
+ set_purity(purity_pure, Attrs, ConstantGetAttrs0),
+ set_thread_safe(proc_thread_safe, ConstantGetAttrs0, ConstantGetAttrs),
+ ConstantGetForeignProc = pragma_foreign_proc(
+ ConstantGetAttrs,
+ mutable_get_pred_sym_name(ModuleName, Name),
+ pf_predicate,
+ [pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
+ ProgVarSet,
+ InstVarSet,
+ fc_impl_ordinary("X = " ++ TargetMutableName ++ ";", yes(Context))
+ ),
+ ConstantGetClause = item_pragma(compiler(mutable_decl),
+ ConstantGetForeignProc),
+ add_item_clause(ConstantGetClause, !Status, Context, !ModuleInfo,
+ !QualInfo, !Specs),
+
+ % NOTE: we don't need to trail the set action, since it is executed
+ % only once at initialization time.
+
+ ConstantSetForeignProc = pragma_foreign_proc(Attrs,
+ mutable_secret_set_pred_sym_name(ModuleName, Name),
+ pf_predicate,
+ [pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
+ ProgVarSet,
+ InstVarSet,
+ fc_impl_ordinary(TargetMutableName ++ " = X;", yes(Context))
+ ),
+ ConstantSetClause = item_pragma(compiler(mutable_decl),
+ ConstantSetForeignProc),
+ add_item_clause(ConstantSetClause, !Status, Context, !ModuleInfo,
+ !QualInfo, !Specs).
+
+ % Add the foreign clauses for the mutable's primitive access and
+ % locking predicates.
+ %
+:- pred add_mutable_primitive_preds(string::in, module_name::in, string::in,
+ mutable_var_attributes::in, pragma_foreign_proc_attributes::in,
+ mer_inst::in, box_policy::in, string::in, prog_context::in,
+ import_status::in, import_status::out, qual_info::in, qual_info::out,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_mutable_primitive_preds(TargetMutableName, ModuleName, Name,
+ MutAttrs, Attrs, Inst, BoxPolicy, TypeName, Context,
+ !Status, !QualInfo, !ModuleInfo, !Specs) :-
+ IsThreadLocal = mutable_var_thread_local(MutAttrs),
+ set_thread_safe(proc_thread_safe, Attrs, LockAndUnlockAttrs),
+
+ % Construct the lock predicate.
+
+ MutableMutexVarName = mutable_mutex_var_name(TargetMutableName),
+ % XXX the second argument should be the name of the mercury predicate,
+ % with chars escaped as appropriate.
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ LockForeignProcBody = string.append_list([
+ "#ifdef MR_THREAD_SAFE\n",
+ " MR_LOCK(&" ++ MutableMutexVarName ++ ",
+ \"" ++ MutableMutexVarName ++ "\");\n" ++
+ "#endif\n"
+ ])
+ ;
+ IsThreadLocal = mutable_thread_local,
+ LockForeignProcBody = ""
+ ),
+ LockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
+ mutable_lock_pred_sym_name(ModuleName, Name),
+ pf_predicate,
+ [],
+ varset.init, % Prog varset.
+ varset.init, % Inst varset.
+ fc_impl_ordinary(LockForeignProcBody, yes(Context))
+ ),
+ LockClause = item_pragma(compiler(mutable_decl), LockForeignProc),
+ add_item_clause(LockClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ % Construct the unlock predicate.
+ % XXX as above regarding the second argument to MR_UNLOCK.
+
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ UnlockForeignProcBody = string.append_list([
+ "#ifdef MR_THREAD_SAFE\n",
+ " MR_UNLOCK(&" ++ MutableMutexVarName ++ ",
+ \"" ++ MutableMutexVarName ++ "\");\n" ++
+ "#endif\n"
+ ])
+ ;
+ IsThreadLocal = mutable_thread_local,
+ UnlockForeignProcBody = ""
+ ),
+ UnlockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
+ mutable_unlock_pred_sym_name(ModuleName, Name),
+ pf_predicate,
+ [],
+ varset.init, % Prog varset.
+ varset.init, % Inst varset.
+ fc_impl_ordinary(UnlockForeignProcBody, yes(Context))
+ ),
+ UnlockClause = item_pragma(compiler(mutable_decl), UnlockForeignProc),
+ add_item_clause(UnlockClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ % Construct the semipure unsafe_get_predicate.
+
+ set_purity(purity_semipure, Attrs, UnsafeGetAttrs0),
+ set_thread_safe(proc_thread_safe, UnsafeGetAttrs0, UnsafeGetAttrs),
+ varset.new_named_var(varset.init, "X", X, ProgVarSet),
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ UnsafeGetCode = "X = " ++ TargetMutableName ++ ";"
+ ;
+ IsThreadLocal = mutable_thread_local,
+ UnsafeGetCode = "MR_get_thread_local_mutable(" ++
+ TypeName ++ ", X, " ++ TargetMutableName ++ ");"
+ ),
+ UnsafeGetForeignProc = pragma_foreign_proc(UnsafeGetAttrs,
+ mutable_unsafe_get_pred_sym_name(ModuleName, Name),
+ pf_predicate,
+ [pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
+ ProgVarSet,
+ varset.init, % Inst varset.
+ fc_impl_ordinary(UnsafeGetCode, yes(Context))
+ ),
+ UnsafeGetClause = item_pragma(compiler(mutable_decl),
+ UnsafeGetForeignProc),
+ add_item_clause(UnsafeGetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ % Construct the impure unsafe_set_predicate.
+
+ set_thread_safe(proc_thread_safe, Attrs, UnsafeSetAttrs),
+ TrailMutableUpdates = mutable_var_trailed(MutAttrs),
+ (
+ TrailMutableUpdates = mutable_untrailed,
+ TrailCode = ""
+ ;
+ TrailMutableUpdates = mutable_trailed,
+
+ % If we require that the mutable to be trailed then we need to be
+ % compiling in a trailing grade.
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, use_trail, UseTrail),
+ (
+ UseTrail = yes,
+ TrailCode = "MR_trail_current_value(&" ++
+ TargetMutableName ++ ");\n"
+ ;
+ UseTrail = no,
+ Pieces =
+ [words("Error: trailed mutable in non-trailing grade."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs],
+
+ % This is just a dummy value.
+ TrailCode = ""
+ )
+ ),
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ SetCode = TargetMutableName ++ "= X;"
+ ;
+ IsThreadLocal = mutable_thread_local,
+ SetCode = "MR_set_thread_local_mutable(" ++
+ TypeName ++ ", X, " ++ TargetMutableName ++ ");"
+ ),
+ UnsafeSetForeignProc = pragma_foreign_proc(UnsafeSetAttrs,
+ mutable_unsafe_set_pred_sym_name(ModuleName, Name),
+ pf_predicate,
+ [pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
+ ProgVarSet,
+ varset.init, % Inst varset.
+ fc_impl_ordinary(TrailCode ++ SetCode, yes(Context))
+ ),
+ UnsafeSetClause = item_pragma(compiler(mutable_decl),
+ UnsafeSetForeignProc),
+ add_item_clause(UnsafeSetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs).
+
+ % Add the access predicates for a non-constant mutable.
+ % If the mutable has the `attach_to_io_state' attribute then add the
+ % versions of the access preds that take the I/O state as well.
+ %
+:- pred add_mutable_user_access_preds(module_name::in, string::in,
+ mutable_var_attributes::in, prog_context::in,
+ import_status::in, import_status::out, qual_info::in, qual_info::out,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_mutable_user_access_preds(ModuleName, Name, MutAttrs, Context,
+ !Status, !QualInfo, !ModuleInfo, !Specs) :-
+ varset.new_named_var(varset.init, "X", X, ProgVarSet0),
+ LockPredName = mutable_lock_pred_sym_name(ModuleName, Name),
+ UnlockPredName = mutable_unlock_pred_sym_name(ModuleName, Name),
+ SetPredName = mutable_set_pred_sym_name(ModuleName, Name),
+ GetPredName = mutable_get_pred_sym_name(ModuleName, Name),
+ CallLock = call_expr(LockPredName, [], purity_impure) - Context,
+ CallUnlock = call_expr(UnlockPredName, [], purity_impure) - Context,
+ %
+ % Construct the semipure get predicate.
+ %
+ UnsafeGetPredName = mutable_unsafe_get_pred_sym_name(ModuleName, Name),
+ UnsafeGetCallArgs = [variable(X, Context)],
+ CallUnsafeGet = call_expr(UnsafeGetPredName, UnsafeGetCallArgs,
+ purity_semipure) - Context,
+
+ GetBody = goal_list_to_conj(Context,
+ [CallLock, CallUnsafeGet, CallUnlock]),
+ StdGetBody = promise_purity_expr(dont_make_implicit_promises,
+ purity_semipure, GetBody) - Context,
+
+ StdGetClause = item_clause(
+ compiler(mutable_decl),
+ ProgVarSet0,
+ pf_predicate,
+ GetPredName,
+ [variable(X, context_init)],
+ StdGetBody
+ ),
+
+ add_item_clause(StdGetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+ %
+ % Construct the impure set predicate.
+ %
+ UnsafeSetPredName = mutable_unsafe_set_pred_sym_name(ModuleName, Name),
+ UnsafeSetCallArgs = [variable(X, context_init)],
+ StdSetCallUnsafeSet = call_expr(UnsafeSetPredName, UnsafeSetCallArgs,
+ purity_impure) - Context,
+
+ StdSetBody = goal_list_to_conj(Context,
+ [CallLock, StdSetCallUnsafeSet, CallUnlock]),
+
+ StdSetClause = item_clause(
+ compiler(mutable_decl),
+ ProgVarSet0,
+ pf_predicate,
+ SetPredName,
+ [variable(X, context_init)],
+ StdSetBody
+ ),
+
+ add_item_clause(StdSetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
+ (
+ IOStateInterface = yes,
+ varset.new_named_var(ProgVarSet0, "IO", IO, ProgVarSet),
+
+ % Construct the pure get predicate.
+ %
+ IOGetBody = promise_purity_expr(dont_make_implicit_promises,
+ purity_pure, GetBody) - Context,
+
+ Ctxt = context_init,
+ IOGetClause = item_clause(
+ compiler(mutable_decl),
+ ProgVarSet,
+ pf_predicate,
+ GetPredName,
+ [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
+ IOGetBody
+ ),
+
+ add_item_clause(IOGetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ % Construct the pure set predicate.
+ %
+ % We just use the body of impure version and attach a promise_pure
+ % pragma to the predicate. (The purity pragma was added during
+ % stage 2.)
+ %
+ IOSetBody = StdSetBody,
+
+ IOSetClause = item_clause(
+ compiler(mutable_decl),
+ ProgVarSet,
+ pf_predicate,
+ SetPredName,
+ [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
+ IOSetBody
+ ),
+
+ add_item_clause(IOSetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ IOStateInterface = no
+ ).
+
+ % Add the code required to initialise a mutable.
+ %
+:- pred add_mutable_initialisation(bool::in, mutable_thread_local::in,
+ string::in, module_name::in, string::in,
+ prog_varset::in, sym_name::in, prog_term::in,
+ pragma_foreign_proc_attributes::in, import_status::in, import_status::out,
+ prog_context::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
+ ModuleName, Name, MutVarset, InitSetPredName, InitTerm, Attrs, !Status,
+ Context, !ModuleInfo, !QualInfo, !Specs) :-
+ %
+ % Add the `:- initialise' declaration and clause for the
+ % mutable initialise predicate.
+ %
+ add_item_clause(item_initialise(compiler(mutable_decl),
+ mutable_init_pred_sym_name(ModuleName, Name), 0 /* Arity */),
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs),
+ (
+ IsConstant = yes,
+ %
+ % See the comments for prog_io.parse_mutable_decl for the reason
+ % why we _must_ use MutVarset here.
+ %
+ InitClause = item_clause(compiler(mutable_decl),
+ MutVarset,
+ pf_predicate,
+ mutable_init_pred_sym_name(ModuleName, Name), [],
+ call_expr(InitSetPredName, [InitTerm], purity_impure)
+ - Context)
+ ;
+ IsConstant = no,
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ % Construct the clause for the mutex initialisation predicate.
+ PreInitCode = string.append_list([
+ "#ifdef MR_THREAD_SAFE\n",
+ " pthread_mutex_init(&",
+ mutable_mutex_var_name(TargetMutableName),
+ ", MR_MUTEX_ATTR);\n",
+ "#endif\n"
+ ])
+ ;
+ IsThreadLocal = mutable_thread_local,
+ PreInitCode = string.append_list([
+ TargetMutableName,
+ " = MR_new_thread_local_mutable_index();\n"
+ ])
+ ),
+ PreInitPredName = mutable_pre_init_pred_sym_name(ModuleName, Name),
+ PreInitForeignProc = pragma_foreign_proc(Attrs,
+ PreInitPredName,
+ pf_predicate,
+ [],
+ varset.init, % ProgVarSet
+ varset.init, % InstVarSet
+ fc_impl_ordinary(PreInitCode, yes(Context))
+ ),
+ PreInitClause = item_pragma(compiler(mutable_decl),
+ PreInitForeignProc),
+ add_item_clause(PreInitClause, !Status, Context, !ModuleInfo,
+ !QualInfo, !Specs),
+
+ CallPreInitExpr =
+ call_expr(PreInitPredName, [], purity_impure) - Context,
+ CallSetPredExpr =
+ call_expr(InitSetPredName, [InitTerm], purity_impure)
+ - Context,
+ InitClauseExpr = conj_expr(CallPreInitExpr, CallSetPredExpr)
+ - Context,
+ %
+ % See the comments for prog_io.parse_mutable_decl for the reason
+ % why we _must_ use MutVarset here.
+ %
+ InitClause = item_clause(compiler(mutable_decl),
+ MutVarset,
+ pf_predicate,
+ mutable_init_pred_sym_name(ModuleName, Name),
+ [],
+ InitClauseExpr
+ )
+ ),
+ add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs).
+
+ % Create the foreign_decl for the mutable.
+ % The bool argument says whether the mutable is a constant mutable
+ % or not.
+ %
+:- pred get_mutable_global_foreign_decl_defn(module_info::in, mer_type::in,
+ string::in, bool::in, mutable_thread_local::in, item::out(item_pragma),
+ item::out(item_pragma)) is det.
+
+get_mutable_global_foreign_decl_defn(ModuleInfo, Type, TargetMutableName,
+ IsConstant, IsThreadLocal, Decl, Defn) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
+ globals.get_target(Globals, Backend),
+ (
+ Backend = target_c,
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
+ ModuleInfo, Type)
+ ;
+ IsThreadLocal = mutable_thread_local,
+ %
+ % For thread-local mutables, the variable holds an index into an
+ % array.
+ %
+ TypeName = "MR_Unsigned"
+ ),
+ %
+ % Constant mutables do not require mutexes as their values are never
+ % updated. Thread-local mutables do not require mutexes either.
+ %
+ (
+ ( IsConstant = yes
+ ; IsThreadLocal = mutable_thread_local
+ )
+ ->
+ LockDecl = [],
+ LockDefn = []
+ ;
+ LockDecl = [
+ "#ifdef MR_THREAD_SAFE\n",
+ " extern MercuryLock ",
+ mutable_mutex_var_name(TargetMutableName), ";\n",
+ "#endif\n"
+ ],
+ LockDefn = [
+ "#ifdef MR_THREAD_SAFE\n",
+ " MercuryLock ",
+ mutable_mutex_var_name(TargetMutableName), ";\n",
+ "#endif\n"
+ ]
+ ),
+
+ DeclBody = string.append_list([
+ "extern ", TypeName, " ", TargetMutableName, ";\n" | LockDecl]),
+ Decl = item_pragma(compiler(mutable_decl),
+ pragma_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody)),
+
+ DefnBody = string.append_list([
+ TypeName, " ", TargetMutableName, ";\n" | LockDefn]),
+ Defn = item_pragma(compiler(mutable_decl),
+ pragma_foreign_code(lang_c, DefnBody))
+ ;
+ ( Backend = target_il
+ ; Backend = target_java
+ ; Backend = target_asm
+ ; Backend = target_x86_64
+ ; Backend = target_erlang
+ ),
+ sorry(this_file, "we don't yet support mutables for non-C backends")
+ ).
+
+:- func global_foreign_type_name(bool, foreign_language, module_info, mer_type)
+ = string.
+
+global_foreign_type_name(yes, _, _, _) = "MR_Word".
+global_foreign_type_name(no, Lang, ModuleInfo, Type) =
+ to_type_string(Lang, ModuleInfo, Type).
+
+ % 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(module_info::in, bool::in,
+ prog_context::in, module_name::in, string::in, list(foreign_name)::in,
+ string::out, list(error_spec)::in, list(error_spec)::out) is det.
+
+get_global_name_from_foreign_names(ModuleInfo, ReportErrors, Context,
+ ModuleName, MercuryMutableName, ForeignNames, TargetMutableName,
+ !Specs) :-
+ solutions(get_matching_foreign_name(ForeignNames, lang_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 = [_, _ | _],
+ (
+ ReportErrors = yes,
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.get_target(Globals, CompilationTarget),
+ Pieces = [words("Error: multiple foreign_name attributes"),
+ words("specified for the"),
+ fixed(compilation_target_string(CompilationTarget)),
+ words("backend."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ ReportErrors = no
+ ),
+ 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, _).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "add_mutable.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module add_mutable.
+%-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.528
diff -u -r1.528 make_hlds.m
--- compiler/make_hlds.m 4 Mar 2007 23:37:57 -0000 1.528
+++ compiler/make_hlds.m 28 May 2007 06:56:02 -0000
@@ -117,6 +117,7 @@
:- include_module add_class.
:- include_module add_clause.
:- include_module add_mode.
+:- include_module add_mutable.
:- include_module add_pragma.
:- include_module add_pred.
:- include_module add_solver.
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.67
diff -u -r1.67 make_hlds_passes.m
--- compiler/make_hlds_passes.m 7 May 2007 05:21:31 -0000 1.67
+++ compiler/make_hlds_passes.m 28 May 2007 06:56:02 -0000
@@ -103,6 +103,7 @@
:- import_module hlds.make_hlds.add_class.
:- import_module hlds.make_hlds.add_clause.
:- import_module hlds.make_hlds.add_mode.
+:- import_module hlds.make_hlds.add_mutable.
:- import_module hlds.make_hlds.add_pragma.
:- import_module hlds.make_hlds.add_pred.
:- import_module hlds.make_hlds.add_solver.
@@ -453,87 +454,8 @@
add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !Specs) :-
% We add the initialise decl and the foreign_decl on the second pass and
% the foreign_proc clauses on the third pass.
- Item = item_mutable(Name, Type, _InitValue, Inst, MutAttrs, _MutVarset),
- !.Status = item_status(ImportStatus, _),
- DefinedThisModule = status_defined_in_this_module(ImportStatus),
- (
- DefinedThisModule = yes,
- module_info_get_name(!.ModuleInfo, ModuleName),
- %
- % Create the initialisation predicate and the mutex initialisation
- % predicate. The latter is called by the former.
- %
- InitPredDecl = mutable_init_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
- !Specs),
- IsConstant = mutable_var_constant(MutAttrs),
- (
- IsConstant = no,
-
- % Create the pre-initialisation predicate. This is called
- % by the mutable initialisation predicate.
- PreInitPredDecl = mutable_pre_init_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(PreInitPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
-
- % Create the primitive access and locking predicates.
- LockPredDecl = lock_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(LockPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnlockPredDecl = unlock_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(UnlockPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnsafeGetPredDecl = unsafe_get_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(UnsafeGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnsafeSetPredDecl = unsafe_set_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(UnsafeSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
-
- % Create the standard, non-pure access predicates. These are
- % always created for non-constant mutables, even if the
- % `attach_to_io_state' attribute has been specified.
- StdGetPredDecl = std_get_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(StdGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- StdSetPredDecl = std_set_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(StdSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
-
- % If requested, create the pure access predicates using
- % the I/O state as well.
- CreateIOInterface = mutable_var_attach_to_io_state(MutAttrs),
- (
- CreateIOInterface = yes,
- IOGetPredDecl = io_get_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(IOGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- IOSetPredDecl = io_set_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(IOSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs)
- ;
- CreateIOInterface = no
- )
- ;
- IsConstant = yes,
-
- % We create the "get" access predicate, which is pure since
- % it always returns the same value, but we must also create
- % a secret "set" predicate for use by the initialization code.
- ConstantGetPredDecl = constant_get_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(ConstantGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- ConstantSetPredDecl = constant_set_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(ConstantSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs)
- )
- ;
- DefinedThisModule = no
- ).
+ Item = item_mutable(_, _, _, _, _, _),
+ add_mutable_pass_1(Item, Context, !Status, !ModuleInfo, !Specs).
:- pred add_solver_type_mutable_items_pass_1(list(item)::in, prog_context::in,
item_status::in, item_status::out, module_info::in, module_info::out,
@@ -691,101 +613,8 @@
true
).
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
- Item = item_mutable(Name, _Type, _InitTerm, Inst, MutAttrs, _MutVarset),
- !.Status = item_status(ImportStatus, _),
- ( ImportStatus = status_exported ->
- error_is_exported(Context, "`mutable' declaration", !Specs)
- ;
- true
- ),
- %
- % We don't implement the `mutable' declaration unless it is defined in
- % this module. Not having this check means that we might end up up
- % duplicating the definition of the global variable in any submodules.
- %
- DefinedThisModule = status_defined_in_this_module(ImportStatus),
- (
- DefinedThisModule = yes,
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.get_target(Globals, CompilationTarget),
-
- % XXX We don't currently support the foreign_name attribute
- % for languages other than C.
- (
- CompilationTarget = target_c,
- mutable_var_maybe_foreign_names(MutAttrs) = MaybeForeignNames,
- module_info_get_name(!.ModuleInfo, ModuleName),
- (
- MaybeForeignNames = no
- ;
- MaybeForeignNames = yes(ForeignNames),
-
- % Report any errors with the foreign_name attributes
- % during this pass.
- ReportErrors = yes,
- get_global_name_from_foreign_names(!.ModuleInfo, ReportErrors,
- Context, ModuleName, Name, ForeignNames,
- _TargetMutableName, !Specs)
- ),
-
- % If we are creating the I/O version of the set predicate then we
- % need to add a promise_pure pragma for it. This needs to be done
- % here (in stage 2) rather than in stage 3 where the rest of the
- % mutable transformation is.
-
- IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
- (
- IOStateInterface = yes,
- SetPredName = mutable_set_pred_sym_name(ModuleName, Name),
- IOSetPromisePurePragma = pragma_promise_pure(SetPredName, 3),
- add_pragma(compiler(mutable_decl), IOSetPromisePurePragma,
- Context, !Status, !ModuleInfo, !Specs)
- ;
- IOStateInterface = no
- )
- ;
- ( CompilationTarget = target_il
- ; CompilationTarget = target_java
- ; CompilationTarget = target_asm
- ; CompilationTarget = target_x86_64
- ; CompilationTarget = target_erlang
- ),
- Pieces = [words("Error: foreign_name mutable attribute not yet"),
- words("implemented for the"),
- fixed(compilation_target_string(CompilationTarget)),
- words("backend."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- ),
- %
- % Check that the inst in the mutable declaration is a valid inst for a
- % mutable declaration.
- %
- ( is_valid_mutable_inst(!.ModuleInfo, Inst) ->
- true
- ;
- % It is okay to pass a dummy varset in here since any attempt
- % to use inst variables in a mutable declaration should already
- % been dealt with when the mutable declaration was parsed.
- DummyInstVarset = varset.init,
- InstStr = mercury_expanded_inst_to_string(Inst, DummyInstVarset,
- !.ModuleInfo),
- InvalidInstPieces = [
- words("Error: the inst"),
- quote(InstStr),
- words("is not a valid inst for a mutable declaration.")
- ],
- % XXX we could provide more information about exactly *why* the
- % inst was not valid here as well.
- InvalidInstMsg = simple_msg(Context, [always(InvalidInstPieces)]),
- InvalidInstSpec = error_spec(severity_error,
- phase_parse_tree_to_hlds, [InvalidInstMsg]),
- !:Specs = [ InvalidInstSpec | !.Specs ]
- )
- ;
- DefinedThisModule = no
- ).
+ Item = item_mutable(_, _, _, _, _, _),
+ add_mutable_pass_2(Item, Context, !Status, !ModuleInfo, !Specs).
:- pred add_solver_type_mutable_items_pass_2(list(item)::in, prog_context::in,
item_status::in, item_status::out, module_info::in, module_info::out,
@@ -799,53 +628,6 @@
add_solver_type_mutable_items_pass_2(Items, Context, !Status,
!ModuleInfo, !Specs).
- % 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(module_info::in, bool::in,
- prog_context::in, module_name::in, string::in, list(foreign_name)::in,
- string::out, list(error_spec)::in, list(error_spec)::out) is det.
-
-get_global_name_from_foreign_names(ModuleInfo, ReportErrors, Context,
- ModuleName, MercuryMutableName, ForeignNames, TargetMutableName,
- !Specs) :-
- solutions(get_matching_foreign_name(ForeignNames, lang_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 = [_, _ | _],
- (
- ReportErrors = yes,
- module_info_get_globals(ModuleInfo, Globals),
- globals.get_target(Globals, CompilationTarget),
- Pieces = [words("Error: multiple foreign_name attributes"),
- words("specified for the"),
- fixed(compilation_target_string(CompilationTarget)),
- words("backend."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- ;
- ReportErrors = no
- ),
- 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, !Specs) :-
@@ -1293,600 +1075,9 @@
!:Specs = [Spec | !.Specs]
).
add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_mutable(MercuryMutableName, Type, InitTerm, Inst,
- MutAttrs, MutVarset),
-
- % The transformation here is documented in the comments at the
- % beginning of prog_mutable.m.
-
- DefinedThisModule = status_defined_in_this_module(!.Status),
- (
- DefinedThisModule = yes,
- module_info_get_name(!.ModuleInfo, ModuleName),
- IsConstant = mutable_var_constant(MutAttrs),
- IsThreadLocal = mutable_var_thread_local(MutAttrs),
-
- % Work out what name to give the global in the target language.
- decide_mutable_target_var_name(!.ModuleInfo, MutAttrs, ModuleName,
- MercuryMutableName, Context, TargetMutableName, !Specs),
-
- % Add foreign_decl and foreign_code items that declare/define the
- % global variable used to implement the mutable. If the mutable is
- % not constant then add a mutex to synchronize access to it as well.
- add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant,
- IsThreadLocal, Context, !QualInfo, !ModuleInfo, !Specs),
-
- % Set up the default attributes for the foreign_procs used for the
- % access predicates.
- % XXX Handle target languages other than C here.
- Attrs0 = default_attributes(lang_c),
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
- (
- AlwaysBoxed = yes,
- BoxPolicy = always_boxed
- ;
- AlwaysBoxed = no,
- BoxPolicy = native_if_possible
- ),
- set_box_policy(BoxPolicy, Attrs0, Attrs1),
- set_may_call_mercury(proc_will_not_call_mercury, Attrs1, Attrs),
-
- (
- IsConstant = yes,
- InitSetPredName = mutable_secret_set_pred_sym_name(ModuleName,
- MercuryMutableName),
- add_constant_mutable_access_preds(TargetMutableName,
- ModuleName, MercuryMutableName, Attrs, Inst, BoxPolicy,
- Context, !Status, !QualInfo, !ModuleInfo, !Specs)
- ;
- IsConstant = no,
- InitSetPredName = mutable_set_pred_sym_name(ModuleName,
- MercuryMutableName),
- TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
- !.ModuleInfo, Type),
- add_mutable_primitive_preds(TargetMutableName, ModuleName,
- MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
- Context, !Status, !QualInfo, !ModuleInfo, !Specs),
- add_mutable_user_access_preds(ModuleName, MercuryMutableName,
- MutAttrs, Context, !Status, !QualInfo, !ModuleInfo, !Specs)
- ),
- add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
- ModuleName, MercuryMutableName, MutVarset, InitSetPredName, InitTerm,
- Attrs, !Status, Context, !ModuleInfo, !QualInfo, !Specs)
- ;
- DefinedThisModule = no
- ).
-
- % Decide what the name of the underlying global used to implement the
- % mutable should be. If there is a foreign_name attribute then use that
- % otherwise construct one based on the Mercury name for the mutable
- %
-:- pred decide_mutable_target_var_name(module_info::in,
- mutable_var_attributes::in, module_name::in, string::in, prog_context::in,
- string::out, list(error_spec)::in, list(error_spec)::out) is det.
-
-decide_mutable_target_var_name(ModuleInfo, MutAttrs, ModuleName, Name, Context,
- TargetMutableName, !Specs) :-
- 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(ModuleInfo, ReportErrors, Context,
- ModuleName, Name, ForeignNames, TargetMutableName, !Specs)
- ).
-
- % Add the foreign_decl and foreign_code items that declare/define
- % the global variable used to hold the mutable.
- %
-:- pred add_mutable_defn_and_decl(string::in, mer_type::in, bool::in,
- mutable_thread_local::in, prog_context::in, qual_info::in, qual_info::out,
- module_info::in, module_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant, IsThreadLocal,
- Context, !QualInfo, !ModuleInfo, !Specs) :-
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.get_target(Globals, CompilationTarget),
-
- % We add the foreign code declaration and definition here rather than
- % in pass 2 because the target-language-specific type name depends on
- % whether there are any foreign_type declarations for Type.
- (
- CompilationTarget = target_c,
- get_mutable_global_foreign_decl_defn(!.ModuleInfo, Type,
- TargetMutableName, IsConstant, IsThreadLocal,
- ForeignDecl, ForeignDefn),
- ItemStatus0 = item_status(status_local, may_be_unqualified),
- add_item_decl_pass_2(ForeignDecl, Context, ItemStatus0, _,
- !ModuleInfo, !Specs),
- add_item_decl_pass_2(ForeignDefn, Context, ItemStatus0, _,
- !ModuleInfo, !Specs)
- ;
- % The error message was printed in pass 2.
- ( CompilationTarget = target_il
- ; CompilationTarget = target_java
- ; CompilationTarget = target_asm
- ; CompilationTarget = target_x86_64
- ; CompilationTarget = target_erlang
- ),
- true
- ).
-
- % Add the access predicates for constant mutables.
- %
-:- pred add_constant_mutable_access_preds(string::in, module_name::in,
- string::in, pragma_foreign_proc_attributes::in, mer_inst::in,
- box_policy::in, prog_context::in, import_status::in, import_status::out,
- qual_info::in, qual_info::out, module_info::in, module_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-add_constant_mutable_access_preds(TargetMutableName, ModuleName, Name,
- Attrs, Inst, BoxPolicy, Context, !Status, !QualInfo, !ModuleInfo,
- !Specs) :-
- varset.new_named_var(varset.init, "X", X, ProgVarSet),
- InstVarSet = varset.init,
- set_purity(purity_pure, Attrs, ConstantGetAttrs0),
- set_thread_safe(proc_thread_safe, ConstantGetAttrs0, ConstantGetAttrs),
- ConstantGetForeignProc = pragma_foreign_proc(
- ConstantGetAttrs,
- mutable_get_pred_sym_name(ModuleName, Name),
- pf_predicate,
- [pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
- ProgVarSet,
- InstVarSet,
- fc_impl_ordinary("X = " ++ TargetMutableName ++ ";", yes(Context))
- ),
- ConstantGetClause = item_pragma(compiler(mutable_decl),
- ConstantGetForeignProc),
- add_item_clause(ConstantGetClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs),
-
- % NOTE: we don't need to trail the set action, since it is executed
- % only once at initialization time.
-
- ConstantSetForeignProc = pragma_foreign_proc(Attrs,
- mutable_secret_set_pred_sym_name(ModuleName, Name),
- pf_predicate,
- [pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
- ProgVarSet,
- InstVarSet,
- fc_impl_ordinary(TargetMutableName ++ " = X;", yes(Context))
- ),
- ConstantSetClause = item_pragma(compiler(mutable_decl),
- ConstantSetForeignProc),
- add_item_clause(ConstantSetClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs).
-
- % Add the foreign clauses for the mutable's primitive access and
- % locking predicates.
- %
-:- pred add_mutable_primitive_preds(string::in, module_name::in, string::in,
- mutable_var_attributes::in, pragma_foreign_proc_attributes::in,
- mer_inst::in, box_policy::in, string::in, prog_context::in,
- import_status::in, import_status::out, qual_info::in, qual_info::out,
- module_info::in, module_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-add_mutable_primitive_preds(TargetMutableName, ModuleName, Name,
- MutAttrs, Attrs, Inst, BoxPolicy, TypeName, Context,
- !Status, !QualInfo, !ModuleInfo, !Specs) :-
- IsThreadLocal = mutable_var_thread_local(MutAttrs),
- set_thread_safe(proc_thread_safe, Attrs, LockAndUnlockAttrs),
-
- % Construct the lock predicate.
-
- MutableMutexVarName = mutable_mutex_var_name(TargetMutableName),
- % XXX the second argument should be the name of the mercury predicate,
- % with chars escaped as appropriate.
- (
- IsThreadLocal = mutable_not_thread_local,
- LockForeignProcBody = string.append_list([
- "#ifdef MR_THREAD_SAFE\n",
- " MR_LOCK(&" ++ MutableMutexVarName ++ ",
- \"" ++ MutableMutexVarName ++ "\");\n" ++
- "#endif\n"
- ])
- ;
- IsThreadLocal = mutable_thread_local,
- LockForeignProcBody = ""
- ),
- LockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
- mutable_lock_pred_sym_name(ModuleName, Name),
- pf_predicate,
- [],
- varset.init, % Prog varset.
- varset.init, % Inst varset.
- fc_impl_ordinary(LockForeignProcBody, yes(Context))
- ),
- LockClause = item_pragma(compiler(mutable_decl), LockForeignProc),
- add_item_clause(LockClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
-
- % Construct the unlock predicate.
- % XXX as above regarding the second argument to MR_UNLOCK.
-
- (
- IsThreadLocal = mutable_not_thread_local,
- UnlockForeignProcBody = string.append_list([
- "#ifdef MR_THREAD_SAFE\n",
- " MR_UNLOCK(&" ++ MutableMutexVarName ++ ",
- \"" ++ MutableMutexVarName ++ "\");\n" ++
- "#endif\n"
- ])
- ;
- IsThreadLocal = mutable_thread_local,
- UnlockForeignProcBody = ""
- ),
- UnlockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
- mutable_unlock_pred_sym_name(ModuleName, Name),
- pf_predicate,
- [],
- varset.init, % Prog varset.
- varset.init, % Inst varset.
- fc_impl_ordinary(UnlockForeignProcBody, yes(Context))
- ),
- UnlockClause = item_pragma(compiler(mutable_decl), UnlockForeignProc),
- add_item_clause(UnlockClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
-
- % Construct the semipure unsafe_get_predicate.
-
- set_purity(purity_semipure, Attrs, UnsafeGetAttrs0),
- set_thread_safe(proc_thread_safe, UnsafeGetAttrs0, UnsafeGetAttrs),
- varset.new_named_var(varset.init, "X", X, ProgVarSet),
- (
- IsThreadLocal = mutable_not_thread_local,
- UnsafeGetCode = "X = " ++ TargetMutableName ++ ";"
- ;
- IsThreadLocal = mutable_thread_local,
- UnsafeGetCode = "MR_get_thread_local_mutable(" ++
- TypeName ++ ", X, " ++ TargetMutableName ++ ");"
- ),
- UnsafeGetForeignProc = pragma_foreign_proc(UnsafeGetAttrs,
- mutable_unsafe_get_pred_sym_name(ModuleName, Name),
- pf_predicate,
- [pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
- ProgVarSet,
- varset.init, % Inst varset.
- fc_impl_ordinary(UnsafeGetCode, yes(Context))
- ),
- UnsafeGetClause = item_pragma(compiler(mutable_decl),
- UnsafeGetForeignProc),
- add_item_clause(UnsafeGetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
-
- % Construct the impure unsafe_set_predicate.
-
- set_thread_safe(proc_thread_safe, Attrs, UnsafeSetAttrs),
- TrailMutableUpdates = mutable_var_trailed(MutAttrs),
- (
- TrailMutableUpdates = mutable_untrailed,
- TrailCode = ""
- ;
- TrailMutableUpdates = mutable_trailed,
-
- % If we require that the mutable to be trailed then we need to be
- % compiling in a trailing grade.
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, use_trail, UseTrail),
- (
- UseTrail = yes,
- TrailCode = "MR_trail_current_value(&" ++
- TargetMutableName ++ ");\n"
- ;
- UseTrail = no,
- Pieces =
- [words("Error: trailed mutable in non-trailing grade."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs],
-
- % This is just a dummy value.
- TrailCode = ""
- )
- ),
- (
- IsThreadLocal = mutable_not_thread_local,
- SetCode = TargetMutableName ++ "= X;"
- ;
- IsThreadLocal = mutable_thread_local,
- SetCode = "MR_set_thread_local_mutable(" ++
- TypeName ++ ", X, " ++ TargetMutableName ++ ");"
- ),
- UnsafeSetForeignProc = pragma_foreign_proc(UnsafeSetAttrs,
- mutable_unsafe_set_pred_sym_name(ModuleName, Name),
- pf_predicate,
- [pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
- ProgVarSet,
- varset.init, % Inst varset.
- fc_impl_ordinary(TrailCode ++ SetCode, yes(Context))
- ),
- UnsafeSetClause = item_pragma(compiler(mutable_decl),
- UnsafeSetForeignProc),
- add_item_clause(UnsafeSetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs).
-
- % Add the access predicates for a non-constant mutable.
- % If the mutable has the `attach_to_io_state' attribute then add the
- % versions of the access preds that take the I/O state as well.
- %
-:- pred add_mutable_user_access_preds(module_name::in, string::in,
- mutable_var_attributes::in, prog_context::in,
- import_status::in, import_status::out, qual_info::in, qual_info::out,
- module_info::in, module_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-add_mutable_user_access_preds(ModuleName, Name, MutAttrs, Context,
- !Status, !QualInfo, !ModuleInfo, !Specs) :-
- varset.new_named_var(varset.init, "X", X, ProgVarSet0),
- LockPredName = mutable_lock_pred_sym_name(ModuleName, Name),
- UnlockPredName = mutable_unlock_pred_sym_name(ModuleName, Name),
- SetPredName = mutable_set_pred_sym_name(ModuleName, Name),
- GetPredName = mutable_get_pred_sym_name(ModuleName, Name),
- CallLock = call_expr(LockPredName, [], purity_impure) - Context,
- CallUnlock = call_expr(UnlockPredName, [], purity_impure) - Context,
- %
- % Construct the semipure get predicate.
- %
- UnsafeGetPredName = mutable_unsafe_get_pred_sym_name(ModuleName, Name),
- UnsafeGetCallArgs = [variable(X, Context)],
- CallUnsafeGet = call_expr(UnsafeGetPredName, UnsafeGetCallArgs,
- purity_semipure) - Context,
-
- GetBody = goal_list_to_conj(Context,
- [CallLock, CallUnsafeGet, CallUnlock]),
- StdGetBody = promise_purity_expr(dont_make_implicit_promises,
- purity_semipure, GetBody) - Context,
-
- StdGetClause = item_clause(
- compiler(mutable_decl),
- ProgVarSet0,
- pf_predicate,
- GetPredName,
- [variable(X, context_init)],
- StdGetBody
- ),
-
- add_item_clause(StdGetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
- %
- % Construct the impure set predicate.
- %
- UnsafeSetPredName = mutable_unsafe_set_pred_sym_name(ModuleName, Name),
- UnsafeSetCallArgs = [variable(X, context_init)],
- StdSetCallUnsafeSet = call_expr(UnsafeSetPredName, UnsafeSetCallArgs,
- purity_impure) - Context,
-
- StdSetBody = goal_list_to_conj(Context,
- [CallLock, StdSetCallUnsafeSet, CallUnlock]),
-
- StdSetClause = item_clause(
- compiler(mutable_decl),
- ProgVarSet0,
- pf_predicate,
- SetPredName,
- [variable(X, context_init)],
- StdSetBody
- ),
-
- add_item_clause(StdSetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
-
- IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
- (
- IOStateInterface = yes,
- varset.new_named_var(ProgVarSet0, "IO", IO, ProgVarSet),
-
- % Construct the pure get predicate.
- %
- IOGetBody = promise_purity_expr(dont_make_implicit_promises,
- purity_pure, GetBody) - Context,
-
- Ctxt = context_init,
- IOGetClause = item_clause(
- compiler(mutable_decl),
- ProgVarSet,
- pf_predicate,
- GetPredName,
- [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
- IOGetBody
- ),
-
- add_item_clause(IOGetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
-
- % Construct the pure set predicate.
- %
- % We just use the body of impure version and attach a promise_pure
- % pragma to the predicate. (The purity pragma was added during
- % stage 2.)
- %
- IOSetBody = StdSetBody,
-
- IOSetClause = item_clause(
- compiler(mutable_decl),
- ProgVarSet,
- pf_predicate,
- SetPredName,
- [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
- IOSetBody
- ),
-
- add_item_clause(IOSetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs)
- ;
- IOStateInterface = no
- ).
-
- % Add the code required to initialise a mutable.
- %
-:- pred add_mutable_initialisation(bool::in, mutable_thread_local::in,
- string::in, module_name::in, string::in,
- prog_varset::in, sym_name::in, prog_term::in,
- pragma_foreign_proc_attributes::in, import_status::in, import_status::out,
- prog_context::in, module_info::in, module_info::out,
- qual_info::in, qual_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
- ModuleName, Name, MutVarset, InitSetPredName, InitTerm, Attrs, !Status,
- Context, !ModuleInfo, !QualInfo, !Specs) :-
- %
- % Add the `:- initialise' declaration and clause for the
- % mutable initialise predicate.
- %
- add_item_clause(item_initialise(compiler(mutable_decl),
- mutable_init_pred_sym_name(ModuleName, Name), 0 /* Arity */),
- !Status, Context, !ModuleInfo, !QualInfo, !Specs),
- (
- IsConstant = yes,
- %
- % See the comments for prog_io.parse_mutable_decl for the reason
- % why we _must_ use MutVarset here.
- %
- InitClause = item_clause(compiler(mutable_decl),
- MutVarset,
- pf_predicate,
- mutable_init_pred_sym_name(ModuleName, Name), [],
- call_expr(InitSetPredName, [InitTerm], purity_impure)
- - Context)
- ;
- IsConstant = no,
- (
- IsThreadLocal = mutable_not_thread_local,
- % Construct the clause for the mutex initialisation predicate.
- PreInitCode = string.append_list([
- "#ifdef MR_THREAD_SAFE\n",
- " pthread_mutex_init(&",
- mutable_mutex_var_name(TargetMutableName),
- ", MR_MUTEX_ATTR);\n",
- "#endif\n"
- ])
- ;
- IsThreadLocal = mutable_thread_local,
- PreInitCode = string.append_list([
- TargetMutableName,
- " = MR_new_thread_local_mutable_index();\n"
- ])
- ),
- PreInitPredName = mutable_pre_init_pred_sym_name(ModuleName, Name),
- PreInitForeignProc = pragma_foreign_proc(Attrs,
- PreInitPredName,
- pf_predicate,
- [],
- varset.init, % ProgVarSet
- varset.init, % InstVarSet
- fc_impl_ordinary(PreInitCode, yes(Context))
- ),
- PreInitClause = item_pragma(compiler(mutable_decl),
- PreInitForeignProc),
- add_item_clause(PreInitClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs),
-
- CallPreInitExpr =
- call_expr(PreInitPredName, [], purity_impure) - Context,
- CallSetPredExpr =
- call_expr(InitSetPredName, [InitTerm], purity_impure)
- - Context,
- InitClauseExpr = conj_expr(CallPreInitExpr, CallSetPredExpr)
- - Context,
- %
- % See the comments for prog_io.parse_mutable_decl for the reason
- % why we _must_ use MutVarset here.
- %
- InitClause = item_clause(compiler(mutable_decl),
- MutVarset,
- pf_predicate,
- mutable_init_pred_sym_name(ModuleName, Name),
- [],
- InitClauseExpr
- )
- ),
- add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
+ Item = item_mutable(_, _, _, _, _, _),
+ add_mutable_clauses(Item, !Status, Context, !ModuleInfo, !QualInfo,
!Specs).
-
- % Create the foreign_decl for the mutable.
- % The bool argument says whether the mutable is a constant mutable
- % or not.
- %
-:- pred get_mutable_global_foreign_decl_defn(module_info::in, mer_type::in,
- string::in, bool::in, mutable_thread_local::in, item::out, item::out)
- is det.
-
-get_mutable_global_foreign_decl_defn(ModuleInfo, Type, TargetMutableName,
- IsConstant, IsThreadLocal, Decl, Defn) :-
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
- globals.get_target(Globals, Backend),
- (
- Backend = target_c,
- (
- IsThreadLocal = mutable_not_thread_local,
- TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
- ModuleInfo, Type)
- ;
- IsThreadLocal = mutable_thread_local,
- %
- % For thread-local mutables, the variable holds an index into an
- % array.
- %
- TypeName = "MR_Unsigned"
- ),
- %
- % Constant mutables do not require mutexes as their values are never
- % updated. Thread-local mutables do not require mutexes either.
- %
- (
- ( IsConstant = yes
- ; IsThreadLocal = mutable_thread_local
- )
- ->
- LockDecl = [],
- LockDefn = []
- ;
- LockDecl = [
- "#ifdef MR_THREAD_SAFE\n",
- " extern MercuryLock ",
- mutable_mutex_var_name(TargetMutableName), ";\n",
- "#endif\n"
- ],
- LockDefn = [
- "#ifdef MR_THREAD_SAFE\n",
- " MercuryLock ",
- mutable_mutex_var_name(TargetMutableName), ";\n",
- "#endif\n"
- ]
- ),
-
- DeclBody = string.append_list([
- "extern ", TypeName, " ", TargetMutableName, ";\n" | LockDecl]),
- Decl = item_pragma(compiler(mutable_decl),
- pragma_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody)),
-
- DefnBody = string.append_list([
- TypeName, " ", TargetMutableName, ";\n" | LockDefn]),
- Defn = item_pragma(compiler(mutable_decl),
- pragma_foreign_code(lang_c, DefnBody))
- ;
- ( Backend = target_il
- ; Backend = target_java
- ; Backend = target_asm
- ; Backend = target_x86_64
- ; Backend = target_erlang
- ),
- sorry(this_file, "we don't yet support mutables for non-C backends")
- ).
-
-:- func global_foreign_type_name(bool, foreign_language, module_info, mer_type)
- = string.
-
-global_foreign_type_name(yes, _, _, _) = "MR_Word".
-global_foreign_type_name(no, Lang, ModuleInfo, Type) =
- to_type_string(Lang, ModuleInfo, Type).
:- pred add_solver_type_mutable_items_clauses(list(item)::in,
import_status::in, import_status::out, prog_context::in,
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.26
diff -u -r1.26 prog_item.m
--- compiler/prog_item.m 4 Mar 2007 23:38:06 -0000 1.26
+++ compiler/prog_item.m 28 May 2007 06:56:02 -0000
@@ -239,6 +239,9 @@
nothing_maybe_warning :: maybe(item_warning)
).
+:- inst item_pragma
+ ---> item_pragma(ground, ground).
+
:- type item_warning
---> item_warning(
maybe(option), % Option controlling whether the
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.129
diff -u -r1.129 compiler_design.html
--- compiler/notes/compiler_design.html 28 May 2007 03:13:53 -0000 1.129
+++ compiler/notes/compiler_design.html 28 May 2007 06:56:02 -0000
@@ -461,6 +461,11 @@
Adds most kinds of pragmas to the HLDS,
including import/export pragmas, tabling pragmas and foreign code.
+<dt>
+add_mutable.m
+<dd>
+Handles mutable declarations.
+
</dl>
Fact table pragmas are handled by fact_table.m
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list