mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
9d38b252bf
compiler/prog_item.m:
Previously, both decl and impl pragmas contained some pragma kinds
that contained only the specification of a predicate or function.
These served only to specify a marker to be applied to the named
predicate or function.
This diff separates out those kinds of pragmas from the types of
both the decl pragmas and the impl pragmas (the difference is that
decl pragmas may appear in module interfaces, while impl pragmas may not),
and gives them two new representations: decl markers and impl markers.
While in the old representation, each kind of marker had its own wrapper
around the predicate/function specification, in the new representation,
they are side-by-side, which allows simpler construction techniques
and smaller code.
Update the definition of parse_tree_module_src, parse_tree_plain_opt,
parse_tree_int0 and parse_tree_int1 to include markers alongside
pragmas of each kind. Use subtypes to restrict the kinds of markers
that can appear in parse_tree_plain_opts to the set that we actually
can put into them. (Source files of course can contain any markers,
and .intN files either get put into them either all of the markers
that occur in the source file in a given section, or none of them.)
Delete the item_pragma_info type, which was a wrapper around
the specific info of each pragma, and stored a context and an item
sequence number alongside it. Move the context and the item sequence
number into the representation of each pragma. This should reduce
visual clutter in the source code at places that construct or deconstruct
pragmas, and at runtime (with direct args) it should reduce both
the number of memory cells we need to allocate, and the number
of pointers we need to follow.
Include decl vs impl in the names of some function symbols.
Partly to counteract that, shorten some names to avoid excessive
line lengths.
compiler/add_pragma.m:
Add predicates to add decl and impl markers.
Move the predicates looping over lists of pragma next to the
predicates handling those pragmas.
compiler/make_hlds_passes.m:
Add both decl and impl markers before adding foreign_procs.
The ability to do this was the original motivation for this diff.
Update the comments both about this issue, and about why we delay
adding tabling pragmas to the HLDS.
compiler/check_module_interface.m:
Conform to the changes above.
Add an XXX about something fishy.
compiler/item_util.m:
Delete aux functions that are no longer needed.
compiler/add_mutable_aux_preds.m:
compiler/add_pragma_tabling.m:
compiler/add_pragma_type_spec.m:
compiler/comp_unit_interface.m:
compiler/convert_parse_tree.m:
compiler/equiv_type.m:
compiler/get_dependencies.m:
compiler/grab_modules.m:
compiler/hlds_module.m:
compiler/intermod.m:
compiler/intermod_analysis.m:
compiler/make_hlds_separate_items.m:
compiler/mercury_compile_middle_passes.m:
compiler/module_qual.collect_mq_info.m:
compiler/module_qual.qual_errors.m:
compiler/module_qual.qualify_items.m:
compiler/parse_pragma.m:
compiler/parse_pragma_analysis.m:
compiler/parse_pragma_foreign.m:
compiler/parse_pragma_tabling.m:
compiler/parse_tree_out.m:
compiler/parse_tree_out_pragma.m:
compiler/prog_item_stats.m:
compiler/prog_mutable.m:
compiler/recompilation.check.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/unused_args.m:
Conform to the changes above.
1185 lines
49 KiB
Mathematica
1185 lines
49 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2011 The University of Melbourne.
|
|
% Copyright (C) 2015 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: prog_mutable.m.
|
|
% Main authors: rafe, juliensf, zs.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.prog_mutable.
|
|
:- interface.
|
|
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_foreign.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module cord.
|
|
:- import_module list.
|
|
:- import_module set_tree234.
|
|
|
|
:- type module_params
|
|
---> module_params(
|
|
mp_globals :: globals,
|
|
mp_module_name :: sym_name,
|
|
mp_undef_inst_ctors :: set_tree234(inst_ctor),
|
|
mp_type_name_func :: type_foreign_name_func
|
|
).
|
|
|
|
% This function should lookup the name of the given Mercury type
|
|
% in the given foreign target language, even if the Mercury type
|
|
% is defined using a foreign_type pragma. This means that our caller
|
|
% needs to embed in this function access to a version of the type table
|
|
% from *after* all type definitions have been processed.
|
|
%
|
|
:- type type_foreign_name_func ==
|
|
(func(foreign_language, mer_type) = string).
|
|
|
|
% Implement the given mutable by constructing
|
|
%
|
|
% - the predicate declarations of the auxiliary predicates it needs,
|
|
%
|
|
% - the definitions of those auxiliary predicates, in the form of
|
|
% clauses (for some) or foreign procs (for the others),
|
|
%
|
|
% - recording the foreign_body_codes that contain the definitions of the
|
|
% global variables that contain the mutable,
|
|
%
|
|
% - recording any foreign_decl_codes that contain declarations of those
|
|
% global variables, if needed by the target language.
|
|
%
|
|
% Also, record the initialization predicates to the target language,
|
|
% to let our ancestors arrange for them to be called before main/2.
|
|
%
|
|
:- pred implement_mutable(module_params::in, item_mutable_info::in,
|
|
list(item_pred_decl_info)::out,
|
|
list(item_clause_info)::out, list(item_foreign_proc_info)::out,
|
|
impl_pragma_fproc_export_info::out,
|
|
cord(foreign_decl_code)::in, cord(foreign_decl_code)::out,
|
|
cord(foreign_body_code)::in, cord(foreign_body_code)::out,
|
|
pred_target_names::in, pred_target_names::out) is det.
|
|
|
|
%---------------------%
|
|
|
|
:- func declare_mutable_aux_preds_for_int0(module_name, item_mutable_info)
|
|
= list(item_pred_decl_info).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.builtin_lib_types.
|
|
:- import_module parse_tree.file_names.
|
|
:- import_module parse_tree.maybe_error.
|
|
:- import_module parse_tree.prog_data_foreign.
|
|
:- import_module parse_tree.prog_mode.
|
|
|
|
:- import_module bool.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
implement_mutable(ModuleParams, ItemMutable,
|
|
PredDecls, ClauseInfos, ForeignProcs, FPEInfo,
|
|
!ForeignDeclCodes, !ForeignBodyCodes, !PredTargetNames) :-
|
|
ItemMutable = item_mutable_info(MutableName,
|
|
_OrigType, Type, _OrigInst, _Inst,
|
|
_InitTerm, _VarSetMutable, MutAttrs, Context, _SeqNum),
|
|
Globals = ModuleParams ^ mp_globals,
|
|
get_target_params(Globals, TargetParams),
|
|
Lang = TargetParams ^ tp_target_lang,
|
|
define_mutable_global_var(ModuleParams, Lang, MutableName, Type, MutAttrs,
|
|
Context, TargetMutableName, !ForeignDeclCodes, !ForeignBodyCodes),
|
|
declare_and_define_mutable_aux_preds(ModuleParams, TargetParams,
|
|
ItemMutable, TargetMutableName,
|
|
PredDecls, ClauseInfos, ForeignProcs, FPEInfo, !PredTargetNames).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Define the global holding the mutable.
|
|
%
|
|
|
|
:- pred define_mutable_global_var(module_params::in, foreign_language::in,
|
|
string::in, mer_type::in, mutable_var_attributes::in, prog_context::in,
|
|
string::out,
|
|
cord(foreign_decl_code)::in, cord(foreign_decl_code)::out,
|
|
cord(foreign_body_code)::in, cord(foreign_body_code)::out) is det.
|
|
|
|
define_mutable_global_var(ModuleParams, Lang, MutableName, Type, MutAttrs,
|
|
Context, TargetMutableName, !ForeignDeclCodes, !ForeignBodyCodes) :-
|
|
MutAttrs = mutable_var_attributes(LangMap, Const),
|
|
ModuleName = ModuleParams ^ mp_module_name,
|
|
mutable_target_var_name(ModuleName, MutableName, LangMap, Lang,
|
|
TargetMutableName),
|
|
(
|
|
Lang = lang_c,
|
|
define_mutable_global_var_c(ModuleParams, TargetMutableName, Type,
|
|
Const, Context, ForeignDeclCode, ForeignBodyCode),
|
|
cord.snoc(ForeignDeclCode, !ForeignDeclCodes)
|
|
;
|
|
Lang = lang_csharp,
|
|
define_mutable_global_var_csharp(TargetMutableName, Type,
|
|
Const, Context, ForeignBodyCode)
|
|
;
|
|
Lang = lang_java,
|
|
define_mutable_global_var_java(TargetMutableName, Type,
|
|
Const, Context, ForeignBodyCode)
|
|
),
|
|
cord.snoc(ForeignBodyCode, !ForeignBodyCodes).
|
|
|
|
% Decide what the name of the underlying global used to implement the
|
|
% mutable should be. If there is a foreign_name attribute for the target
|
|
% language, then use that, otherwise construct one based on the
|
|
% Mercury name for the mutable.
|
|
%
|
|
% The variable name should be acceptable in all our current backends.
|
|
%
|
|
:- pred mutable_target_var_name(module_name::in, string::in,
|
|
map(foreign_language, string)::in, foreign_language::in,
|
|
string::out) is det.
|
|
|
|
mutable_target_var_name(ModuleName, MutableName, LangMap, Lang,
|
|
TargetMutableVarName) :-
|
|
( if map.search(LangMap, Lang, TargetVarName) then
|
|
TargetMutableVarName = TargetVarName
|
|
else
|
|
RawVarName = "mutable_variable_" ++ MutableName,
|
|
QualifiedVarName0 = qualified(ModuleName, RawVarName),
|
|
( if mercury_std_library_module_name(ModuleName) then
|
|
QualifiedVarName =
|
|
add_outermost_qualifier("mercury", QualifiedVarName0)
|
|
else
|
|
QualifiedVarName = QualifiedVarName0
|
|
),
|
|
TargetMutableVarName = sym_name_mangle(QualifiedVarName)
|
|
).
|
|
|
|
% Define the global variable used to hold the mutable on the C backend,
|
|
% and if needed, the mutex controlling access to it.
|
|
%
|
|
:- pred define_mutable_global_var_c(module_params::in, string::in,
|
|
mer_type::in, mutable_maybe_constant::in, prog_context::in,
|
|
foreign_decl_code::out, foreign_body_code::out) is det.
|
|
|
|
define_mutable_global_var_c(ModuleParams, TargetMutableName, Type,
|
|
Const, Context, ForeignDeclCode, ForeignBodyCode) :-
|
|
% The declaration we construct will be included in the .mh files. Since
|
|
% these are grade independent, we need to output both the high- and
|
|
% low-level C declarations for the global used to implement the mutable,
|
|
% and make the choice conditional on whether MR_HIGHLEVEL_CODE is defined.
|
|
IsThreadLocal = mutable_var_thread_local(Const),
|
|
(
|
|
IsThreadLocal = mutable_not_thread_local,
|
|
% The only difference between the high- and low-level C backends
|
|
% is that in the latter, mutables are *always* boxed, whereas
|
|
% in the former they may not be.
|
|
HighLevelTypeName = global_foreign_type_name(ModuleParams,
|
|
bp_native_if_possible, lang_c, Type),
|
|
LowLevelTypeName = global_foreign_type_name(ModuleParams,
|
|
bp_always_boxed, lang_c, Type),
|
|
Globals = ModuleParams ^ mp_globals,
|
|
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
|
|
(
|
|
HighLevelCode = no,
|
|
TypeName = LowLevelTypeName
|
|
;
|
|
HighLevelCode = yes,
|
|
TypeName = HighLevelTypeName
|
|
)
|
|
;
|
|
IsThreadLocal = mutable_thread_local,
|
|
% For thread-local mutables, the variable holds an index into an array.
|
|
TypeName = "MR_Unsigned",
|
|
HighLevelTypeName = TypeName,
|
|
LowLevelTypeName = TypeName
|
|
),
|
|
% Constant mutables do not require mutexes, as their values are never
|
|
% updated. Thread-local mutables do not require mutexes either.
|
|
( if
|
|
( Const = mutable_is_constant
|
|
; IsThreadLocal = mutable_thread_local
|
|
)
|
|
then
|
|
LockDeclStr = "",
|
|
LockDefnStr = ""
|
|
else
|
|
MutexVarName = mutable_mutex_var_name(TargetMutableName),
|
|
LockDeclStr = string.format(
|
|
"#ifdef MR_THREAD_SAFE\n" ++
|
|
" extern MercuryLock %s;\n" ++
|
|
"#endif\n",
|
|
[s(MutexVarName)]),
|
|
LockDefnStr = string.format(
|
|
"#ifdef MR_THREAD_SAFE\n" ++
|
|
" MercuryLock %s;\n" ++
|
|
"#endif\n",
|
|
[s(MutexVarName)])
|
|
),
|
|
DeclBodyStr = string.format(
|
|
"#ifdef MR_HIGHLEVEL_CODE\n" ++
|
|
" extern %s %s;\n" ++
|
|
"#else\n" ++
|
|
" extern %s %s;\n" ++
|
|
"#endif\n",
|
|
[s(HighLevelTypeName), s(TargetMutableName),
|
|
s(LowLevelTypeName), s(TargetMutableName)]),
|
|
DeclLiteral = floi_literal(DeclBodyStr ++ LockDeclStr),
|
|
ForeignDeclCode = foreign_decl_code(lang_c, foreign_decl_is_exported,
|
|
DeclLiteral, Context),
|
|
DefnBodyStr = string.format("%s %s;\n",
|
|
[s(TypeName), s(TargetMutableName)]),
|
|
DefnLiteral = floi_literal(DefnBodyStr ++ LockDefnStr),
|
|
ForeignBodyCode = foreign_body_code(lang_c, DefnLiteral, Context).
|
|
|
|
% Define the global variable used to hold the mutable on the C# backend.
|
|
%
|
|
:- pred define_mutable_global_var_csharp(string::in, mer_type::in,
|
|
mutable_maybe_constant::in, prog_context::in,
|
|
foreign_body_code::out) is det.
|
|
|
|
define_mutable_global_var_csharp(TargetMutableName, Type, Const, Context,
|
|
ForeignBodyCode) :-
|
|
IsThreadLocal = mutable_var_thread_local(Const),
|
|
(
|
|
IsThreadLocal = mutable_not_thread_local,
|
|
( if Type = int_type then
|
|
TypeStr = "int"
|
|
else
|
|
TypeStr = "object"
|
|
)
|
|
;
|
|
IsThreadLocal = mutable_thread_local,
|
|
TypeStr = "int"
|
|
),
|
|
DefnBodyStr = string.format("static %s %s;\n",
|
|
[s(TypeStr), s(TargetMutableName)]),
|
|
ForeignBodyCode =
|
|
foreign_body_code(lang_csharp, floi_literal(DefnBodyStr), Context).
|
|
|
|
% Define the global variable used to hold the mutable on the Java backend.
|
|
%
|
|
:- pred define_mutable_global_var_java(string::in, mer_type::in,
|
|
mutable_maybe_constant::in, prog_context::in,
|
|
foreign_body_code::out) is det.
|
|
|
|
define_mutable_global_var_java(TargetMutableName, Type, Const, Context,
|
|
ForeignBodyCode) :-
|
|
% XXX The reason why we use java.lang.Object as the type of the mutable
|
|
% variable is documented in the commit message of a commit on 2009 Sep 2,
|
|
% commit ac3d1c60271951ab98d07cf24bd73332925beb92. That message also
|
|
% explains how we can make an exception for integers.
|
|
IsThreadLocal = mutable_var_thread_local(Const),
|
|
(
|
|
IsThreadLocal = mutable_not_thread_local,
|
|
% Synchronization is only required for double and long values,
|
|
% which Mercury does not expose. We could also use the volatile
|
|
% keyword. (Java Language Specification, 2nd Ed., 17.4).
|
|
( if Type = int_type then
|
|
TypeStr = "int"
|
|
else
|
|
TypeStr = "java.lang.Object"
|
|
),
|
|
DefnBodyStr = string.format("static %s %s;\n",
|
|
[s(TypeStr), s(TargetMutableName)])
|
|
;
|
|
IsThreadLocal = mutable_thread_local,
|
|
( if Type = int_type then
|
|
TypeStr = "java.lang.Integer"
|
|
else
|
|
TypeStr = "java.lang.Object"
|
|
),
|
|
DefnBodyStr = string.format(
|
|
"static java.lang.ThreadLocal<%s> %s = " ++
|
|
"new java.lang.InheritableThreadLocal<%s>();\n",
|
|
[s(TypeStr), s(TargetMutableName), s(TypeStr)])
|
|
),
|
|
ForeignBodyCode =
|
|
foreign_body_code(lang_java, floi_literal(DefnBodyStr), Context).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
declare_mutable_aux_preds_for_int0(ModuleName, ItemMutable)
|
|
= PublicAuxPredDecls :-
|
|
% The logic here is a version of the logic behind
|
|
% declare_and_define_mutable_aux_preds below, but restricted
|
|
% to the kinds of items that we may want to put into .int0 files.
|
|
ItemMutable = item_mutable_info(MutableName,
|
|
_OrigType, Type, _OrigInst, Inst, _Value, _Varset, MutAttrs,
|
|
Context, _SeqNum),
|
|
MutAttrs = mutable_var_attributes(_LangMap, Const),
|
|
(
|
|
Const = mutable_is_constant,
|
|
declare_constant_get_set_preds(ModuleName, MutableName, Type, Inst,
|
|
Context, _InitSetPredName, GetPredDecl, _SetPredDecl),
|
|
% 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.
|
|
PublicAuxPredDecls = [GetPredDecl]
|
|
% We used to also put SetPredDecl into the .int0 file,
|
|
% but since the set predicate for constant mutables
|
|
% is supposed to be a secret, that seems... counterproductive.
|
|
;
|
|
Const = mutable_is_not_constant(AttachToIO, _Local),
|
|
declare_nonconstant_get_set_preds(ModuleName, MutableName, Type, Inst,
|
|
AttachToIO, Context, _InitSetPredName,
|
|
GetPredDecl, SetPredDecl, IOPredDecls),
|
|
% _AttachToIO = mutable_dont_attach_to_io_state => IOPredDecls = []
|
|
PublicAuxPredDecls = [GetPredDecl, SetPredDecl | IOPredDecls]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred declare_and_define_mutable_aux_preds(module_params::in,
|
|
mutable_target_params::in, item_mutable_info::in, string::in,
|
|
list(item_pred_decl_info)::out,
|
|
list(item_clause_info)::out, list(item_foreign_proc_info)::out,
|
|
impl_pragma_fproc_export_info::out,
|
|
pred_target_names::in, pred_target_names::out) is det.
|
|
|
|
declare_and_define_mutable_aux_preds(ModuleParams, TargetParams, ItemMutable,
|
|
TargetMutableName, PredDecls, ClauseInfos, ForeignProcs,
|
|
PragmaFPEInfo, !PredTargetNames) :-
|
|
% The transformation we implement here is documented in notes/mutables.
|
|
% The logic here is an expanded version of the logic behind
|
|
% declare_mutable_aux_preds_for_int0 above.
|
|
ItemMutable = item_mutable_info(MutableName,
|
|
_OrigType, Type, _OrigInst, Inst,
|
|
_InitTerm, _VarSetMutable, MutAttrs, Context, _SeqNum),
|
|
TargetParams = mutable_target_params(Lang, BoxPolicy),
|
|
|
|
% Set up the default attributes for the foreign_procs used for the
|
|
% access predicates.
|
|
Attrs0 = default_attributes(Lang),
|
|
(
|
|
Lang = lang_c,
|
|
set_box_policy(BoxPolicy, Attrs0, Attrs1),
|
|
set_may_call_mercury(proc_will_not_call_mercury, Attrs1, Attrs)
|
|
;
|
|
( Lang = lang_csharp
|
|
; Lang = lang_java
|
|
),
|
|
% The mutable variable name is not module-qualified, and so
|
|
% it must not be exported to `.opt' files. We could add the
|
|
% qualification, but do we really want to opt-export
|
|
% mutable variables anyway?
|
|
set_may_export_body(yes(proc_may_not_export_body), Attrs0, Attrs)
|
|
),
|
|
|
|
ModuleName = ModuleParams ^ mp_module_name,
|
|
MutAttrs = mutable_var_attributes(_LangMap, Const),
|
|
(
|
|
Const = mutable_is_constant,
|
|
declare_constant_get_set_preds(ModuleName, MutableName, Type, Inst,
|
|
Context, InitSetPredName, GetPredDecl, SetPredDecl),
|
|
define_constant_get_set_preds(ModuleName, TargetParams, MutableName,
|
|
Inst, Context, TargetMutableName, Attrs, GetSetForeignProcs),
|
|
NonInitPredDecls = [GetPredDecl, SetPredDecl],
|
|
GetSetClauseInfos = [],
|
|
PreInitForeignProcs = [],
|
|
MaybeCallPreInitExpr = maybe.no,
|
|
LockUnlockForeignProcs = [],
|
|
UnsafeGetSetForeignProcs = []
|
|
;
|
|
Const = mutable_is_not_constant(AttachToIO, Local),
|
|
declare_nonconstant_get_set_preds(ModuleName, MutableName, Type, Inst,
|
|
AttachToIO, Context, InitSetPredName,
|
|
GetPredDecl, SetPredDecl, IOPredDecls),
|
|
% We call define_nonconstant_get_set_preds later,
|
|
% after we have computed the input it needs.
|
|
do_we_need_pre_init_lock_unlock(Lang, Local, PreInit, LockUnlock),
|
|
(
|
|
PreInit = dont_need_pre_init_pred,
|
|
PreInitPredDecls = [],
|
|
PreInitForeignProcs = [],
|
|
MaybeCallPreInitExpr = maybe.no
|
|
;
|
|
PreInit = need_pre_init_pred,
|
|
declare_pre_init_pred(ModuleName, MutableName, Context,
|
|
PreInitPredDecl),
|
|
PreInitPredDecls = [PreInitPredDecl],
|
|
define_pre_init_pred(ModuleName, TargetParams, MutableName,
|
|
Local, Context, TargetMutableName, Attrs,
|
|
CallPreInitExpr, PreInitForeignProc),
|
|
PreInitForeignProcs = [PreInitForeignProc],
|
|
MaybeCallPreInitExpr = yes(CallPreInitExpr)
|
|
),
|
|
(
|
|
LockUnlock = dont_need_lock_unlock_preds,
|
|
LockUnlockPredDecls = [],
|
|
LockUnlockForeignProcs = [],
|
|
MaybeLockUnlockExprs = maybe.no
|
|
;
|
|
LockUnlock = need_lock_unlock_preds,
|
|
declare_lock_unlock_preds(ModuleName, MutableName,
|
|
Context, LockPredDecl, UnlockPredDecl),
|
|
define_lock_unlock_preds(ModuleName, TargetParams, MutableName,
|
|
Local, Context, TargetMutableName, Attrs,
|
|
LockUnlockExprs, LockUnlockForeignProcs),
|
|
LockUnlockPredDecls = [LockPredDecl, UnlockPredDecl],
|
|
MaybeLockUnlockExprs = yes(LockUnlockExprs)
|
|
),
|
|
declare_unsafe_get_set_preds(ModuleName, MutableName, Type, Inst,
|
|
Context, UnsafeGetPredDecl, UnsafeSetPredDecl),
|
|
define_unsafe_get_set_preds(ModuleParams, TargetParams,
|
|
MutableName, Type, Inst, Local, Context, TargetMutableName,
|
|
Attrs, UnsafeGetExpr, UnsafeSetExpr, UnsafeGetSetForeignProcs),
|
|
% We do this after defining (a) the lock and unlock predicates
|
|
% (if any), and (b) the unsafe get and set predicates, since they
|
|
% give us (a) MaybeLockUnlockExprs and (b) Unsafe{Get,Set}Expr
|
|
% respectively.
|
|
define_nonconstant_get_set_preds(ModuleName, TargetParams,
|
|
MutableName, AttachToIO, Context,
|
|
MaybeLockUnlockExprs, UnsafeGetExpr, UnsafeSetExpr,
|
|
GetSetClauseInfos),
|
|
GetSetForeignProcs = [],
|
|
NonInitPredDecls = [GetPredDecl, SetPredDecl] ++ IOPredDecls ++
|
|
PreInitPredDecls ++ LockUnlockPredDecls ++
|
|
[UnsafeGetPredDecl, UnsafeSetPredDecl]
|
|
),
|
|
declare_init_pred(ModuleName, MutableName, Context, InitPredDecl),
|
|
% We do this after (a) defining the preinit predicate (if any) and
|
|
% (b) declaring the main get and set predicates, since they give us
|
|
% (a) MaybeCallPreInitExpr and (b) InitSetPredName respectively.
|
|
define_init_pred(ModuleName, Lang, ItemMutable, InitSetPredName,
|
|
MaybeCallPreInitExpr, InitClauseInfo, PragmaFPEInfo, !PredTargetNames),
|
|
PredDecls = [InitPredDecl | NonInitPredDecls],
|
|
ClauseInfos = [InitClauseInfo | GetSetClauseInfos],
|
|
ForeignProcs = PreInitForeignProcs ++ LockUnlockForeignProcs ++
|
|
GetSetForeignProcs ++ UnsafeGetSetForeignProcs.
|
|
|
|
:- type need_pre_init_pred
|
|
---> dont_need_pre_init_pred
|
|
; need_pre_init_pred.
|
|
|
|
:- type need_lock_unlock_preds
|
|
---> dont_need_lock_unlock_preds
|
|
; need_lock_unlock_preds.
|
|
|
|
:- pred do_we_need_pre_init_lock_unlock(foreign_language::in,
|
|
mutable_maybe_thread_local::in,
|
|
need_pre_init_pred::out, need_lock_unlock_preds::out) is det.
|
|
|
|
do_we_need_pre_init_lock_unlock(Lang, Local, PreInit, LockUnlock) :-
|
|
(
|
|
Lang = lang_c,
|
|
PreInit = need_pre_init_pred,
|
|
LockUnlock = need_lock_unlock_preds
|
|
;
|
|
Lang = lang_csharp,
|
|
(
|
|
Local = mutable_is_thread_local,
|
|
PreInit = need_pre_init_pred
|
|
;
|
|
Local = mutable_is_not_thread_local(_),
|
|
PreInit = dont_need_pre_init_pred
|
|
),
|
|
LockUnlock = dont_need_lock_unlock_preds
|
|
;
|
|
Lang = lang_java,
|
|
PreInit = dont_need_pre_init_pred,
|
|
LockUnlock = dont_need_lock_unlock_preds
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred declare_pre_init_pred(module_name::in, string::in,
|
|
prog_context::in, item_pred_decl_info::out) is det.
|
|
|
|
declare_pre_init_pred(ModuleName, MutableName, Context, PreInitPredDecl) :-
|
|
PreInitPredName = mutable_pre_init_pred_name(ModuleName, MutableName),
|
|
make_aux_pred_decl(ModuleName, MutableName, PreInitPredName,
|
|
[], purity_impure, mutable_pred_pre_init, Context, PreInitPredDecl).
|
|
|
|
% Define the pre_init predicates, if needed by the init predicate.
|
|
%
|
|
:- pred define_pre_init_pred(module_name::in, mutable_target_params::in,
|
|
string::in, mutable_maybe_thread_local::in, prog_context::in, string::in,
|
|
foreign_proc_attributes::in, goal::out, item_foreign_proc_info::out)
|
|
is det.
|
|
|
|
define_pre_init_pred(ModuleName, TargetParams, MutableName, Local, Context,
|
|
TargetMutableName, Attrs, CallPreInitExpr, ForeignProc) :-
|
|
Lang = TargetParams ^ tp_target_lang,
|
|
PreInitPredName = mutable_pre_init_pred_name(ModuleName, MutableName),
|
|
(
|
|
Lang = lang_c,
|
|
(
|
|
Local = mutable_is_not_thread_local(_),
|
|
PreInitCode = string.format(
|
|
"#ifdef MR_THREAD_SAFE\n" ++
|
|
" pthread_mutex_init(&%s, MR_MUTEX_ATTR);\n" ++
|
|
"#endif\n",
|
|
[s(mutable_mutex_var_name(TargetMutableName))])
|
|
;
|
|
Local = mutable_is_thread_local,
|
|
PreInitCode = string.format(
|
|
"%s = MR_new_thread_local_mutable_index();\n",
|
|
[s(TargetMutableName)])
|
|
)
|
|
;
|
|
Lang = lang_csharp,
|
|
PreInitCode = string.format(
|
|
"%s = runtime.ThreadLocalMutables.new_index();\n",
|
|
[s(TargetMutableName)])
|
|
;
|
|
Lang = lang_java,
|
|
unexpected($pred, "preinit for java")
|
|
),
|
|
ForeignProc = item_foreign_proc_info(Attrs,
|
|
PreInitPredName,
|
|
pf_predicate,
|
|
[], % Args
|
|
varset.init, % ProgVarSet
|
|
varset.init, % InstVarSet
|
|
fp_impl_ordinary(PreInitCode, yes(Context)),
|
|
Context,
|
|
item_no_seq_num
|
|
),
|
|
CallPreInitExpr = call_expr(Context, PreInitPredName, [], purity_impure).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred declare_lock_unlock_preds(module_name::in, string::in,
|
|
prog_context::in,
|
|
item_pred_decl_info::out, item_pred_decl_info::out) is det.
|
|
|
|
declare_lock_unlock_preds(ModuleName, MutableName, Context,
|
|
LockPredDecl, UnlockPredDecl) :-
|
|
LockPredName = mutable_lock_pred_name(ModuleName, MutableName),
|
|
UnlockPredName = mutable_unlock_pred_name(ModuleName, MutableName),
|
|
make_aux_pred_decl(ModuleName, MutableName, LockPredName,
|
|
[], purity_impure, mutable_pred_lock, Context, LockPredDecl),
|
|
make_aux_pred_decl(ModuleName, MutableName, UnlockPredName,
|
|
[], purity_impure, mutable_pred_unlock, Context, UnlockPredDecl).
|
|
|
|
% Define the lock and unlock predicates, if needed.
|
|
%
|
|
:- pred define_lock_unlock_preds(module_name::in, mutable_target_params::in,
|
|
string::in, mutable_maybe_thread_local::in, prog_context::in, string::in,
|
|
foreign_proc_attributes::in,
|
|
{goal, goal}::out, list(item_foreign_proc_info)::out) is det.
|
|
|
|
define_lock_unlock_preds(ModuleName, TargetParams, MutableName, Local, Context,
|
|
TargetMutableName, Attrs, LockUnlockExprs, ForeignProcs) :-
|
|
Lang = TargetParams ^ tp_target_lang,
|
|
(
|
|
Lang = lang_c,
|
|
set_thread_safe(proc_thread_safe, Attrs, LockAndUnlockAttrs),
|
|
MutableMutexVarName = mutable_mutex_var_name(TargetMutableName),
|
|
(
|
|
Local = mutable_is_not_thread_local(_),
|
|
% XXX The second argument of both calls should be the name of
|
|
% the Mercury predicate, with chars escaped as appropriate.
|
|
LockForeignProcBodyStr = string.format(
|
|
"#ifdef MR_THREAD_SAFE\n" ++
|
|
" MR_LOCK(&%s, \"%s\");\n" ++
|
|
"#endif\n",
|
|
[s(MutableMutexVarName), s(MutableMutexVarName)]),
|
|
UnlockForeignProcBodyStr = string.format(
|
|
"#ifdef MR_THREAD_SAFE\n" ++
|
|
" MR_UNLOCK(&%s, \"%s\");\n" ++
|
|
"#endif\n",
|
|
[s(MutableMutexVarName), s(MutableMutexVarName)])
|
|
;
|
|
Local = mutable_is_thread_local,
|
|
LockForeignProcBodyStr = "",
|
|
UnlockForeignProcBodyStr = ""
|
|
),
|
|
LockPredName =
|
|
mutable_lock_pred_name(ModuleName, MutableName),
|
|
UnlockPredName =
|
|
mutable_unlock_pred_name(ModuleName, MutableName),
|
|
LockForeignProc = item_foreign_proc_info(LockAndUnlockAttrs,
|
|
LockPredName,
|
|
pf_predicate,
|
|
[],
|
|
varset.init, % ProgVarSet
|
|
varset.init, % InstVarSet
|
|
fp_impl_ordinary(LockForeignProcBodyStr, yes(Context)),
|
|
Context,
|
|
item_no_seq_num
|
|
),
|
|
UnlockForeignProc = item_foreign_proc_info(LockAndUnlockAttrs,
|
|
UnlockPredName,
|
|
pf_predicate,
|
|
[],
|
|
varset.init, % ProgVarSet
|
|
varset.init, % InstVarSet
|
|
fp_impl_ordinary(UnlockForeignProcBodyStr, yes(Context)),
|
|
Context,
|
|
item_no_seq_num
|
|
),
|
|
ForeignProcs = [LockForeignProc, UnlockForeignProc],
|
|
CallLockExpr0 =
|
|
call_expr(Context, LockPredName, [], purity_impure),
|
|
CallUnlockExpr0 =
|
|
call_expr(Context, UnlockPredName, [], purity_impure),
|
|
LockUnlockExprs = {CallLockExpr0, CallUnlockExpr0}
|
|
;
|
|
Lang = lang_csharp,
|
|
unexpected($pred, "lock_unlock for csharp")
|
|
;
|
|
Lang = lang_java,
|
|
unexpected($pred, "lock_unlock for java")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred declare_unsafe_get_set_preds(module_name::in, string::in,
|
|
mer_type::in, mer_inst::in, prog_context::in,
|
|
item_pred_decl_info::out, item_pred_decl_info::out) is det.
|
|
|
|
declare_unsafe_get_set_preds(ModuleName, MutableName, Type, Inst, Context,
|
|
UnsafeGetPredDecl, UnsafeSetPredDecl) :-
|
|
GetArg = type_out(Type, Inst),
|
|
SetArg = type_in(Type, Inst),
|
|
UnsafeGetPredName = mutable_unsafe_get_pred_name(ModuleName, MutableName),
|
|
UnsafeSetPredName = mutable_unsafe_set_pred_name(ModuleName, MutableName),
|
|
make_aux_pred_decl(ModuleName, MutableName, UnsafeGetPredName,
|
|
[GetArg], purity_semipure,
|
|
mutable_pred_std_get, Context, UnsafeGetPredDecl),
|
|
make_aux_pred_decl(ModuleName, MutableName, UnsafeSetPredName,
|
|
[SetArg], purity_impure,
|
|
mutable_pred_std_set, Context, UnsafeSetPredDecl).
|
|
|
|
% Define the unsafe get and set predicates, if needed.
|
|
%
|
|
:- pred define_unsafe_get_set_preds(module_params::in,
|
|
mutable_target_params::in, string::in, mer_type::in, mer_inst::in,
|
|
mutable_maybe_thread_local::in, prog_context::in, string::in,
|
|
foreign_proc_attributes::in,
|
|
goal::out, goal::out, list(item_foreign_proc_info)::out) is det.
|
|
|
|
define_unsafe_get_set_preds(ModuleParams, TargetParams, MutableName,
|
|
Type, Inst, Local, Context, TargetMutableName, Attrs,
|
|
UnsafeGetExpr, UnsafeSetExpr, ForeignProcs) :-
|
|
ModuleName = ModuleParams ^ mp_module_name,
|
|
Lang = TargetParams ^ tp_target_lang,
|
|
BoxPolicy = TargetParams ^ tp_box_policy,
|
|
varset.new_named_var("X", X, varset.init, VarSetOnlyX),
|
|
set_thread_safe(proc_thread_safe, Attrs, ThreadSafeAttrs),
|
|
set_purity(purity_semipure, ThreadSafeAttrs, UnsafeGetAttrs),
|
|
UnsafeSetAttrs = ThreadSafeAttrs, % defaults to purity_impure
|
|
(
|
|
Lang = lang_c,
|
|
Trailed = mutable_thread_local_trailed(Local),
|
|
(
|
|
Trailed = mutable_untrailed,
|
|
TrailCode = ""
|
|
;
|
|
Trailed = mutable_trailed,
|
|
% We have already checked that we are in a
|
|
% trailing grade.
|
|
TrailCode = string.format("MR_trail_current_value(&%s);\n",
|
|
[s(TargetMutableName)])
|
|
),
|
|
(
|
|
Local = mutable_is_not_thread_local(_Trail),
|
|
UnsafeGetCode = string.format("X = %s;\n", [s(TargetMutableName)]),
|
|
UnsafeSetCode = string.format("%s = X;\n", [s(TargetMutableName)])
|
|
;
|
|
Local = mutable_is_thread_local,
|
|
TypeName =
|
|
global_foreign_type_name(ModuleParams, BoxPolicy, Lang, Type),
|
|
UnsafeGetCode = string.format(
|
|
"MR_get_thread_local_mutable(%s, X, %s);\n",
|
|
[s(TypeName), s(TargetMutableName)]),
|
|
UnsafeSetCode = string.format(
|
|
"MR_set_thread_local_mutable(%s, X, %s);\n",
|
|
[s(TypeName), s(TargetMutableName)])
|
|
)
|
|
;
|
|
Lang = lang_csharp,
|
|
% We generate an error for trailed mutables in pass 2, but we
|
|
% still continue on to pass 3 even in the presence of such errors.
|
|
TrailCode = "",
|
|
(
|
|
Local = mutable_is_not_thread_local(_Trail),
|
|
UnsafeGetCode =
|
|
string.format("\tX = %s;\n", [s(TargetMutableName)]),
|
|
UnsafeSetCode =
|
|
string.format("\t%s = X;\n", [s(TargetMutableName)])
|
|
;
|
|
Local = mutable_is_thread_local,
|
|
( if Type = int_type then
|
|
Cast = "(int) "
|
|
else
|
|
Cast = ""
|
|
),
|
|
UnsafeGetCode = string.format(
|
|
"\tX = %sruntime.ThreadLocalMutables.get(%s);\n",
|
|
[s(Cast), s(TargetMutableName)]),
|
|
UnsafeSetCode = string.format(
|
|
"\truntime.ThreadLocalMutables.set(%s, X);\n",
|
|
[s(TargetMutableName)])
|
|
)
|
|
;
|
|
Lang = lang_java,
|
|
% We generate an error for trailed mutables in pass 2, but we
|
|
% still continue on to pass 3 even in the presence of such errors.
|
|
TrailCode = "",
|
|
(
|
|
Local = mutable_is_not_thread_local(_Trail),
|
|
UnsafeGetCode =
|
|
string.format("\tX = %s;\n", [s(TargetMutableName)]),
|
|
UnsafeSetCode =
|
|
string.format("\t%s = X;\n", [s(TargetMutableName)])
|
|
;
|
|
Local = mutable_is_thread_local,
|
|
UnsafeGetCode =
|
|
string.format("\tX = %s.get();\n", [s(TargetMutableName)]),
|
|
UnsafeSetCode =
|
|
string.format("\t%s.set(X);\n", [s(TargetMutableName)])
|
|
)
|
|
),
|
|
UnsafeGetPredName =
|
|
mutable_unsafe_get_pred_name(ModuleName, MutableName),
|
|
UnsafeSetPredName =
|
|
mutable_unsafe_set_pred_name(ModuleName, MutableName),
|
|
UnsafeGetForeignProc = item_foreign_proc_info(UnsafeGetAttrs,
|
|
UnsafeGetPredName,
|
|
pf_predicate,
|
|
[pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
|
|
VarSetOnlyX, % ProgVarSet
|
|
varset.init, % InstVarSet
|
|
fp_impl_ordinary(UnsafeGetCode, yes(Context)),
|
|
Context,
|
|
item_no_seq_num
|
|
),
|
|
UnsafeSetForeignProc = item_foreign_proc_info(UnsafeSetAttrs,
|
|
UnsafeSetPredName,
|
|
pf_predicate,
|
|
[pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
|
|
VarSetOnlyX, % ProgVarSet
|
|
varset.init, % InstVarSet
|
|
fp_impl_ordinary(TrailCode ++ UnsafeSetCode, yes(Context)),
|
|
Context,
|
|
item_no_seq_num
|
|
),
|
|
ForeignProcs = [UnsafeGetForeignProc, UnsafeSetForeignProc],
|
|
UnsafeGetExpr = call_expr(Context, UnsafeGetPredName,
|
|
[variable(X, Context)], purity_semipure),
|
|
UnsafeSetExpr = call_expr(Context, UnsafeSetPredName,
|
|
[variable(X, Context)], purity_impure).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred declare_constant_get_set_preds(module_name::in, string::in,
|
|
mer_type::in, mer_inst::in, prog_context::in, sym_name::out,
|
|
item_pred_decl_info::out, item_pred_decl_info::out) is det.
|
|
|
|
declare_constant_get_set_preds(ModuleName, MutableName, Type, Inst,
|
|
Context, InitSetPredName, GetPredDecl, SetPredDecl) :-
|
|
GetArg = type_out(Type, Inst),
|
|
SetArg = type_in(Type, Inst),
|
|
GetPredName = mutable_get_pred_name(ModuleName, MutableName),
|
|
SetPredName = mutable_secret_set_pred_name(ModuleName, MutableName),
|
|
InitSetPredName = SetPredName,
|
|
make_aux_pred_decl(ModuleName, MutableName, GetPredName,
|
|
[GetArg], purity_pure,
|
|
mutable_pred_constant_get, Context, GetPredDecl),
|
|
make_aux_pred_decl(ModuleName, MutableName, SetPredName,
|
|
[SetArg], purity_impure,
|
|
mutable_pred_constant_secret_set, Context, SetPredDecl).
|
|
|
|
:- pred define_constant_get_set_preds(module_name::in,
|
|
mutable_target_params::in, string::in, mer_inst::in, prog_context::in,
|
|
string::in, foreign_proc_attributes::in,
|
|
list(item_foreign_proc_info)::out) is det.
|
|
|
|
define_constant_get_set_preds(ModuleName, TargetParams, MutableName, Inst,
|
|
Context, TargetMutableName, Attrs, ForeignProcs) :-
|
|
Lang = TargetParams ^ tp_target_lang,
|
|
BoxPolicy = TargetParams ^ tp_box_policy,
|
|
varset.new_named_var("X", X, varset.init, VarSetOnlyX),
|
|
ConstantGetPredName = mutable_get_pred_name(ModuleName, MutableName),
|
|
ConstantSetPredName =
|
|
mutable_secret_set_pred_name(ModuleName, MutableName),
|
|
set_purity(purity_pure, Attrs, ConstantGetAttrs0),
|
|
set_thread_safe(proc_thread_safe,
|
|
ConstantGetAttrs0, ConstantGetAttrs),
|
|
ConstantSetAttrs = Attrs,
|
|
(
|
|
( Lang = lang_c
|
|
; Lang = lang_csharp
|
|
; Lang = lang_java
|
|
),
|
|
ConstantGetCode = string.format("X = %s;\n", [s(TargetMutableName)]),
|
|
ConstantSetCode = string.format("%s = X;\n", [s(TargetMutableName)])
|
|
),
|
|
ConstantGetForeignProc = item_foreign_proc_info(ConstantGetAttrs,
|
|
ConstantGetPredName,
|
|
pf_predicate,
|
|
[pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
|
|
VarSetOnlyX, % ProgVarSet
|
|
varset.init, % InstVarSet
|
|
fp_impl_ordinary(ConstantGetCode, yes(Context)),
|
|
Context,
|
|
item_no_seq_num
|
|
),
|
|
% NOTE: we don't need to trail the set action, since it is
|
|
% executed only once at initialization time.
|
|
ConstantSetForeignProc = item_foreign_proc_info(ConstantSetAttrs,
|
|
ConstantSetPredName,
|
|
pf_predicate,
|
|
[pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
|
|
VarSetOnlyX, % ProgVarSet
|
|
varset.init, % InstVarSet
|
|
fp_impl_ordinary(ConstantSetCode, yes(Context)),
|
|
Context,
|
|
item_no_seq_num
|
|
),
|
|
ForeignProcs = [ConstantGetForeignProc, ConstantSetForeignProc].
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred declare_nonconstant_get_set_preds(module_name::in, string::in,
|
|
mer_type::in, mer_inst::in, mutable_attach_to_io_state::in,
|
|
prog_context::in, sym_name::out,
|
|
item_pred_decl_info::out, item_pred_decl_info::out,
|
|
list(item_pred_decl_info)::out) is det.
|
|
|
|
declare_nonconstant_get_set_preds(ModuleName, MutableName, Type, Inst,
|
|
AttachToIO, Context, InitSetPredName,
|
|
GetPredDecl, SetPredDecl, IOPredDecls) :-
|
|
GetArg = type_out(Type, Inst),
|
|
SetArg = type_in(Type, Inst),
|
|
GetPredName = mutable_get_pred_name(ModuleName, MutableName),
|
|
SetPredName = mutable_set_pred_name(ModuleName, MutableName),
|
|
InitSetPredName = SetPredName,
|
|
make_aux_pred_decl(ModuleName, MutableName, GetPredName,
|
|
[GetArg], purity_semipure,
|
|
mutable_pred_std_get, Context, GetPredDecl),
|
|
make_aux_pred_decl(ModuleName, MutableName, SetPredName,
|
|
[SetArg], purity_impure,
|
|
mutable_pred_std_set, Context, SetPredDecl),
|
|
(
|
|
AttachToIO = mutable_dont_attach_to_io_state,
|
|
IOPredDecls = []
|
|
;
|
|
AttachToIO = mutable_attach_to_io_state,
|
|
IOGetPredName = mutable_get_pred_name(ModuleName, MutableName),
|
|
IOSetPredName = mutable_set_pred_name(ModuleName, MutableName),
|
|
make_aux_pred_decl(ModuleName, MutableName, IOGetPredName,
|
|
[GetArg | io_state_pair], purity_pure,
|
|
mutable_pred_io_get, Context, IOGetPredDecl),
|
|
make_aux_pred_decl(ModuleName, MutableName, IOSetPredName,
|
|
[SetArg | io_state_pair], purity_pure,
|
|
mutable_pred_io_set, Context, IOSetPredDecl),
|
|
IOPredDecls = [IOGetPredDecl, IOSetPredDecl]
|
|
).
|
|
|
|
% Define the standard get and set predicates for a nonconstant mutable.
|
|
% Define the io get and set predicates as well if the mutable
|
|
% is attached to the I/O state.
|
|
%
|
|
:- pred define_nonconstant_get_set_preds(module_name::in,
|
|
mutable_target_params::in, string::in,
|
|
mutable_attach_to_io_state::in, prog_context::in,
|
|
maybe({goal, goal})::in, goal::in, goal::in,
|
|
list(item_clause_info)::out) is det.
|
|
|
|
define_nonconstant_get_set_preds(ModuleName, TargetParams, MutableName,
|
|
AttachToIO, Context,
|
|
MaybeLockUnlockExprs, CallUnsafeGetExpr, CallUnsafeSetExpr,
|
|
ClauseInfos) :-
|
|
Lang = TargetParams ^ tp_target_lang,
|
|
varset.new_named_var("X", X, varset.init, VarSetOnlyX),
|
|
StdGetPredName = mutable_get_pred_name(ModuleName, MutableName),
|
|
StdSetPredName = mutable_set_pred_name(ModuleName, MutableName),
|
|
(
|
|
( Lang = lang_c
|
|
; Lang = lang_csharp
|
|
; Lang = lang_java
|
|
),
|
|
(
|
|
MaybeLockUnlockExprs = no,
|
|
ImpureGetExpr = CallUnsafeGetExpr,
|
|
ImpureSetExpr = CallUnsafeSetExpr
|
|
;
|
|
MaybeLockUnlockExprs = yes({CallLockExpr, CallUnlockExpr}),
|
|
ImpureGetExpr = conj_expr(Context,
|
|
CallLockExpr, [CallUnsafeGetExpr, CallUnlockExpr]),
|
|
ImpureSetExpr = conj_expr(Context,
|
|
CallLockExpr, [CallUnsafeSetExpr, CallUnlockExpr])
|
|
),
|
|
StdPredArgs = [variable(X, Context)],
|
|
StdGetPredExpr = promise_purity_expr(Context, purity_semipure,
|
|
ImpureGetExpr),
|
|
StdSetPredExpr = ImpureSetExpr,
|
|
StdGetClauseInfo = item_clause_info(pf_predicate, StdGetPredName,
|
|
StdPredArgs, VarSetOnlyX, ok2(StdGetPredExpr, []),
|
|
Context, item_no_seq_num),
|
|
StdSetClauseInfo = item_clause_info(pf_predicate, StdSetPredName,
|
|
StdPredArgs, VarSetOnlyX, ok2(StdSetPredExpr, []),
|
|
Context, item_no_seq_num)
|
|
),
|
|
(
|
|
AttachToIO = mutable_dont_attach_to_io_state,
|
|
ClauseInfos = [StdGetClauseInfo, StdSetClauseInfo]
|
|
;
|
|
AttachToIO = mutable_attach_to_io_state,
|
|
varset.new_named_var("IO0", IO0, VarSetOnlyX, VarSetXandIOs0),
|
|
varset.new_named_var("IO", IO, VarSetXandIOs0, VarSetXandIOs),
|
|
IOGetPredName = StdGetPredName,
|
|
IOSetPredName = StdSetPredName,
|
|
IOPredArgs = [variable(X, Context),
|
|
variable(IO0, Context), variable(IO, Context)],
|
|
% It is important to have CopyIOExpr INSIDE the promise_pure scope
|
|
% for the set predicate. If it were outside, then the scope
|
|
% would not bind any variables, and since it is promised pure,
|
|
% the compiler would be allowed to delete it. The problem does not
|
|
% arise for the get predicate, since ImpureGetExpr binds X.
|
|
CopyIOExpr = unify_expr(Context,
|
|
variable(IO0, Context), variable(IO, Context),
|
|
purity_impure),
|
|
IOGetPredExpr = conj_expr(Context, ImpureGetExpr, [CopyIOExpr]),
|
|
IOSetPredExpr = conj_expr(Context, ImpureSetExpr, [CopyIOExpr]),
|
|
PureIOGetPredExpr =
|
|
promise_purity_expr(Context, purity_pure, IOGetPredExpr),
|
|
PureIOSetPredExpr =
|
|
promise_purity_expr(Context, purity_pure, IOSetPredExpr),
|
|
IOGetClauseInfo = item_clause_info(pf_predicate,
|
|
IOGetPredName, IOPredArgs, VarSetXandIOs,
|
|
ok2(PureIOGetPredExpr, []), Context, item_no_seq_num),
|
|
IOSetClauseInfo = item_clause_info(pf_predicate,
|
|
IOSetPredName, IOPredArgs, VarSetXandIOs,
|
|
ok2(PureIOSetPredExpr, []), Context, item_no_seq_num),
|
|
ClauseInfos = [StdGetClauseInfo, StdSetClauseInfo,
|
|
IOGetClauseInfo, IOSetClauseInfo]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred declare_init_pred(module_name::in, string::in, prog_context::in,
|
|
item_pred_decl_info::out) is det.
|
|
|
|
declare_init_pred(ModuleName, MutableName, Context, InitPredDecl) :-
|
|
InitPredName = mutable_init_pred_name(ModuleName, MutableName),
|
|
make_aux_pred_decl(ModuleName, MutableName, InitPredName, [],
|
|
purity_impure, mutable_pred_init, Context, InitPredDecl).
|
|
|
|
% Define the init predicate, and arrange for it to be called
|
|
% at initialization time.
|
|
%
|
|
:- pred define_init_pred(module_name::in, foreign_language::in,
|
|
item_mutable_info::in, sym_name::in, maybe(goal)::in,
|
|
item_clause_info::out, impl_pragma_fproc_export_info::out,
|
|
pred_target_names::in, pred_target_names::out) is det.
|
|
|
|
define_init_pred(ModuleName, Lang, ItemMutable, InitSetPredName,
|
|
MaybeCallPreInitExpr, InitClauseInfo, FPEInfo, !PredTargetNames) :-
|
|
ItemMutable = item_mutable_info(MutableName,
|
|
_OrigType, _Type, _OrigInst, _Inst,
|
|
InitTerm, VarSetMutable, _MutAttrs, Context, SeqNum),
|
|
varset.new_named_var("X", X, VarSetMutable, VarSetMutableX),
|
|
VarX = variable(X, Context),
|
|
|
|
UnifyExpr = unify_expr(Context, VarX, InitTerm, purity_impure),
|
|
CallSetExpr = call_expr(Context, InitSetPredName, [VarX], purity_impure),
|
|
UnifyCallSetExpr = conj_expr(Context, UnifyExpr, [CallSetExpr]),
|
|
(
|
|
MaybeCallPreInitExpr = no,
|
|
InitPredExpr = UnifyCallSetExpr
|
|
;
|
|
MaybeCallPreInitExpr = yes(CallPreInitExpr),
|
|
InitPredExpr = conj_expr(Context, CallPreInitExpr, [UnifyCallSetExpr])
|
|
),
|
|
InitPredName = mutable_init_pred_name(ModuleName, MutableName),
|
|
% See the comments for parse_mutable_decl_info for the reason
|
|
% why we _must_ pass VarSetMutableX here.
|
|
InitClauseInfo = item_clause_info(pf_predicate, InitPredName, [],
|
|
VarSetMutableX, ok2(InitPredExpr, []), Context, item_no_seq_num),
|
|
|
|
% The compiler introduces initialise declarations that call impure
|
|
% predicates as part of the source-to-source transformation for mutable
|
|
% variables. These predicates *must* be impure in order to prevent the
|
|
% compiler optimizing them away.
|
|
Attrs = item_compiler_attributes(compiler_origin_mutable(ModuleName,
|
|
MutableName, mutable_pred_init)),
|
|
Origin = item_origin_compiler(Attrs),
|
|
new_user_init_or_final_pred_target_name(ModuleName, "init", SeqNum,
|
|
InitPredName, user_arity(0), TargetName, !PredTargetNames),
|
|
PredNameModesPF = proc_pf_name_modes(pf_predicate, InitPredName, []),
|
|
FPEInfo = impl_pragma_fproc_export_info(Origin, Lang, PredNameModesPF,
|
|
TargetName, VarSetMutable, Context, item_no_seq_num).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type mutable_target_params
|
|
---> mutable_target_params(
|
|
tp_target_lang :: foreign_language,
|
|
tp_box_policy :: box_policy
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% This predicate decides which auxiliary predicates we need
|
|
% to implement a mutable. The rest of this module just implements
|
|
% the decisions made here, which are recorded in the mutable_target_params.
|
|
%
|
|
:- pred get_target_params(globals::in, mutable_target_params::out) is det.
|
|
|
|
get_target_params(Globals, TargetParams) :-
|
|
% The set of predicates we need depends on
|
|
% - the compilation target, since we use different implementations
|
|
% of mutables on different backends, and
|
|
% - on the properties of the mutable itself.
|
|
globals.get_target(Globals, CompilationTarget),
|
|
(
|
|
CompilationTarget = target_c,
|
|
Lang = lang_c,
|
|
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
|
|
(
|
|
HighLevelCode = no,
|
|
BoxPolicy = bp_always_boxed
|
|
;
|
|
HighLevelCode = yes,
|
|
BoxPolicy = bp_native_if_possible
|
|
)
|
|
;
|
|
CompilationTarget = target_csharp,
|
|
Lang = lang_csharp,
|
|
BoxPolicy = bp_native_if_possible
|
|
;
|
|
CompilationTarget = target_java,
|
|
Lang = lang_java,
|
|
BoxPolicy = bp_native_if_possible
|
|
),
|
|
TargetParams = mutable_target_params(Lang, BoxPolicy).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Returns the name of the mutex associated eith a given mutable.
|
|
% The input to this function is the name of the mutable in the target
|
|
% language.
|
|
%
|
|
:- func mutable_mutex_var_name(string) = string.
|
|
|
|
mutable_mutex_var_name(TargetMutableVarName) = MutexVarName :-
|
|
MutexVarName = TargetMutableVarName ++ "_lock".
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func type_in(mer_type, mer_inst) = type_and_mode.
|
|
|
|
type_in(Type, Inst) = type_and_mode(Type, in_mode(Inst)).
|
|
|
|
:- func type_out(mer_type, mer_inst) = type_and_mode.
|
|
|
|
type_out(Type, Inst) = type_and_mode(Type, out_mode(Inst)).
|
|
|
|
:- func io_state_pair = list(type_and_mode).
|
|
|
|
io_state_pair =
|
|
[type_and_mode(io_state_type, di_mode),
|
|
type_and_mode(io_state_type, uo_mode)].
|
|
|
|
:- pred make_aux_pred_decl(module_name::in, string::in, sym_name::in,
|
|
list(type_and_mode)::in, purity::in, mutable_pred_kind::in,
|
|
prog_context::in, item_pred_decl_info::out) is det.
|
|
|
|
make_aux_pred_decl(ModuleName, MutableName, PredSymName, ArgTypesAndModes,
|
|
Purity, Kind, Context, PredDecl) :-
|
|
WithType = maybe.no,
|
|
WithMode = maybe.no,
|
|
Origin = compiler_origin_mutable(ModuleName, MutableName, Kind),
|
|
CompilerAttrs = item_compiler_attributes(Origin),
|
|
MaybeAttrs = item_origin_compiler(CompilerAttrs),
|
|
varset.init(TypeVarSet),
|
|
varset.init(InstVarSet),
|
|
ExistQVars = [],
|
|
Constraints = constraints([], []),
|
|
SeqNum = item_no_seq_num,
|
|
PredDecl = item_pred_decl_info(PredSymName, pf_predicate, ArgTypesAndModes,
|
|
WithType, WithMode, yes(detism_det), MaybeAttrs,
|
|
TypeVarSet, InstVarSet, ExistQVars, Purity, Constraints,
|
|
Context, SeqNum).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% The BoxPolicy says whether the mutable should always be boxed or not.
|
|
% The only difference between the high- and low-level C backends is that
|
|
% in the latter mutables are *always* boxed, whereas in the former
|
|
% they may not be. The other backends that support mutables are all
|
|
% native_if_possible.
|
|
%
|
|
:- func global_foreign_type_name(module_params, box_policy, foreign_language,
|
|
mer_type) = string.
|
|
|
|
global_foreign_type_name(ModuleParams, BoxPolicy, Lang, Type) = String :-
|
|
(
|
|
BoxPolicy = bp_always_boxed,
|
|
String = "MR_Word"
|
|
;
|
|
BoxPolicy = bp_native_if_possible,
|
|
TypeNameFunc = ModuleParams ^ mp_type_name_func,
|
|
String = TypeNameFunc(Lang, Type)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The names we construct for the auxiliary predicates of a mutable.
|
|
%
|
|
|
|
:- func mutable_lock_pred_name(sym_name, string) = sym_name.
|
|
:- func mutable_unlock_pred_name(sym_name, string) = sym_name.
|
|
:- func mutable_unsafe_get_pred_name(sym_name, string) = sym_name.
|
|
:- func mutable_unsafe_set_pred_name(sym_name, string) = sym_name.
|
|
:- func mutable_get_pred_name(sym_name, string) = sym_name.
|
|
:- func mutable_set_pred_name(sym_name, string) = sym_name.
|
|
:- func mutable_secret_set_pred_name(module_name, string) = sym_name.
|
|
:- func mutable_init_pred_name(module_name, string) = sym_name.
|
|
:- func mutable_pre_init_pred_name(module_name, string) = sym_name.
|
|
|
|
mutable_lock_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "lock_" ++ MutableName).
|
|
|
|
mutable_unlock_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "unlock_" ++ MutableName).
|
|
|
|
mutable_unsafe_get_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "unsafe_get_" ++ MutableName).
|
|
|
|
mutable_unsafe_set_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "unsafe_set_" ++ MutableName).
|
|
|
|
mutable_get_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "get_" ++ MutableName).
|
|
|
|
mutable_set_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "set_" ++ MutableName).
|
|
|
|
mutable_secret_set_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "secret_initialization_only_set_" ++ MutableName).
|
|
|
|
mutable_init_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "initialise_mutable_" ++ MutableName).
|
|
|
|
mutable_pre_init_pred_name(ModuleName, MutableName) =
|
|
qualified(ModuleName, "pre_initialise_mutable_" ++ MutableName).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module parse_tree.prog_mutable.
|
|
%---------------------------------------------------------------------------%
|