mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
386160f937
compiler/*.m:
Standardize on the do_not spelling over the dont contraction
in the compiler directory. (We used to have a lot of both spellings.)
1185 lines
49 KiB
Mathematica
1185 lines
49 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2015, 2019, 2021-2024 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_do_not_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 = do_not_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 = do_not_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
|
|
---> do_not_need_pre_init_pred
|
|
; need_pre_init_pred.
|
|
|
|
:- type need_lock_unlock_preds
|
|
---> do_not_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 = do_not_need_pre_init_pred
|
|
),
|
|
LockUnlock = do_not_need_lock_unlock_preds
|
|
;
|
|
Lang = lang_java,
|
|
PreInit = do_not_need_pre_init_pred,
|
|
LockUnlock = do_not_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_do_not_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_do_not_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 = univ_exist_constraints([], []),
|
|
SeqNum = item_no_seq_num,
|
|
PredDecl = item_pred_decl_info(PredSymName, pf_predicate,
|
|
types_and_modes(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.
|
|
%---------------------------------------------------------------------------%
|