[m-rev.] for review: implement mutables for erlang
Peter Wang
wangp at students.csse.unimelb.edu.au
Tue Jun 12 12:22:20 AEST 2007
Estimated hours taken: 15
Branches: main
Add support for mutables in the Erlang backend.
compiler/make_hlds_passes.m:
Refactor code that inserts mutable-related items for C backend.
Insert items for mutable-related predicates for Erlang.
compiler/prog_item.m:
Add item_mutable inst.
compiler/prog_mutable.m:
Document the mutable transformation for Erlang.
library/erlang.m:
New module. This initially contains a server process that will run
in the background to handle messages relating to mutables in Erlang.
In future it may hold other things for the Erlang backend.
library/library.m:
Add `erlang' module to the standard library.
compiler/elds_to_erlang.m:
Make the Erlang main wrapper start and stop the Erlang global server.
tests/hard_coded/Mmakefile:
tests/hard_coded/float_gv.m:
tests/hard_coded/sub-modules/non_word_mutable.m:
Make these test cases work in Erlang.
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.14
diff -u -r1.14 elds_to_erlang.m
--- compiler/elds_to_erlang.m 8 Jun 2007 07:24:57 -0000 1.14
+++ compiler/elds_to_erlang.m 12 Jun 2007 02:02:42 -0000
@@ -270,7 +270,7 @@
% Otherwise main_2_p_0 will be called.
mercury__main_wrapper() ->
- mercury__io:'ML_io_init_state'(),
+ mercury__startup(),
InitModule = list_to_atom(atom_to_list(?MODULE) ++ ""_init""),
try
InitModule:init_modules(),
@@ -282,12 +282,20 @@
StackTrace = erlang:get_stacktrace(),
mercury__exception:'ML_report_uncaught_exception'(Excp),
mercury__maybe_dump_stacktrace(StackTrace),
- mercury__io:'ML_io_finalize_state'(),
+ mercury__shutdown(),
% init:stop is preferred to calling halt but there seems
% to be no way to choose the exit code otherwise.
halt(1)
end,
- mercury__io:'ML_io_finalize_state'().
+ mercury__shutdown().
+
+ mercury__startup() ->
+ mercury__erlang:'ML_start_global_server'(),
+ mercury__io:'ML_io_init_state'().
+
+ mercury__shutdown() ->
+ mercury__io:'ML_io_finalize_state'(),
+ mercury__erlang:'ML_stop_global_server'().
mercury__maybe_dump_stacktrace(StackTrace) ->
case os:getenv(""MERCURY_SUPPRESS_STACK_TRACE"") of
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.68
diff -u -r1.68 make_hlds_passes.m
--- compiler/make_hlds_passes.m 8 Jun 2007 00:47:10 -0000 1.68
+++ compiler/make_hlds_passes.m 12 Jun 2007 02:02:42 -0000
@@ -459,38 +459,71 @@
(
DefinedThisModule = yes,
module_info_get_name(!.ModuleInfo, ModuleName),
- %
- % Create the initialisation predicate and the mutex initialisation
- % predicate. The latter is called by the former.
- %
+
+ % The predicate declarations we produce depends on the compilation
+ % target, which use different source-to-source transformations for
+ % mutables.
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.get_target(Globals, CompilationTarget),
+ (
+ CompilationTarget = target_c,
+ WantPreInitDecl = yes,
+ WantUnsafeAccessAndLockDecls = yes
+ ;
+ CompilationTarget = target_erlang,
+ WantPreInitDecl = no,
+ WantUnsafeAccessAndLockDecls = no
+ ;
+ ( CompilationTarget = target_il
+ ; CompilationTarget = target_java
+ ; CompilationTarget = target_asm
+ ; CompilationTarget = target_x86_64
+ ),
+ % Not supported yet.
+ WantPreInitDecl = yes,
+ WantUnsafeAccessAndLockDecls = yes
+ ),
+
+ % Create the mutable initialisation predicate.
InitPredDecl = mutable_init_pred_decl(ModuleName, Name),
add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
!Specs),
+
IsConstant = mutable_var_constant(MutAttrs),
(
IsConstant = no,
% Create the pre-initialisation predicate. This is called
% by the mutable initialisation predicate.
- PreInitPredDecl = mutable_pre_init_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(PreInitPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
+ (
+ WantPreInitDecl = yes,
+ PreInitPredDecl = mutable_pre_init_pred_decl(ModuleName, Name),
+ add_item_decl_pass_1(PreInitPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs)
+ ;
+ WantPreInitDecl = no
+ ),
% Create the primitive access and locking predicates.
- LockPredDecl = lock_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(LockPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnlockPredDecl = unlock_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(UnlockPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnsafeGetPredDecl = unsafe_get_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(UnsafeGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnsafeSetPredDecl = unsafe_set_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(UnsafeSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
+ (
+ WantUnsafeAccessAndLockDecls = yes,
+ LockPredDecl = lock_pred_decl(ModuleName, Name),
+ add_item_decl_pass_1(LockPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ UnlockPredDecl = unlock_pred_decl(ModuleName, Name),
+ add_item_decl_pass_1(UnlockPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ UnsafeGetPredDecl = unsafe_get_pred_decl(ModuleName, Name,
+ Type, Inst),
+ add_item_decl_pass_1(UnsafeGetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs),
+ UnsafeSetPredDecl = unsafe_set_pred_decl(ModuleName, Name,
+ Type, Inst),
+ add_item_decl_pass_1(UnsafeSetPredDecl, Context, !Status,
+ !ModuleInfo, _, !Specs)
+ ;
+ WantUnsafeAccessAndLockDecls = no
+ ),
% Create the standard, non-pure access predicates. These are
% always created for non-constant mutables, even if the
@@ -710,9 +743,15 @@
globals.get_target(Globals, CompilationTarget),
% XXX We don't currently support the foreign_name attribute
- % for languages other than C.
+ % for languages other than C and Erlang.
(
- CompilationTarget = target_c,
+ (
+ CompilationTarget = target_c,
+ ForeignLanguage = lang_c
+ ;
+ CompilationTarget = target_erlang,
+ ForeignLanguage = lang_erlang
+ ),
mutable_var_maybe_foreign_names(MutAttrs) = MaybeForeignNames,
module_info_get_name(!.ModuleInfo, ModuleName),
(
@@ -724,7 +763,7 @@
% during this pass.
ReportErrors = yes,
get_global_name_from_foreign_names(!.ModuleInfo, ReportErrors,
- Context, ModuleName, Name, ForeignNames,
+ Context, ModuleName, Name, ForeignLanguage, ForeignNames,
_TargetMutableName, !Specs)
),
@@ -748,7 +787,6 @@
; CompilationTarget = target_java
; CompilationTarget = target_asm
; CompilationTarget = target_x86_64
- ; CompilationTarget = target_erlang
),
Pieces = [words("Error: foreign_name mutable attribute not yet"),
words("implemented for the"),
@@ -805,16 +843,18 @@
% an appropriate variable name.
%
:- pred get_global_name_from_foreign_names(module_info::in, bool::in,
- prog_context::in, module_name::in, string::in, list(foreign_name)::in,
- string::out, list(error_spec)::in, list(error_spec)::out) is det.
+ prog_context::in, module_name::in, string::in, foreign_language::in,
+ list(foreign_name)::in, string::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
get_global_name_from_foreign_names(ModuleInfo, ReportErrors, Context,
- ModuleName, MercuryMutableName, ForeignNames, TargetMutableName,
- !Specs) :-
- solutions(get_matching_foreign_name(ForeignNames, lang_c),
+ ModuleName, MercuryMutableName, ForeignLanguage, ForeignNames,
+ TargetMutableName, !Specs) :-
+ solutions(get_matching_foreign_name(ForeignNames, ForeignLanguage),
TargetMutableNames),
(
TargetMutableNames = [],
+ % This works for Erlang as well.
TargetMutableName = mutable_c_var_name(ModuleName, MercuryMutableName)
;
TargetMutableNames = [foreign_name(_, TargetMutableName)]
@@ -836,6 +876,7 @@
;
ReportErrors = no
),
+ % This works for Erlang as well.
TargetMutableName = mutable_c_var_name(ModuleName, MercuryMutableName)
).
@@ -1225,7 +1266,7 @@
pred_info_get_procedures(PredInfo, ProcTable),
ProcInfos = map.values(ProcTable),
% XXX We currently only support finalise declarations for the C
- % backends.
+ % and Erlang backends.
ExportLang = lang_c,
(
ArgTypes = [Arg1Type, Arg2Type],
@@ -1305,8 +1346,8 @@
!:Specs = [Spec | !.Specs]
).
add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_mutable(MercuryMutableName, Type, InitTerm, Inst,
- MutAttrs, MutVarset),
+ Item = item_mutable(MercuryMutableName, Type, _InitTerm, _Inst,
+ MutAttrs, _MutVarset),
% The transformation here is documented in the comments at the
% beginning of prog_mutable.m.
@@ -1315,57 +1356,48 @@
(
DefinedThisModule = yes,
module_info_get_name(!.ModuleInfo, ModuleName),
- IsConstant = mutable_var_constant(MutAttrs),
- IsThreadLocal = mutable_var_thread_local(MutAttrs),
- % Work out what name to give the global in the target language.
- decide_mutable_target_var_name(!.ModuleInfo, MutAttrs, ModuleName,
- MercuryMutableName, Context, TargetMutableName, !Specs),
-
- % Add foreign_decl and foreign_code items that declare/define the
- % global variable used to implement the mutable. If the mutable is
- % not constant then add a mutex to synchronize access to it as well.
- add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant,
- IsThreadLocal, Context, !QualInfo, !ModuleInfo, !Specs),
-
- % Set up the default attributes for the foreign_procs used for the
- % access predicates.
- % XXX Handle target languages other than C here.
- Attrs0 = default_attributes(lang_c),
module_info_get_globals(!.ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
+ globals.get_target(Globals, CompilationTarget),
(
- AlwaysBoxed = yes,
- BoxPolicy = always_boxed
+ CompilationTarget = target_c,
+
+ % Work out what name to give the global in the target language.
+ decide_mutable_target_var_name(!.ModuleInfo, MutAttrs,
+ ModuleName, MercuryMutableName, lang_c, Context,
+ TargetMutableName, !Specs),
+
+ % Add foreign_decl and foreign_code items that declare/define the
+ % global variable used to implement the mutable. If the mutable is
+ % not constant then add a mutex to synchronize access to it as
+ % well.
+ IsConstant = mutable_var_constant(MutAttrs),
+ IsThreadLocal = mutable_var_thread_local(MutAttrs),
+ add_c_mutable_defn_and_decl(TargetMutableName, Type, IsConstant,
+ IsThreadLocal, Context, !ModuleInfo, !QualInfo, !Specs),
+
+ % Add all the predicates related to mutables.
+ add_c_mutable_preds(Item, TargetMutableName,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs)
;
- AlwaysBoxed = no,
- BoxPolicy = native_if_possible
- ),
- set_box_policy(BoxPolicy, Attrs0, Attrs1),
- set_may_call_mercury(proc_will_not_call_mercury, Attrs1, Attrs),
+ CompilationTarget = target_erlang,
- (
- IsConstant = yes,
- InitSetPredName = mutable_secret_set_pred_sym_name(ModuleName,
- MercuryMutableName),
- add_constant_mutable_access_preds(TargetMutableName,
- ModuleName, MercuryMutableName, Attrs, Inst, BoxPolicy,
- Context, !Status, !QualInfo, !ModuleInfo, !Specs)
+ % Work out what name to give the global in the target language.
+ decide_mutable_target_var_name(!.ModuleInfo, MutAttrs,
+ ModuleName, MercuryMutableName, lang_erlang, Context,
+ TargetMutableName, !Specs),
+
+ % Add all the predicates related to mutables.
+ add_erlang_mutable_preds(Item, TargetMutableName,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs)
;
- IsConstant = no,
- InitSetPredName = mutable_set_pred_sym_name(ModuleName,
- MercuryMutableName),
- TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
- !.ModuleInfo, Type),
- add_mutable_primitive_preds(TargetMutableName, ModuleName,
- MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
- Context, !Status, !QualInfo, !ModuleInfo, !Specs),
- add_mutable_user_access_preds(ModuleName, MercuryMutableName,
- MutAttrs, Context, !Status, !QualInfo, !ModuleInfo, !Specs)
- ),
- add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
- ModuleName, MercuryMutableName, MutVarset, InitSetPredName, InitTerm,
- Attrs, !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ ( CompilationTarget = target_il
+ ; CompilationTarget = target_java
+ ; CompilationTarget = target_asm
+ ; CompilationTarget = target_x86_64
+ )
+ % Not supported yet.
+ )
;
DefinedThisModule = no
).
@@ -1375,77 +1407,191 @@
% otherwise construct one based on the Mercury name for the mutable
%
:- pred decide_mutable_target_var_name(module_info::in,
- mutable_var_attributes::in, module_name::in, string::in, prog_context::in,
- string::out, list(error_spec)::in, list(error_spec)::out) is det.
+ mutable_var_attributes::in, module_name::in, string::in,
+ foreign_language::in, prog_context::in, string::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-decide_mutable_target_var_name(ModuleInfo, MutAttrs, ModuleName, Name, Context,
- TargetMutableName, !Specs) :-
+decide_mutable_target_var_name(ModuleInfo, MutAttrs, ModuleName, Name,
+ ForeignLanguage, Context, TargetMutableName, !Specs) :-
mutable_var_maybe_foreign_names(MutAttrs) = MaybeForeignNames,
(
MaybeForeignNames = no,
+ % This works for Erlang as well.
TargetMutableName = mutable_c_var_name(ModuleName, Name)
;
MaybeForeignNames = yes(ForeignNames),
ReportErrors = no, % We've already reported them during pass 2.
get_global_name_from_foreign_names(ModuleInfo, ReportErrors, Context,
- ModuleName, Name, ForeignNames, TargetMutableName, !Specs)
+ ModuleName, Name, ForeignLanguage, ForeignNames, TargetMutableName,
+ !Specs)
).
-
+
+%-----------------------------------------------------------------------------%
+%
+% C mutables
+%
+
% Add the foreign_decl and foreign_code items that declare/define
% the global variable used to hold the mutable.
%
-:- pred add_mutable_defn_and_decl(string::in, mer_type::in, bool::in,
- mutable_thread_local::in, prog_context::in, qual_info::in, qual_info::out,
- module_info::in, module_info::out,
+:- pred add_c_mutable_defn_and_decl(string::in, mer_type::in, bool::in,
+ mutable_thread_local::in, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant, IsThreadLocal,
- Context, !QualInfo, !ModuleInfo, !Specs) :-
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.get_target(Globals, CompilationTarget),
-
+add_c_mutable_defn_and_decl(TargetMutableName, Type, IsConstant, IsThreadLocal,
+ Context, !ModuleInfo, !QualInfo, !Specs) :-
% We add the foreign code declaration and definition here rather than
% in pass 2 because the target-language-specific type name depends on
% whether there are any foreign_type declarations for Type.
+ get_c_mutable_global_foreign_decl_defn(!.ModuleInfo, Type,
+ TargetMutableName, IsConstant, IsThreadLocal,
+ ForeignDecl, ForeignDefn),
+ ItemStatus0 = item_status(status_local, may_be_unqualified),
+ add_item_decl_pass_2(ForeignDecl, Context, ItemStatus0, _,
+ !ModuleInfo, !Specs),
+ add_item_decl_pass_2(ForeignDefn, Context, ItemStatus0, _,
+ !ModuleInfo, !Specs).
+
+ % Create the C foreign_decl for the mutable.
+ % The bool argument says whether the mutable is a constant mutable
+ % or not.
+ %
+:- pred get_c_mutable_global_foreign_decl_defn(module_info::in, mer_type::in,
+ string::in, bool::in, mutable_thread_local::in, item::out, item::out)
+ is det.
+
+get_c_mutable_global_foreign_decl_defn(ModuleInfo, Type, TargetMutableName,
+ IsConstant, IsThreadLocal, Decl, Defn) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
(
- CompilationTarget = target_c,
- get_mutable_global_foreign_decl_defn(!.ModuleInfo, Type,
- TargetMutableName, IsConstant, IsThreadLocal,
- ForeignDecl, ForeignDefn),
- ItemStatus0 = item_status(status_local, may_be_unqualified),
- add_item_decl_pass_2(ForeignDecl, Context, ItemStatus0, _,
- !ModuleInfo, !Specs),
- add_item_decl_pass_2(ForeignDefn, Context, ItemStatus0, _,
- !ModuleInfo, !Specs)
+ IsThreadLocal = mutable_not_thread_local,
+ TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
+ ModuleInfo, Type)
;
- % The error message was printed in pass 2.
- ( CompilationTarget = target_il
- ; CompilationTarget = target_java
- ; CompilationTarget = target_asm
- ; CompilationTarget = target_x86_64
- ; CompilationTarget = target_erlang
- ),
- true
- ).
+ IsThreadLocal = mutable_thread_local,
+ %
+ % For thread-local mutables, the variable holds an index into an
+ % array.
+ %
+ TypeName = "MR_Unsigned"
+ ),
+ %
+ % Constant mutables do not require mutexes as their values are never
+ % updated. Thread-local mutables do not require mutexes either.
+ %
+ (
+ ( IsConstant = yes
+ ; IsThreadLocal = mutable_thread_local
+ )
+ ->
+ LockDecl = [],
+ LockDefn = []
+ ;
+ LockDecl = [
+ "#ifdef MR_THREAD_SAFE\n",
+ " extern MercuryLock ",
+ mutable_mutex_var_name(TargetMutableName), ";\n",
+ "#endif\n"
+ ],
+ LockDefn = [
+ "#ifdef MR_THREAD_SAFE\n",
+ " MercuryLock ",
+ mutable_mutex_var_name(TargetMutableName), ";\n",
+ "#endif\n"
+ ]
+ ),
+
+ DeclBody = string.append_list([
+ "extern ", TypeName, " ", TargetMutableName, ";\n" | LockDecl]),
+ Decl = item_pragma(compiler(mutable_decl),
+ pragma_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody)),
+
+ DefnBody = string.append_list([
+ TypeName, " ", TargetMutableName, ";\n" | LockDefn]),
+ Defn = item_pragma(compiler(mutable_decl),
+ pragma_foreign_code(lang_c, DefnBody)).
+
+:- func global_foreign_type_name(bool, foreign_language, module_info,
+ mer_type) = string.
+
+global_foreign_type_name(yes, _, _, _) = "MR_Word".
+global_foreign_type_name(no, Lang, ModuleInfo, Type) =
+ to_type_string(Lang, ModuleInfo, Type).
+
+%-----------------------------------------------------------------------------%
+
+:- pred add_c_mutable_preds(item::in(item_mutable), string::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_c_mutable_preds(Item, TargetMutableName,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ module_info_get_name(!.ModuleInfo, ModuleName),
+ Item = item_mutable(MercuryMutableName, Type, InitTerm, Inst,
+ MutAttrs, MutVarset),
+ IsConstant = mutable_var_constant(MutAttrs),
+ IsThreadLocal = mutable_var_thread_local(MutAttrs),
+
+ % Set up the default attributes for the foreign_procs used for the
+ % access predicates.
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
+ (
+ AlwaysBoxed = yes,
+ BoxPolicy = always_boxed
+ ;
+ AlwaysBoxed = no,
+ BoxPolicy = native_if_possible
+ ),
+ Attrs0 = default_attributes(lang_c),
+ set_box_policy(BoxPolicy, Attrs0, Attrs1),
+ set_may_call_mercury(proc_will_not_call_mercury, Attrs1, Attrs),
+
+ (
+ IsConstant = yes,
+ InitSetPredName = mutable_secret_set_pred_sym_name(ModuleName,
+ MercuryMutableName),
+ add_c_constant_mutable_access_preds(TargetMutableName,
+ ModuleName, MercuryMutableName, Attrs, Inst, BoxPolicy,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ IsConstant = no,
+ InitSetPredName = mutable_set_pred_sym_name(ModuleName,
+ MercuryMutableName),
+ TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
+ !.ModuleInfo, Type),
+ add_c_mutable_primitive_preds(TargetMutableName, ModuleName,
+ MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs),
+ add_c_mutable_user_access_preds(ModuleName, MercuryMutableName,
+ MutAttrs, !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ ),
+ add_c_mutable_initialisation(IsConstant, IsThreadLocal,
+ TargetMutableName, ModuleName, MercuryMutableName, MutVarset,
+ InitSetPredName, InitTerm, Attrs,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs).
% Add the access predicates for constant mutables.
%
-:- pred add_constant_mutable_access_preds(string::in, module_name::in,
+:- pred add_c_constant_mutable_access_preds(string::in, module_name::in,
string::in, pragma_foreign_proc_attributes::in, mer_inst::in,
- box_policy::in, prog_context::in, import_status::in, import_status::out,
- qual_info::in, qual_info::out, module_info::in, module_info::out,
+ box_policy::in, import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_constant_mutable_access_preds(TargetMutableName, ModuleName, Name,
- Attrs, Inst, BoxPolicy, Context, !Status, !QualInfo, !ModuleInfo,
- !Specs) :-
+add_c_constant_mutable_access_preds(TargetMutableName,
+ ModuleName, MutableName, Attrs, Inst, BoxPolicy,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
varset.new_named_var(varset.init, "X", X, ProgVarSet),
InstVarSet = varset.init,
set_purity(purity_pure, Attrs, ConstantGetAttrs0),
set_thread_safe(proc_thread_safe, ConstantGetAttrs0, ConstantGetAttrs),
ConstantGetForeignProc = pragma_foreign_proc(
ConstantGetAttrs,
- mutable_get_pred_sym_name(ModuleName, Name),
+ mutable_get_pred_sym_name(ModuleName, MutableName),
pf_predicate,
[pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
ProgVarSet,
@@ -1461,7 +1607,7 @@
% only once at initialization time.
ConstantSetForeignProc = pragma_foreign_proc(Attrs,
- mutable_secret_set_pred_sym_name(ModuleName, Name),
+ mutable_secret_set_pred_sym_name(ModuleName, MutableName),
pf_predicate,
[pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
ProgVarSet,
@@ -1472,20 +1618,20 @@
ConstantSetForeignProc),
add_item_clause(ConstantSetClause, !Status, Context, !ModuleInfo,
!QualInfo, !Specs).
-
+
% Add the foreign clauses for the mutable's primitive access and
% locking predicates.
%
-:- pred add_mutable_primitive_preds(string::in, module_name::in, string::in,
+:- pred add_c_mutable_primitive_preds(string::in, module_name::in, string::in,
mutable_var_attributes::in, pragma_foreign_proc_attributes::in,
- mer_inst::in, box_policy::in, string::in, prog_context::in,
- import_status::in, import_status::out, qual_info::in, qual_info::out,
- module_info::in, module_info::out,
+ mer_inst::in, box_policy::in, string::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_mutable_primitive_preds(TargetMutableName, ModuleName, Name,
- MutAttrs, Attrs, Inst, BoxPolicy, TypeName, Context,
- !Status, !QualInfo, !ModuleInfo, !Specs) :-
+add_c_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
+ MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
IsThreadLocal = mutable_var_thread_local(MutAttrs),
set_thread_safe(proc_thread_safe, Attrs, LockAndUnlockAttrs),
@@ -1507,7 +1653,7 @@
LockForeignProcBody = ""
),
LockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
- mutable_lock_pred_sym_name(ModuleName, Name),
+ mutable_lock_pred_sym_name(ModuleName, MutableName),
pf_predicate,
[],
varset.init, % Prog varset.
@@ -1534,7 +1680,7 @@
UnlockForeignProcBody = ""
),
UnlockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
- mutable_unlock_pred_sym_name(ModuleName, Name),
+ mutable_unlock_pred_sym_name(ModuleName, MutableName),
pf_predicate,
[],
varset.init, % Prog varset.
@@ -1559,7 +1705,7 @@
TypeName ++ ", X, " ++ TargetMutableName ++ ");"
),
UnsafeGetForeignProc = pragma_foreign_proc(UnsafeGetAttrs,
- mutable_unsafe_get_pred_sym_name(ModuleName, Name),
+ mutable_unsafe_get_pred_sym_name(ModuleName, MutableName),
pf_predicate,
[pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
ProgVarSet,
@@ -1610,7 +1756,7 @@
TypeName ++ ", X, " ++ TargetMutableName ++ ");"
),
UnsafeSetForeignProc = pragma_foreign_proc(UnsafeSetAttrs,
- mutable_unsafe_set_pred_sym_name(ModuleName, Name),
+ mutable_unsafe_set_pred_sym_name(ModuleName, MutableName),
pf_predicate,
[pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
ProgVarSet,
@@ -1626,25 +1772,26 @@
% If the mutable has the `attach_to_io_state' attribute then add the
% versions of the access preds that take the I/O state as well.
%
-:- pred add_mutable_user_access_preds(module_name::in, string::in,
- mutable_var_attributes::in, prog_context::in,
- import_status::in, import_status::out, qual_info::in, qual_info::out,
- module_info::in, module_info::out,
+:- pred add_c_mutable_user_access_preds(module_name::in, string::in,
+ mutable_var_attributes::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_mutable_user_access_preds(ModuleName, Name, MutAttrs, Context,
- !Status, !QualInfo, !ModuleInfo, !Specs) :-
+add_c_mutable_user_access_preds(ModuleName, MutableName, MutAttrs,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
varset.new_named_var(varset.init, "X", X, ProgVarSet0),
- LockPredName = mutable_lock_pred_sym_name(ModuleName, Name),
- UnlockPredName = mutable_unlock_pred_sym_name(ModuleName, Name),
- SetPredName = mutable_set_pred_sym_name(ModuleName, Name),
- GetPredName = mutable_get_pred_sym_name(ModuleName, Name),
+ LockPredName = mutable_lock_pred_sym_name(ModuleName, MutableName),
+ UnlockPredName = mutable_unlock_pred_sym_name(ModuleName, MutableName),
+ SetPredName = mutable_set_pred_sym_name(ModuleName, MutableName),
+ GetPredName = mutable_get_pred_sym_name(ModuleName, MutableName),
CallLock = call_expr(LockPredName, [], purity_impure) - Context,
CallUnlock = call_expr(UnlockPredName, [], purity_impure) - Context,
%
% Construct the semipure get predicate.
%
- UnsafeGetPredName = mutable_unsafe_get_pred_sym_name(ModuleName, Name),
+ UnsafeGetPredName = mutable_unsafe_get_pred_sym_name(ModuleName,
+ MutableName),
UnsafeGetCallArgs = [variable(X, Context)],
CallUnsafeGet = call_expr(UnsafeGetPredName, UnsafeGetCallArgs,
purity_semipure) - Context,
@@ -1668,7 +1815,8 @@
%
% Construct the impure set predicate.
%
- UnsafeSetPredName = mutable_unsafe_set_pred_sym_name(ModuleName, Name),
+ UnsafeSetPredName = mutable_unsafe_set_pred_sym_name(ModuleName,
+ MutableName),
UnsafeSetCallArgs = [variable(X, context_init)],
StdSetCallUnsafeSet = call_expr(UnsafeSetPredName, UnsafeSetCallArgs,
purity_impure) - Context,
@@ -1736,36 +1884,32 @@
% Add the code required to initialise a mutable.
%
-:- pred add_mutable_initialisation(bool::in, mutable_thread_local::in,
- string::in, module_name::in, string::in,
- prog_varset::in, sym_name::in, prog_term::in,
- pragma_foreign_proc_attributes::in, import_status::in, import_status::out,
- prog_context::in, module_info::in, module_info::out,
- qual_info::in, qual_info::out,
+:- pred add_c_mutable_initialisation(bool::in, mutable_thread_local::in,
+ string::in, module_name::in, string::in, prog_varset::in,
+ sym_name::in, prog_term::in, pragma_foreign_proc_attributes::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
- ModuleName, Name, MutVarset, InitSetPredName, InitTerm, Attrs, !Status,
- Context, !ModuleInfo, !QualInfo, !Specs) :-
+add_c_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
+ ModuleName, MutableName, MutVarset, InitSetPredName, InitTerm, Attrs,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ InitPredName = mutable_init_pred_sym_name(ModuleName, MutableName),
%
- % Add the `:- initialise' declaration and clause for the
- % mutable initialise predicate.
+ % Add the `:- initialise' declaration for the mutable initialisation
+ % predicate.
%
add_item_clause(item_initialise(compiler(mutable_decl),
- mutable_init_pred_sym_name(ModuleName, Name), 0 /* Arity */),
+ InitPredName, 0 /* Arity */),
!Status, Context, !ModuleInfo, !QualInfo, !Specs),
+ %
+ % Add the clause for the mutable initialisation predicate.
+ %
(
IsConstant = yes,
- %
- % See the comments for prog_io.parse_mutable_decl for the reason
- % why we _must_ use MutVarset here.
- %
- InitClause = item_clause(compiler(mutable_decl),
- MutVarset,
- pf_predicate,
- mutable_init_pred_sym_name(ModuleName, Name), [],
+ InitClauseExpr =
call_expr(InitSetPredName, [InitTerm], purity_impure)
- - Context)
+ - Context
;
IsConstant = no,
(
@@ -1785,7 +1929,8 @@
" = MR_new_thread_local_mutable_index();\n"
])
),
- PreInitPredName = mutable_pre_init_pred_sym_name(ModuleName, Name),
+ PreInitPredName = mutable_pre_init_pred_sym_name(ModuleName,
+ MutableName),
PreInitForeignProc = pragma_foreign_proc(Attrs,
PreInitPredName,
pf_predicate,
@@ -1805,100 +1950,279 @@
call_expr(InitSetPredName, [InitTerm], purity_impure)
- Context,
InitClauseExpr = conj_expr(CallPreInitExpr, CallSetPredExpr)
- - Context,
- %
- % See the comments for prog_io.parse_mutable_decl for the reason
- % why we _must_ use MutVarset here.
- %
- InitClause = item_clause(compiler(mutable_decl),
- MutVarset,
- pf_predicate,
- mutable_init_pred_sym_name(ModuleName, Name),
- [],
- InitClauseExpr
- )
+ - Context
+ ),
+ %
+ % See the comments for prog_io.parse_mutable_decl for the reason
+ % why we _must_ use MutVarset here.
+ %
+ InitClause = item_clause(compiler(mutable_decl),
+ MutVarset,
+ pf_predicate,
+ InitPredName,
+ [],
+ InitClauseExpr
),
add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
!Specs).
-
- % Create the foreign_decl for the mutable.
- % The bool argument says whether the mutable is a constant mutable
- % or not.
+
+%-----------------------------------------------------------------------------%
+%
+% Erlang mutables
+%
+
+:- pred add_erlang_mutable_preds(item::in(item_mutable), string::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_erlang_mutable_preds(Item, TargetMutableName,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ module_info_get_name(!.ModuleInfo, ModuleName),
+ Item = item_mutable(MutableName, _Type, InitTerm, Inst,
+ MutAttrs, MutVarset),
+ IsConstant = mutable_var_constant(MutAttrs),
+ (
+ IsConstant = yes,
+ InitSetPredName = mutable_secret_set_pred_sym_name(ModuleName,
+ MutableName),
+ add_erlang_constant_mutable_access_preds(TargetMutableName,
+ ModuleName, MutableName, Inst,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ IsConstant = no,
+ InitSetPredName = mutable_set_pred_sym_name(ModuleName,
+ MutableName),
+ add_erlang_mutable_user_access_preds(TargetMutableName,
+ ModuleName, MutableName, MutAttrs, Inst,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ ),
+ add_erlang_mutable_initialisation(ModuleName, MutableName,
+ MutVarset, InitSetPredName, InitTerm,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs).
+
+ % Add the access predicates for constant mutables.
%
-:- pred get_mutable_global_foreign_decl_defn(module_info::in, mer_type::in,
- string::in, bool::in, mutable_thread_local::in, item::out, item::out)
- is det.
+:- pred add_erlang_constant_mutable_access_preds(string::in,
+ module_name::in, string::in, mer_inst::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-get_mutable_global_foreign_decl_defn(ModuleInfo, Type, TargetMutableName,
- IsConstant, IsThreadLocal, Decl, Defn) :-
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
- globals.get_target(Globals, Backend),
+add_erlang_constant_mutable_access_preds(TargetMutableName,
+ ModuleName, MutableName, Inst,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ varset.new_named_var(varset.init, "X", X, ProgVarSet),
+ InstVarSet = varset.init,
+ Attrs = default_attributes(lang_erlang),
+ set_purity(purity_pure, Attrs, ConstantGetAttrs0),
+ set_thread_safe(proc_thread_safe, ConstantGetAttrs0, ConstantGetAttrs),
+
+ % Getter.
+ GetCode = erlang_mutable_get_code(TargetMutableName),
+ ConstantGetForeignProc = pragma_foreign_proc(
+ ConstantGetAttrs,
+ mutable_get_pred_sym_name(ModuleName, MutableName),
+ pf_predicate,
+ [pragma_var(X, "X", out_mode(Inst), native_if_possible)],
+ ProgVarSet,
+ InstVarSet,
+ fc_impl_ordinary(GetCode, yes(Context))
+ ),
+ ConstantGetClause = item_pragma(compiler(mutable_decl),
+ ConstantGetForeignProc),
+ add_item_clause(ConstantGetClause, !Status, Context, !ModuleInfo,
+ !QualInfo, !Specs),
+
+ % Secret setter.
+ SetCode = erlang_mutable_set_code(TargetMutableName),
+ ConstantSetForeignProc = pragma_foreign_proc(Attrs,
+ mutable_secret_set_pred_sym_name(ModuleName, MutableName),
+ pf_predicate,
+ [pragma_var(X, "X", in_mode(Inst), native_if_possible)],
+ ProgVarSet,
+ InstVarSet,
+ fc_impl_ordinary(SetCode, yes(Context))
+ ),
+ ConstantSetClause = item_pragma(compiler(mutable_decl),
+ ConstantSetForeignProc),
+ add_item_clause(ConstantSetClause, !Status, Context, !ModuleInfo,
+ !QualInfo, !Specs).
+
+ % Add the access predicates for a non-constant mutable.
+ % If the mutable has the `attach_to_io_state' attribute then add the
+ % versions of the access preds that take the I/O state as well.
+ %
+:- pred add_erlang_mutable_user_access_preds(string::in,
+ module_name::in, string::in, mutable_var_attributes::in, mer_inst::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_erlang_mutable_user_access_preds(TargetMutableName,
+ ModuleName, MutableName, MutAttrs, Inst,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ IsThreadLocal = mutable_var_thread_local(MutAttrs),
+ Attrs = default_attributes(lang_erlang),
+ varset.new_named_var(varset.init, "X", X, ProgVarSet0),
+
+ %
+ % Construct the semipure get predicate.
+ %
+ set_purity(purity_semipure, Attrs, GetAttrs0),
+ set_thread_safe(proc_thread_safe, GetAttrs0, GetAttrs),
(
- Backend = target_c,
- (
- IsThreadLocal = mutable_not_thread_local,
- TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
- ModuleInfo, Type)
- ;
- IsThreadLocal = mutable_thread_local,
- %
- % For thread-local mutables, the variable holds an index into an
- % array.
- %
- TypeName = "MR_Unsigned"
+ IsThreadLocal = mutable_not_thread_local,
+ GetCode = erlang_mutable_get_code(TargetMutableName)
+ ;
+ IsThreadLocal = mutable_thread_local,
+ % XXX this will need to change
+ GetCode = "X = get({'MR_thread_local_mutable', " ++
+ TargetMutableName ++ "})"
+ ),
+ GetPredName = mutable_get_pred_sym_name(ModuleName, MutableName),
+ GetForeignProc = pragma_foreign_proc(GetAttrs,
+ GetPredName,
+ pf_predicate,
+ [pragma_var(X, "X", out_mode(Inst), native_if_possible)],
+ ProgVarSet0,
+ varset.init, % Inst varset.
+ fc_impl_ordinary(GetCode, yes(Context))
+ ),
+ GetClause = item_pragma(compiler(mutable_decl), GetForeignProc),
+ add_item_clause(GetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ %
+ % Construct the impure set predicate.
+ %
+ set_purity(purity_impure, Attrs, SetAttrs0),
+ set_thread_safe(proc_thread_safe, SetAttrs0, SetAttrs),
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ SetCode = erlang_mutable_set_code(TargetMutableName)
+ ;
+ IsThreadLocal = mutable_thread_local,
+ % XXX this will need to change
+ SetCode = "put({'MR_thread_local_mutable', " ++
+ TargetMutableName ++ "}, X)"
+ ),
+ SetPredName = mutable_set_pred_sym_name(ModuleName, MutableName),
+ SetForeignProc = pragma_foreign_proc(SetAttrs,
+ SetPredName,
+ pf_predicate,
+ [pragma_var(X, "X", in_mode(Inst), native_if_possible)],
+ ProgVarSet0,
+ varset.init, % Inst varset.
+ fc_impl_ordinary(SetCode, yes(Context))
+ ),
+ SetClause = item_pragma(compiler(mutable_decl), SetForeignProc),
+ add_item_clause(SetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
+ (
+ IOStateInterface = yes,
+ varset.new_named_var(ProgVarSet0, "IO", IO, ProgVarSet),
+ Ctxt = context_init,
+
+ % Construct the pure get predicate.
+ % This just calls the semipure get predicate with a promise_pure
+ % around it.
+ CallSemipureGet = call_expr(GetPredName, [variable(X, Context)],
+ purity_semipure) - Context,
+ IOGetBody = promise_purity_expr(dont_make_implicit_promises,
+ purity_pure, CallSemipureGet) - Context,
+
+ IOGetClause = item_clause(
+ compiler(mutable_decl),
+ ProgVarSet,
+ pf_predicate,
+ GetPredName,
+ [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
+ IOGetBody
),
+
+ add_item_clause(IOGetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs),
+
+ % Construct the pure set predicate.
%
- % Constant mutables do not require mutexes as their values are never
- % updated. Thread-local mutables do not require mutexes either.
+ % We just call the impure version and attach a promise_pure
+ % pragma to the predicate. (The purity pragma was added during
+ % stage 2.)
%
- (
- ( IsConstant = yes
- ; IsThreadLocal = mutable_thread_local
- )
- ->
- LockDecl = [],
- LockDefn = []
- ;
- LockDecl = [
- "#ifdef MR_THREAD_SAFE\n",
- " extern MercuryLock ",
- mutable_mutex_var_name(TargetMutableName), ";\n",
- "#endif\n"
- ],
- LockDefn = [
- "#ifdef MR_THREAD_SAFE\n",
- " MercuryLock ",
- mutable_mutex_var_name(TargetMutableName), ";\n",
- "#endif\n"
- ]
+ CallImpureSet = call_expr(SetPredName, [variable(X, Context)],
+ purity_impure) - Context,
+ IOSetClause = item_clause(
+ compiler(mutable_decl),
+ ProgVarSet,
+ pf_predicate,
+ SetPredName,
+ [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
+ CallImpureSet
),
-
- DeclBody = string.append_list([
- "extern ", TypeName, " ", TargetMutableName, ";\n" | LockDecl]),
- Decl = item_pragma(compiler(mutable_decl),
- pragma_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody)),
- DefnBody = string.append_list([
- TypeName, " ", TargetMutableName, ";\n" | LockDefn]),
- Defn = item_pragma(compiler(mutable_decl),
- pragma_foreign_code(lang_c, DefnBody))
- ;
- ( Backend = target_il
- ; Backend = target_java
- ; Backend = target_asm
- ; Backend = target_x86_64
- ; Backend = target_erlang
- ),
- sorry(this_file, "we don't yet support mutables for non-C backends")
+ add_item_clause(IOSetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ IOStateInterface = no
).
-
-:- func global_foreign_type_name(bool, foreign_language, module_info, mer_type)
- = string.
-global_foreign_type_name(yes, _, _, _) = "MR_Word".
-global_foreign_type_name(no, Lang, ModuleInfo, Type) =
- to_type_string(Lang, ModuleInfo, Type).
+:- func erlang_mutable_get_code(string) = string.
+
+erlang_mutable_get_code(TargetMutableName) =
+ string.append_list([
+ "'ML_erlang_global_server' ! {get_mutable, ",
+ TargetMutableName, ", self()},\n",
+ "receive\n",
+ " {get_mutable_ack, Value} ->\n",
+ " X = Value\n",
+ "end\n"
+ ]).
+
+:- func erlang_mutable_set_code(string) = string.
+
+erlang_mutable_set_code(TargetMutableName) =
+ "'ML_erlang_global_server' ! {set_mutable, " ++
+ TargetMutableName ++ ", X}".
+
+ % Add the code required to initialise a mutable.
+ %
+:- pred add_erlang_mutable_initialisation(module_name::in, string::in,
+ prog_varset::in, sym_name::in, prog_term::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_erlang_mutable_initialisation(ModuleName, MutableName,
+ MutVarset, InitSetPredName, InitTerm,
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ %
+ % Add the `:- initialise' declaration for the mutable initialisation
+ % predicate.
+ %
+ InitPredName = mutable_init_pred_sym_name(ModuleName, MutableName),
+ add_item_clause(item_initialise(compiler(mutable_decl),
+ InitPredName, 0 /* Arity */),
+ !Status, Context, !ModuleInfo, !QualInfo, !Specs),
+ %
+ % Add the clause for the mutable initialisation predicate.
+ %
+ % See the comments for prog_io.parse_mutable_decl for the reason
+ % why we _must_ use MutVarset here.
+ %
+ InitClause = item_clause(compiler(mutable_decl),
+ MutVarset,
+ pf_predicate,
+ InitPredName,
+ [],
+ call_expr(InitSetPredName, [InitTerm], purity_impure) - Context
+ ),
+ add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !Specs).
+
+%-----------------------------------------------------------------------------%
:- pred add_solver_type_mutable_items_clauses(list(item)::in,
import_status::in, import_status::out, prog_context::in,
@@ -1913,6 +2237,8 @@
add_solver_type_mutable_items_clauses(Items, !Status, Context,
!ModuleInfo, !QualInfo, !Specs).
+%-----------------------------------------------------------------------------%
+
% If a module_defn updates the import_status, return the new status
% and whether uses of the following items must be module qualified,
% otherwise fail.
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.26
diff -u -r1.26 prog_item.m
--- compiler/prog_item.m 4 Mar 2007 23:38:06 -0000 1.26
+++ compiler/prog_item.m 12 Jun 2007 02:02:43 -0000
@@ -239,6 +239,9 @@
nothing_maybe_warning :: maybe(item_warning)
).
+:- inst item_mutable
+ ---> item_mutable(ground, ground, ground, ground, ground, ground).
+
:- type item_warning
---> item_warning(
maybe(option), % Option controlling whether the
Index: compiler/prog_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mutable.m,v
retrieving revision 1.21
diff -u -r1.21 prog_mutable.m
--- compiler/prog_mutable.m 19 Jan 2007 07:04:28 -0000 1.21
+++ compiler/prog_mutable.m 12 Jun 2007 02:02:43 -0000
@@ -16,7 +16,13 @@
%-----------------------------------------------------------------------------%
%
% Mutables are implemented as a source-to-source transformation on the
-% parse tree. For non-constant mutables the transformation is as follows:
+% parse tree. The transformation depends on the compilation target.
+%
+%-----------------------------------------------------------------------------%
+%
+% C BACKENDS
+%
+% For non-constant mutables the transformation is as follows:
%
% :- mutable(<varname>, <vartype>, <initvalue>, <varinst>, [attributes]).
%
@@ -70,7 +76,7 @@
%
% :- impure pred unsafe_set_<varname>(<vartype>::in(<varinst>)) is det.
% :- pragma foreign_proc("C",
-% unsafe_set_<varname)(X::in(<varinst>)),
+% unsafe_set_<varname>(X::in(<varinst>)),
% [will_not_call_mercury, thread_safe],
% "
% mutable_<varname> = X;
@@ -85,7 +91,7 @@
% ").
%
% :- impure lock_<varname> is det.
-% :- pramga foreign_proc("C",
+% :- pragma foreign_proc("C",
% lock_<varname>,
% [will_not_call_mercury, promise_pure],
% "
@@ -95,7 +101,7 @@
% ").
%
% :- impure unlock_<varname> is det.
-% :- pramga foreign_proc("C",
+% :- pragma foreign_proc("C",
% unlock_<varname>,
% [will_not_call_mercury, promise_pure],
% "
@@ -155,14 +161,14 @@
% MR_get_thread_local_mutable(<type>, X, mutable_<varname>);
% ").
%
-% :- pramga foreign_proc("C",
+% :- pragma foreign_proc("C",
% lock_<varname>,
% [will_not_call_mercury, promise_pure],
% "
% /* blank */
% ").
%
-% :- pramga foreign_proc("C",
+% :- pragma foreign_proc("C",
% unlock_<varname>,
% [will_not_call_mercury, promise_pure],
% "
@@ -206,6 +212,96 @@
% impure secret_initialization_only_set_<varname>(<initval>).
%
%-----------------------------------------------------------------------------%
+%
+% ERLANG BACKEND
+%
+% Every Erlang "process" has an associated process dictionary, which we can use
+% to implement mutables. However, since a process dictionary is local to the
+% process, it would not work (in multi-process/multi-threaded programs) to just
+% have each process work with its own process dictionary. Therefore, at
+% initialisation time we start up a global server process to hold the mutable
+% values. Other processes can get and set mutables by communicating messages
+% with this global server.
+%
+% In the transformations below, <varname> is a key derived from the name of the
+% mutable and the module name. The module name must be included.
+%
+% For non-constant mutables:
+%
+% :- mutable(<varname>, <vartype>, <initvalue>, <varinst>, [attributes]).
+%
+% ===>
+%
+% :- initialise initialise_mutable_<varname>/0.
+%
+% :- impure pred initialise_mutable_<varname> is det.
+%
+% initialise_mutable_<varname> :-
+% impure set_<varname>(<initval>).
+%
+% :- impure pred set_<varname>(<vartype>::in(<varinst>)) is det.
+% :- pragma foreign_proc("Erlang",
+% set_<varname)(X::in(<varinst>)),
+% [will_not_call_mercury, thread_safe],
+% "
+% 'ML_erlang_global_server' ! {set_mutable, <varname>, X}
+% ").
+%
+% :- semipure pred get_<varname>(<vartype>::out(<varinst>)) is det.
+% :- pragma foreign_proc("Erlang",
+% get_varname(X::out(<varinst>)),
+% [promise_semipure, will_not_call_mercury, thread_safe],
+% "
+% 'ML_erlang_global_server' ! {get_mutable, <varname>, self()}},
+% receive
+% {get_mutable_ack, Value} ->
+% X = value
+% end
+% ").
+%
+% For constant mutables:
+%
+% :- mutable(<varname>, <vartype>, <initvalue>, <varinst>, [constant]).
+%
+% ===>
+%
+% :- pred get_<varname>(<vartype>::out(<varinst>)) is det.
+% :- pragma foreign_proc("Erlang",
+% get_<varname>(X::out(<varinst>)),
+% [will_not_call_mercury, promise_pure, thread_safe],
+% "
+% 'ML_erlang_global_server' ! {get_mutable, <varname>, self()}},
+% receive
+% {get_mutable_ack, Value} ->
+% X = value
+% end
+% ").
+%
+% In order to initialise constant mutables we generate the following:
+%
+% :- impure pred secret_initialization_only_set_<varname>(
+% <vartype>::in(<varinst>)) is det.
+%
+% :- pragma foreign_proc("Erlang",
+% secret_initialization_only_set_<varname>(X::in(<varinst>)),
+% [will_not_call_mercury],
+% "
+% 'ML_erlang_global_server' ! {set_mutable, <varname>, X}
+% ").
+%
+% :- initialise initialise_mutable_<varname>/0.
+%
+% :- impure pred initialise_mutable_<varname> is det.
+%
+% initialise_mutable_<varname> :-
+% impure secret_initialization_only_set_<varname>(<initval>).
+%
+% The transformation for thread_local mutables has not been decided (we need a
+% way for spawned processes to inherit all the thread-local mutable values of
+% its parent process, but a child process in Erlang does not automatically
+% inherit its parent process's process dictionary).
+%
+%-----------------------------------------------------------------------------%
:- module parse_tree.prog_mutable.
:- interface.
Index: library/erlang.m
===================================================================
RCS file: library/erlang.m
diff -N library/erlang.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/erlang.m 12 Jun 2007 02:02:44 -0000
@@ -0,0 +1,112 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: erlang.m.
+% Main author: wangp.
+% Stability: low.
+%
+% This file is intended to hold things related to Erlang for the Erlang grade.
+% In non-Erlang grades this file should do nothing.
+%
+% Currently it just contains a server that is started at program initialisation
+% to emulate global variables. Lookups and updates of global mutables work by
+% sending and receiving messages to this server.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module erlang.
+:- interface.
+
+% This module exports nothing yet for public consumption.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+% Everything below here is not intended to be part of the public interface,
+% and will not be included in the Mercury library reference manual.
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred start_global_server(io::di, io::uo) is det.
+:- pred stop_global_server(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("Erlang",
+ start_global_server(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Pid = spawn(fun global_server_loop/0),
+ register('ML_erlang_global_server', Pid)
+").
+
+start_global_server(!IO).
+
+:- pragma foreign_proc("Erlang",
+ stop_global_server(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ 'ML_erlang_global_server' ! {stop, self()},
+ receive
+ {stop_ack} ->
+ void
+ end.
+").
+
+stop_global_server(!IO).
+
+:- pragma foreign_code("Erlang", "
+
+mutable_key(MutableName) ->
+ {'ML_mutables', MutableName}.
+
+global_server_loop() ->
+ receive
+ {get_mutable, MutableName, From} ->
+ Value = get(mutable_key(MutableName)),
+ From ! {get_mutable_ack, Value},
+ global_server_loop();
+
+ {set_mutable, MutableName, Value} ->
+ put(mutable_key(MutableName), Value),
+ global_server_loop();
+
+ {stop} ->
+ From ! {stop_ack};
+
+ Any ->
+ io:format(
+ ""** erlang_global_server ignoring unrecognised message: ~p~n"",
+ [Any]),
+ global_server_loop()
+ end.
+").
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "erlang.m".
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: library/library.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.107
diff -u -r1.107 library.m
--- library/library.m 7 Jun 2007 06:14:00 -0000 1.107
+++ library/library.m 12 Jun 2007 02:02:56 -0000
@@ -142,6 +142,7 @@
:- import_module version_types.
% The modules intended for Mercury system implementors.
+:- import_module erlang.
:- import_module erlang_rtti_implementation.
:- import_module mutvar.
:- import_module par_builtin.
@@ -211,6 +212,7 @@
mercury_std_library_module("dir").
mercury_std_library_module("enum").
mercury_std_library_module("eqvclass").
+mercury_std_library_module("erlang").
mercury_std_library_module("erlang_rtti_implementation").
mercury_std_library_module("exception").
mercury_std_library_module("float").
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.321
diff -u -r1.321 Mmakefile
--- tests/hard_coded/Mmakefile 8 Jun 2007 00:47:51 -0000 1.321
+++ tests/hard_coded/Mmakefile 12 Jun 2007 02:02:56 -0000
@@ -301,6 +301,14 @@
mutable_decl
endif
+# Mutables work properly only in C grades and Erlang grades.
+ifeq "$(filter il% java%,$(GRADE))" ""
+ MUTABLE_PROGS = \
+ float_gv
+else
+ MUTABLE_PROGS =
+endif
+
# Tests of the C#, MC++, and IL foreign language interfaces only
# work in IL grades
ifeq "$(filter il%,$(GRADE))" ""
@@ -321,14 +329,12 @@
# Fact tables currently work only in the C grades.
# The foreign_type_assertion test is currently meaningful only in C grades.
-# Mutables work properly only in C grades.
# Trace goal with runtime conditions work properly only in C grades.
# The lookup_disj test case uses C foreign_proc code to print progress reports.
ifeq "$(filter il% java% erlang%,$(GRADE))" ""
C_ONLY_PROGS= \
factt \
factt_sort_test \
- float_gv \
foreign_type_assertion \
lookup_disj \
trace_goal_env_1 \
@@ -548,7 +554,8 @@
$(BACKEND_PROGS) $(NONDET_C_PROGS) \
$(C_AND_GC_ONLY_PROGS) $(STATIC_LINK_PROGS) \
$(CHAR_REP_PROGS) $(C_ONLY_PROGS) \
- $(DOTNET_PROGS) $(JAVA_PROGS) $(TRAILED_PROGS)
+ $(DOTNET_PROGS) $(JAVA_PROGS) $(TRAILED_PROGS) \
+ $(MUTABLE_PROGS)
endif
#-----------------------------------------------------------------------------#
Index: tests/hard_coded/float_gv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/float_gv.m,v
retrieving revision 1.1
diff -u -r1.1 float_gv.m
--- tests/hard_coded/float_gv.m 24 Feb 2006 01:42:13 -0000 1.1
+++ tests/hard_coded/float_gv.m 12 Jun 2007 02:02:56 -0000
@@ -19,6 +19,7 @@
:- type coord.
:- pragma foreign_type(c, coord, "coord *").
+:- pragma foreign_type("Erlang", coord, "").
:- pragma foreign_decl(c, "
typedef struct {
@@ -54,6 +55,27 @@
Y = C->y;
").
+:- pragma foreign_proc("Erlang",
+ new_coord(X::in, Y::in) = (C::out),
+ [will_not_call_mercury, promise_pure],
+"
+ C = {X, Y}
+").
+
+:- pragma foreign_proc("Erlang",
+ x(C::in) = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ {X, _} = C
+").
+
+:- pragma foreign_proc("Erlang",
+ y(C::in) = (Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ {_, Y} = C
+").
+
:- mutable(gv1,float,0.0,ground,[untrailed]).
:- mutable(gv2,float,2.3,ground,[untrailed]).
:- mutable(gv3,string,"",ground,[untrailed]).
Index: tests/hard_coded/sub-modules/non_word_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/sub-modules/non_word_mutable.m,v
retrieving revision 1.1
diff -u -r1.1 non_word_mutable.m
--- tests/hard_coded/sub-modules/non_word_mutable.m 24 Feb 2006 01:42:16 -0000 1.1
+++ tests/hard_coded/sub-modules/non_word_mutable.m 12 Jun 2007 02:03:01 -0000
@@ -22,6 +22,7 @@
:- type coord.
:- pragma foreign_type(c, coord, "coord *").
+:- pragma foreign_type("Erlang", coord, "").
:- pragma foreign_decl(c, "
typedef struct {
@@ -57,6 +58,28 @@
Y = C->y;
").
+:- pragma foreign_proc("Erlang",
+ new_coord(X::in, Y::in) = (C::out),
+ [will_not_call_mercury, promise_pure],
+"
+ C = {X, Y}
+").
+
+:- pragma foreign_proc("Erlang",
+ x(C::in) = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ {X, _} = C
+").
+
+:- pragma foreign_proc("Erlang",
+ y(C::in) = (Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ {_, Y} = C
+").
+
+
:- pragma promise_pure(main/2).
main(!IO) :-
% Check whether we get back the same value as we set.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list