[m-rev.] for reviews: finalise declarations (part 2)
Julien Fischer
juliensf at cs.mu.OZ.AU
Thu Sep 29 03:13:45 AEST 2005
Estimated hours taken: 8
Branches: main
Add language and compiler support for finalise declarations.
NEWS:
Mention finalise declarations.
compiler/prog_data.m:
Add a new item type for finalise declarations.
Add a new kind of item origin - items can now be introduced as part of
the source-to-source transformation that implements finalise
declarations.
compiler/prog_io.m:
Parse finalise declarations.
compiler/modules.m:
Don't write out finalise declarations in private interfaces.
compiler/hlds_module.m:
Add a slot to the HLDS that stores the names of the predicates in
finalise declarations.
Add access predicates for the above.
compiler/add_pragma.m:
compiler/make_hlds_passes.m:
Fix in incorrect comment: we add initialise declarations on third, not
second, pass.
Restore the code that use the enhanced switch detection capability.
Implement the source-to-source transformation that implements finalise
declarations. This is almost identical to that for intitialise
declarations.
compiler/llds.m:
compiler/llds_out.m:
compiler/transform_llds.m:
Add a slot to the LLDS to hold the name of the predicates specified in
the finalise declarations.
Emit the necessary code to call these predicates after main has finished.
compiler/mlds.m:
compiler/ml_code_gen.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_tailcall.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_ilasm.m:
compiler/mlds_to_java.m:
compiler/mlds_to_managed.m:
As above, but for the MLDS.
compiler/mercury_compile.m:
Conform to changes in the MLDS.
XXX This module probably shouldn't manipulating the MLDS directly.
compiler/module_qual.m:
compiler/mercury_to_mercury.m:
compiler/recompilation.check.m:
compiler/recompilation.version.m:
Conform to the above changes.
library/ops.m:
Add `finalise' as an operator.
runtime/mercury_wrapper.c:
Call any user specified finalise predicates from
mercury_runtime_terminate.
doc/reference_manual.texi:
Document finalise declarations.
tests/hard_coded/Mmakefile:
tests/hard_coded/finalise_decl.m:
tests/hard_coded/finalise_decl.exp:
Tests finalise declarations.
tests/hard_coded/sub-modules/Mmakefile:
tests/hard_coded/sub-modules/finalise_child.m:
tests/hard_coded/sub-modules/finalise_parent.m:
tests/hard_coded/sub-modules/finalise_parent.{exp,exp2}:
Test finalise declarations and sub-modules. There are two expected
outputs because the order of execution between a parent module and its
children of any finalisers is arbitrary.
tests/invalid/Mmakefile:
tests/invalid/bad_finalise_decl.m:
tests/invalid/bad_finalise_decl.err_exp:
Test error messages associated with finalise declarations.
Julien.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.387
diff -u -r1.387 NEWS
--- NEWS 26 Sep 2005 06:52:06 -0000 1.387
+++ NEWS 28 Sep 2005 07:40:17 -0000
@@ -6,7 +6,7 @@
Changes to the Mercury language:
* The Mercury typeclass system now supports functional dependencies.
-* We now have support for optional module initialisation.
+* We now have support for optional module initialisation and finalisation.
* We now have support for impure module-local mutable variables.
* Support for the old-style lambda, mode and pragma syntax has been removed.
* ':' is now the type qualification operator, not a module qualifier.
@@ -43,7 +43,11 @@
details.
* We have added support for optional module initialisation. See the
- "Optional module initialisation" section of the Mercury Language Reference
+ "Module initialisation" section of the Mercury Language Reference
+ Manual for details.
+
+* We have added support for optional module finalisation. See the
+ "Module finalisation" section of the Mercury Language Reference
Manual for details.
* We have added support for impure module-local mutable variables.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.9
diff -u -r1.9 add_pragma.m
--- compiler/add_pragma.m 12 Sep 2005 08:41:54 -0000 1.9
+++ compiler/add_pragma.m 23 Sep 2005 07:39:38 -0000
@@ -394,10 +394,9 @@
;
Details = mutable_decl
;
- Details = solver_type,
- unexpected(this_file, "Bad introduced export pragma.")
- ;
- Details = foreign_imports,
+ Details = finalise_decl
+ ;
+ ( Details = solver_type ; Details = foreign_imports ),
unexpected(this_file, "Bad introduced export pragma.")
)
)
@@ -414,10 +413,9 @@
;
Details = mutable_decl
;
- Details = solver_type,
- unexpected(this_file, "Bad introduced export pragma.")
- ;
- Details = foreign_imports,
+ Details = finalise_decl
+ ;
+ ( Details = solver_type ; Details = foreign_imports ),
unexpected(this_file, "Bad introduced export pragma.")
)
)
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.118
diff -u -r1.118 hlds_module.m
--- compiler/hlds_module.m 13 Sep 2005 04:56:03 -0000 1.118
+++ compiler/hlds_module.m 28 Sep 2005 13:04:15 -0000
@@ -444,6 +444,15 @@
:- pred module_info_user_init_pred_c_names(module_info::in,
list(string)::out) is det.
+:- pred module_info_new_user_final_pred(sym_name::in, string::out,
+ module_info::in, module_info::out) is det.
+
+:- pred module_info_user_final_pred_c_name(module_info::in, sym_name::in,
+ string::out) is det.
+
+:- pred module_info_user_final_pred_c_names(module_info::in,
+ list(string)::out) is det.
+
%-----------------------------------------------------------------------------%
:- pred module_info_preds(module_info::in, pred_table::out) is det.
@@ -680,7 +689,12 @@
% Exported C names for preds appearing in `:- initialise
% initpred' directives in this module, in order of appearance.
- user_init_pred_c_names :: assoc_list(sym_name, string)
+ user_init_pred_c_names :: assoc_list(sym_name, string),
+
+ % Export C names fored pred appearing in `:- finalise
+ % finalpred' directives in this module, in order of
+ % appearance.
+ user_final_pred_c_names :: assoc_list(sym_name, string)
).
module_info_init(Name, Items, Globals, QualifierInfo, RecompInfo,
@@ -722,7 +736,7 @@
map.init, counter__init(1), ImportedModules,
IndirectlyImportedModules, no_aditi_compilation, TypeSpecInfo,
NoTagTypes, no, [], init_analysis_info(mmc),
- [], counter__init(1), []),
+ [], counter__init(1), [], []),
ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, SuperClassTable, InstanceTable, AssertionTable,
@@ -843,7 +857,32 @@
module_info_user_init_pred_c_names(MI, CNames) :-
InitPredCNames = MI ^ sub_info ^ user_init_pred_c_names,
- CNames = list__map(snd, InitPredCNames).
+ CNames = assoc_list.values(InitPredCNames).
+
+module_info_new_user_final_pred(SymName, CName, MI0, MI) :-
+ FinalPredCNames0 = MI0 ^ sub_info ^ user_final_pred_c_names,
+ UserFinalPredNo = list.length(FinalPredCNames0),
+ module_info_name(MI0, ModuleSymName),
+ ModuleName = prog_foreign.sym_name_mangle(ModuleSymName),
+ CName = string.format("%s__user_final_pred_%d",
+ [s(ModuleName), i(UserFinalPredNo)]),
+ FinalPredCNames = FinalPredCNames0 ++ [SymName - CName],
+ MI = MI0 ^ sub_info ^ user_final_pred_c_names := FinalPredCNames.
+
+module_info_user_final_pred_c_name(MI, SymName, CName) :-
+ FinalPredCNames = MI ^ sub_info ^ user_final_pred_c_names,
+ ( assoc_list__search(FinalPredCNames, SymName, CName0) ->
+ CName = CName0
+ ;
+ module_info_name(MI, ModuleSymName),
+ ModuleName = sym_name_to_string(ModuleSymName),
+ unexpected(ModuleName,
+ "lookup failure in module_info_user_final_pred_c_name")
+ ).
+
+module_info_user_final_pred_c_names(MI, CNames) :-
+ FinalPredCNames = MI ^ sub_info ^ user_final_pred_c_names,
+ CNames = assoc_list.values(FinalPredCNames).
%-----------------------------------------------------------------------------%
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.318
diff -u -r1.318 llds.m
--- compiler/llds.m 14 Sep 2005 01:29:08 -0000 1.318
+++ compiler/llds.m 28 Sep 2005 06:55:55 -0000
@@ -64,14 +64,15 @@
:- type c_file
---> c_file(
- cfile_modulename :: module_name,
- cfile_foreign_decl :: foreign_decl_info,
- cfile_foreign_code :: list(user_foreign_code),
- cfile_foreign_export :: list(foreign_export),
- cfile_vars :: list(comp_gen_c_var),
- cfile_data :: list(comp_gen_c_data),
- cfile_code :: list(comp_gen_c_module),
- cfile_user_init_pred_c_names :: list(string)
+ cfile_modulename :: module_name,
+ cfile_foreign_decl :: foreign_decl_info,
+ cfile_foreign_code :: list(user_foreign_code),
+ cfile_foreign_export :: list(foreign_export),
+ cfile_vars :: list(comp_gen_c_var),
+ cfile_data :: list(comp_gen_c_data),
+ cfile_code :: list(comp_gen_c_module),
+ cfile_user_init_pred_c_names :: list(string),
+ cfile_user_final_pred_c_names :: list(string)
).
% Global variables generated by the compiler.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.260
diff -u -r1.260 llds_out.m
--- compiler/llds_out.m 23 Sep 2005 07:10:50 -0000 1.260
+++ compiler/llds_out.m 28 Sep 2005 07:06:19 -0000
@@ -237,7 +237,7 @@
output_llds(C_File, ComplexityProcs, StackLayoutLabels, MaybeRLFile, !IO) :-
C_File = c_file(ModuleName, C_HeaderInfo, UserForeignCodes, Exports, Vars,
- Datas, Modules, UserInitPredCNames),
+ Datas, Modules, UserInitPredCNames, UserFinalPredCNames),
globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
(
SplitFiles = yes,
@@ -246,7 +246,7 @@
output_split_c_file_init(ModuleName, Modules, Datas, Vars,
ComplexityProcs, StackLayoutLabels, MaybeRLFile,
- UserInitPredCNames, !IO),
+ UserInitPredCNames, UserFinalPredCNames, !IO),
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
C_HeaderInfo, ComplexityProcs, StackLayoutLabels, 1, Num1, !IO),
output_split_c_exports(Exports, ModuleName,
@@ -283,7 +283,7 @@
ModuleName, C_HeaderLines, ComplexityProcs, StackLayoutLabels,
!Num, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, [UserForeignCode],
- [], [], [], [], []),
+ [], [], [], [], [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -297,7 +297,7 @@
output_split_c_exports([], _, _, _, _, !Num, !IO).
output_split_c_exports([Export | Exports], ModuleName, C_HeaderLines,
ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
- CFile = c_file(ModuleName, C_HeaderLines, [], [Export], [], [], [], []),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [Export], [], [], [], [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -312,7 +312,7 @@
output_split_comp_gen_c_vars([], _, _, _, _, !Num, !IO).
output_split_comp_gen_c_vars([Var | Vars], ModuleName, C_HeaderLines,
ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
- CFile = c_file(ModuleName, C_HeaderLines, [], [], [Var], [], [], []),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [Var], [], [], [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -327,7 +327,7 @@
output_split_comp_gen_c_datas([], _, _, _, _, !Num, !IO).
output_split_comp_gen_c_datas([Data | Datas], ModuleName, C_HeaderLines,
ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
- CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [Data], [], []),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [Data], [], [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -342,7 +342,8 @@
output_split_comp_gen_c_modules([], _, _, _, _, !Num, !IO).
output_split_comp_gen_c_modules([Module | Modules], ModuleName, C_HeaderLines,
ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
- CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [], [Module], []),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [], [Module],
+ [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -352,10 +353,12 @@
:- pred output_split_c_file_init(module_name::in, list(comp_gen_c_module)::in,
list(comp_gen_c_data)::in, list(comp_gen_c_var)::in,
list(complexity_proc_info)::in, map(label, data_addr)::in,
- maybe(rl_file)::in, list(string)::in, io::di, io::uo) is det.
+ maybe(rl_file)::in, list(string)::in, list(string)::in,
+ io::di, io::uo) is det.
output_split_c_file_init(ModuleName, Modules, Datas, Vars, ComplexityProcs,
- StackLayoutLabels, MaybeRLFile, UserInitPredCNames, !IO) :-
+ StackLayoutLabels, MaybeRLFile, UserInitPredCNames,
+ UserFinalPredCNames, !IO) :-
module_name_to_file_name(ModuleName, ".m", no, SourceFileName, !IO),
module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName, !IO),
@@ -365,7 +368,8 @@
library__version(Version),
io__set_output_stream(FileStream, OutputStream, !IO),
output_c_file_intro_and_grade(SourceFileName, Version, !IO),
- output_init_comment(ModuleName, UserInitPredCNames, !IO),
+ output_init_comment(ModuleName, UserInitPredCNames,
+ UserFinalPredCNames, !IO),
output_c_file_mercury_headers(!IO),
io__write_string("\n", !IO),
decl_set_init(DeclSet0),
@@ -419,7 +423,7 @@
output_single_c_file(CFile, SplitFiles, ComplexityProcs, StackLayoutLabels,
MaybeRLFile, !IO) :-
- CFile = c_file(ModuleName, _, _, _, _, _, _, _),
+ CFile = c_file(ModuleName, _, _, _, _, _, _, _, _),
(
SplitFiles = yes(Num),
module_name_to_split_c_file_name(ModuleName, Num, ".c", FileName, !IO)
@@ -455,7 +459,7 @@
do_output_single_c_file(CFile, SplitFiles, ComplexityProcs, StackLayoutLabels,
MaybeRLFile, FileStream, !DeclSet, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, UserForeignCode, Exports,
- Vars, Datas, Modules, UserInitPredCNames),
+ Vars, Datas, Modules, UserInitPredCNames, UserFinalPredCNames),
library__version(Version),
io__set_output_stream(FileStream, OutputStream, !IO),
module_name_to_file_name(ModuleName, ".m", no, SourceFileName, !IO),
@@ -464,7 +468,8 @@
SplitFiles = yes(_)
;
SplitFiles = no,
- output_init_comment(ModuleName, UserInitPredCNames, !IO)
+ output_init_comment(ModuleName, UserInitPredCNames,
+ UserFinalPredCNames, !IO)
),
output_c_file_mercury_headers(!IO),
@@ -946,12 +951,14 @@
output_tabling_pointer_var_name(ProcLabel, !IO),
io__write_string(".MR_integer = 0;\n", !IO).
- % Output a comment to tell mkinit what functions to
- % call from <module>_init.c.
+ % Output a comment to tell mkinit what functions to call from
+ % <module>_init.c.
+ %
:- pred output_init_comment(module_name::in, list(string)::in,
- io::di, io::uo) is det.
+ list(string)::in, io::di, io::uo) is det.
-output_init_comment(ModuleName, UserInitPredCNames, !IO) :-
+output_init_comment(ModuleName, UserInitPredCNames, UserFinalPredCNames,
+ !IO) :-
io__write_string("/*\n", !IO),
io__write_string("INIT ", !IO),
output_init_name(ModuleName, !IO),
@@ -967,6 +974,7 @@
Aditi = no
),
list__foldl(output_required_user_init_comment, UserInitPredCNames, !IO),
+ list__foldl(output_required_user_final_comment, UserFinalPredCNames, !IO),
io__write_string("ENDINIT\n", !IO),
io__write_string("*/\n\n", !IO).
@@ -977,6 +985,13 @@
io__write_string(CName, !IO),
io__nl(!IO).
+:- pred output_required_user_final_comment(string::in, io::di, io::uo) is det.
+
+output_required_user_final_comment(CName, !IO) :-
+ io__write_string("REQUIRED_FINAL ", !IO),
+ io__write_string(CName, !IO),
+ io__nl(!IO).
+
:- pred output_bunch_name(module_name::in, string::in, int::in, io::di, io::uo)
is det.
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.10
diff -u -r1.10 make_hlds_passes.m
--- compiler/make_hlds_passes.m 15 Sep 2005 07:38:43 -0000 1.10
+++ compiler/make_hlds_passes.m 23 Sep 2005 07:20:51 -0000
@@ -442,8 +442,11 @@
% an instance declaration before its class declaration.
Item = instance(_, _, _, _, _,_).
add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !IO) :-
- % We add initialise declarations on the second pass.
+ % We add initialise declarations on the third pass.
Item = initialise(_, _).
+add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !IO) :-
+ % We add finalise declarations on the third pass.
+ Item = finalise(_, _).
add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !IO) :-
% We add the initialise decl and the foreign_decl on the second pass and
% the foreign_proc clauses on the third pass.
@@ -538,7 +541,7 @@
module_add_instance_defn(InstanceModuleName, Constraints, Name, Types,
Body, VarSet, BodyStatus, Context, !ModuleInfo, !IO).
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
- % These are process properly during pass 3, we just do some
+ % These are processed properly during pass 3, we just do some
% error checking at this point.
Item = initialise(Origin, _),
!.Status = item_status(ImportStatus, _),
@@ -554,20 +557,37 @@
% introduced because of a mutable declaration.
Details = mutable_decl
;
- Details = initialise_decl,
- unexpected(this_file, "Bad introduced intialise declaration.")
- ;
- Details = solver_type,
- unexpected(this_file, "Bad introduced intialise declaration.")
- ;
- Details = foreign_imports,
- unexpected(this_file, "Bad introduced intialise declaration.")
+ ( Details = initialise_decl
+ ; Details = solver_type
+ ; Details = foreign_imports
+ ; Details = finalise_decl
+ ),
+ unexpected(this_file, "Bad introduced initialise declaration.")
)
)
;
true
).
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
+ % There are processed properly during pass 3, we just do some error
+ % checking at this point.
+ Item = finalise(Origin, _),
+ !.Status = item_status(ImportStatus, _),
+ ( ImportStatus = exported ->
+ (
+ Origin = user,
+ error_is_exported(Context, "`finalise' declaration", !IO),
+ module_info_incr_errors(!ModuleInfo)
+ ;
+ % There are no source-to-source transformations that introduce
+ % finalise declarations.
+ Origin = compiler(_),
+ unexpected(this_file, "Bad introduced finalise declaration.")
+ )
+ ;
+ true
+ ).
+add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
Item = mutable(Name, _Type, _InitTerm, _Inst, _MutAttrs),
!.Status = item_status(ImportStatus, _),
( ImportStatus = exported ->
@@ -614,15 +634,14 @@
Origin = compiler(Details),
(
% Ignore clauses that are introduced as a result of
- % `intialise' or `mutable' declarations.
+ % `intialise', `finalise' or `mutable' declarations.
Details = initialise_decl
;
Details = mutable_decl
;
- Details = solver_type,
- unexpected(this_file, "Bad introduced clauses.")
+ Details = finalise_decl
;
- Details = foreign_imports,
+ ( Details = solver_type ; Details = foreign_imports ),
unexpected(this_file, "Bad introduced clauses.")
)
)
@@ -883,6 +902,75 @@
;
unexpected(this_file, "Bad introduced initialise declaration.")
).
+add_item_clause(finalise(Origin, SymName), !Status, Context, !ModuleInfo,
+ !QualInfo, !IO) :-
+ %
+ % To handle a `:- finalise finalpred.' declaration we need to:
+ % (1) construct a new C function name, CName, to use to export finalpred,
+ % (2) add `:- pragma export(finalpred(di, uo), CName).',
+ % (3) record the finalpred/cname pair in the ModuleInfo so that
+ % code generation can ensure cname is called during module finalisation.
+ %
+ ( Origin \= user ->
+ unexpected(this_file, "Bad introduced finalise declaration.")
+ ;
+ true
+ ),
+ module_info_get_predicate_table(!.ModuleInfo, PredTable),
+ (
+ predicate_table_search_pred_sym_arity(PredTable,
+ may_be_partially_qualified, SymName, 2 /* Arity */, PredIds)
+ ->
+ (
+ PredIds = [PredId]
+ ->
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ pred_info_arg_types(PredInfo, ArgTypes),
+ pred_info_procedures(PredInfo, ProcTable),
+ ProcInfos = map.values(ProcTable),
+ (
+ ArgTypes = [Arg1Type, Arg2Type],
+ type_util__type_is_io_state(Arg1Type),
+ type_util__type_is_io_state(Arg2Type),
+ list.member(ProcInfo, ProcInfos),
+ proc_info_maybe_declared_argmodes(ProcInfo, MaybeHeadModes),
+ MaybeHeadModes = yes(HeadModes),
+ HeadModes = [ di_mode, uo_mode ],
+ proc_info_declared_determinism(ProcInfo, MaybeDetism),
+ MaybeDetism = yes(Detism),
+ ( Detism = det ; Detism = cc_multidet )
+ ->
+ module_info_new_user_final_pred(SymName, CName, !ModuleInfo),
+ PragmaExportItem =
+ pragma(compiler(finalise_decl),
+ export(SymName, predicate, [di_mode, uo_mode], CName)),
+ add_item_clause(PragmaExportItem, !Status, Context,
+ !ModuleInfo, !QualInfo, !IO)
+ ;
+ write_error_pieces(Context, 0,
+ [
+ words("Error:"),
+ sym_name_and_arity(SymName/2),
+ words("used in finalise declaration does not"),
+ words("have signature"),
+ fixed("`pred(io::di, io::uo) is det'")
+ ], !IO),
+ module_info_incr_errors(!ModuleInfo)
+ )
+ ;
+ write_error_pieces(Context, 0, [words("Error:"),
+ sym_name_and_arity(SymName/2),
+ words(" used in finalise declaration has " ++
+ "multiple pred declarations.")], !IO),
+ module_info_incr_errors(!ModuleInfo)
+ )
+ ;
+ write_error_pieces(Context, 0, [words("Error:"),
+ sym_name_and_arity(SymName/2),
+ words(" used in finalise declaration does " ++
+ "not have a corresponding pred declaration.")], !IO),
+ module_info_incr_errors(!ModuleInfo)
+ ).
add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO) :-
Item = mutable(Name, _Type, InitTerm, Inst, MutAttrs),
( status_defined_in_this_module(!.Status, yes) ->
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.349
diff -u -r1.349 mercury_compile.m
--- compiler/mercury_compile.m 26 Sep 2005 05:48:08 -0000 1.349
+++ compiler/mercury_compile.m 28 Sep 2005 07:19:49 -0000
@@ -1648,7 +1648,7 @@
mlds_has_main(MLDS) =
(
- MLDS = mlds(_, _, _, Defns, _),
+ MLDS = mlds(_, _, _, Defns, _, _),
defns_contain_main(Defns)
->
has_main
@@ -4115,9 +4115,11 @@
C_LocalHeaderCode ++ [Start | C_ExportedHeaderCode] ++ [End],
module_info_user_init_pred_c_names(ModuleInfo, UserInitPredCNames),
+ module_info_user_final_pred_c_names(ModuleInfo, UserFinalPredCNames),
CFile = c_file(ModuleSymName, C_HeaderCode, C_BodyCode, C_ExportDefns,
- GlobalVars, AllData, ChunkedModules, UserInitPredCNames),
+ GlobalVars, AllData, ChunkedModules, UserInitPredCNames,
+ UserFinalPredCNames),
list__length(C_BodyCode, UserCCodeCount),
list__length(C_ExportDefns, ExportCount),
list__length(GlobalVars, CompGenVarCount),
@@ -4426,9 +4428,10 @@
list__condense([TypeCtorRtti, TypeClassInfoRtti,
NewTypeClassInfoRttiData, AditiProcInfoRtti], RttiData),
RttiDefns = rtti_data_list_to_mlds(HLDS, RttiData),
- MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0, InitPreds),
+ MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0, InitPreds,
+ FinalPreds),
list__append(RttiDefns, Defns0, Defns),
- MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds).
+ MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds, FinalPreds).
% The `--high-level-C' MLDS output pass
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.268
diff -u -r1.268 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 12 Sep 2005 05:24:12 -0000 1.268
+++ compiler/mercury_to_mercury.m 23 Sep 2005 07:28:06 -0000
@@ -765,6 +765,10 @@
io__write_string(":- initialise ", !IO),
mercury_output_sym_name(PredSymName, !IO),
io__write_string(".\n", !IO).
+mercury_output_item(_, finalise(_, PredSymName), _, !IO) :-
+ io.write_string(":- finalise ", !IO),
+ mercury_output_sym_name(PredSymName, !IO),
+ io.write_string(".\n", !IO).
mercury_output_item(_, mutable(Name, Type, InitTerm, Inst, Attrs), _, !IO) :-
io__write_string(":- mutable(", !IO),
io__write_string(Name, !IO),
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.157
diff -u -r1.157 ml_code_gen.m
--- compiler/ml_code_gen.m 26 Sep 2005 05:48:09 -0000 1.157
+++ compiler/ml_code_gen.m 28 Sep 2005 06:01:53 -0000
@@ -808,7 +808,8 @@
ml_gen_imports(ModuleInfo, Imports),
ml_gen_defns(ModuleInfo, Defns, !IO),
module_info_user_init_pred_c_names(ModuleInfo, InitPreds),
- MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds).
+ module_info_user_final_pred_c_names(ModuleInfo, FinalPreds),
+ MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds, FinalPreds).
:- pred ml_gen_foreign_code(module_info::in,
map(foreign_language, mlds__foreign_code)::out,
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.72
diff -u -r1.72 ml_elim_nested.m
--- compiler/ml_elim_nested.m 13 Sep 2005 01:19:56 -0000 1.72
+++ compiler/ml_elim_nested.m 23 Sep 2005 07:48:58 -0000
@@ -466,7 +466,8 @@
%
ml_elim_nested(Action, MLDS0, MLDS, !IO) :-
globals__io_get_globals(Globals, !IO),
- MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0, InitPreds),
+ MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0, InitPreds,
+ FinalPreds),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
OuterVars = [],
DefnsList = list__map(
@@ -479,7 +480,8 @@
% So we need to check for and eliminate any duplicate definitions
% of constants.
Defns = list__remove_dups(Defns1),
- MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds).
+ MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds,
+ FinalPreds).
% Either eliminated nested functions:
% Hoist out any nested function occurring in a single mlds__defn.
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.32
diff -u -r1.32 ml_optimize.m
--- compiler/ml_optimize.m 13 Sep 2005 01:19:56 -0000 1.32
+++ compiler/ml_optimize.m 23 Sep 2005 07:51:21 -0000
@@ -72,10 +72,9 @@
optimize(MLDS0, MLDS, !IO) :-
globals__io_get_globals(Globals, !IO),
- MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0, InitPreds),
- Defns = optimize_in_defns(Defns0, Globals,
- mercury_module_name_to_mlds(ModuleName)),
- MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds).
+ Defns = optimize_in_defns(MLDS0 ^ defns, Globals,
+ mercury_module_name_to_mlds(MLDS0 ^ name)),
+ MLDS = MLDS0 ^ defns := Defns.
:- func optimize_in_defns(mlds__defns, globals, mlds_module_name)
= mlds__defns.
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.28
diff -u -r1.28 ml_tailcall.m
--- compiler/ml_tailcall.m 13 Sep 2005 01:19:57 -0000 1.28
+++ compiler/ml_tailcall.m 23 Sep 2005 07:52:41 -0000
@@ -90,9 +90,7 @@
:- import_module string.
ml_mark_tailcalls(MLDS0, MLDS, !IO) :-
- MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0, InitPreds),
- Defns = mark_tailcalls_in_defns(Defns0),
- MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds).
+ MLDS = MLDS0 ^ defns := mark_tailcalls_in_defns(MLDS0 ^ defns).
%-----------------------------------------------------------------------------%
@@ -525,7 +523,7 @@
:- pred nontailcall_in_mlds(mlds::in, tailcall_warning::out) is nondet.
nontailcall_in_mlds(MLDS, Warning) :-
- MLDS = mlds(ModuleName, _ForeignCode, _Imports, Defns, _InitPreds),
+ MLDS = mlds(ModuleName, _ForeignCode, _Imports, Defns, _InitPreds, _),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
nontailcall_in_defns(MLDS_ModuleName, Defns, Warning).
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.121
diff -u -r1.121 mlds.m
--- compiler/mlds.m 1 Sep 2005 09:06:33 -0000 1.121
+++ compiler/mlds.m 23 Sep 2005 07:53:04 -0000
@@ -372,10 +372,11 @@
% Definitions of code and data
defns :: mlds__defns,
- % The names of init preds.
- % XXX This only works for the C backend, because
+ % The names of init and final preds.
+ % XXX These only work for the C backend, because
% pragma export doesn't work for the other backends.
- init_preds :: list(string)
+ init_preds :: list(string),
+ final_preds :: list(string)
).
:- func mlds__get_module_name(mlds) = mercury_module_name.
@@ -1760,7 +1761,7 @@
%-----------------------------------------------------------------------------%
-mlds__get_module_name(mlds(ModuleName, _, _, _, _)) = ModuleName.
+mlds__get_module_name(mlds(ModuleName, _, _, _, _, _)) = ModuleName.
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.173
diff -u -r1.173 mlds_to_c.m
--- compiler/mlds_to_c.m 12 Sep 2005 05:24:15 -0000 1.173
+++ compiler/mlds_to_c.m 28 Sep 2005 06:35:06 -0000
@@ -150,7 +150,8 @@
:- pred mlds_output_hdr_file(indent::in, mlds::in, io::di, io::uo) is det.
mlds_output_hdr_file(Indent, MLDS, !IO) :-
- MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns, _InitPreds),
+ MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns, _InitPreds,
+ _FinalPreds),
mlds_output_hdr_start(Indent, ModuleName, !IO),
io__nl(!IO),
mlds_output_hdr_imports(Indent, Imports, !IO),
@@ -255,11 +256,15 @@
io::di, io::uo) is det.
mlds_output_src_file(Indent, MLDS, MaybeRLFile, !IO) :-
- MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns, InitPreds),
- % Get the foreign code for C
+ MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns,
+ InitPreds, FinalPreds),
+ %
+ % Get the foreign code for C.
+ %
ForeignCode = mlds_get_c_foreign_code(AllForeignCode),
- mlds_output_src_start(Indent, ModuleName, ForeignCode, InitPreds, !IO),
+ mlds_output_src_start(Indent, ModuleName, ForeignCode, InitPreds,
+ FinalPreds, !IO),
io__nl(!IO),
mlds_output_src_imports(Indent, Imports, !IO),
io__nl(!IO),
@@ -354,9 +359,11 @@
io__write_string("#include ""mercury.h""\n", !IO).
:- pred mlds_output_src_start(indent::in, mercury_module_name::in,
- mlds__foreign_code::in, list(string)::in, io::di, io::uo) is det.
+ mlds__foreign_code::in, list(string)::in, list(string)::in,
+ io::di, io::uo) is det.
-mlds_output_src_start(Indent, ModuleName, ForeignCode, InitPreds, !IO) :-
+mlds_output_src_start(Indent, ModuleName, ForeignCode, InitPreds,
+ FinalPreds, !IO) :-
mlds_output_auto_gen_comment(ModuleName, !IO),
mlds_indent(Indent, !IO),
io__write_string("/* :- module ", !IO),
@@ -366,7 +373,8 @@
io__write_string("/* :- implementation. */\n", !IO),
mlds_output_src_bootstrap_defines(!IO),
io__nl(!IO),
- mlds_output_init_comment(ModuleName, InitPreds, !IO),
+ mlds_output_init_and_final_comments(ModuleName,
+ InitPreds, FinalPreds, !IO),
mlds_output_src_import(Indent,
mercury_import(
@@ -390,26 +398,29 @@
% Output a comment to tell mkinit what module initialisation
% predicates to call from <module>_init.c.
%
-:- pred mlds_output_init_comment(mercury_module_name::in,
- list(string)::in, io::di, io::uo) is det.
+:- pred mlds_output_init_and_final_comments(mercury_module_name::in,
+ list(string)::in, list(string)::in, io::di, io::uo) is det.
-mlds_output_init_comment(ModuleName, UserInitPredCNames, !IO) :-
- (
- UserInitPredCNames = [_|_],
- io__write_string("/*\n", !IO),
- io__write_string("INIT ", !IO),
+mlds_output_init_and_final_comments(ModuleName,
+ UserInitPredCNames, UserFinalPredCNames, !IO) :-
+ ( UserInitPredCNames = [], UserFinalPredCNames = [] ->
+
+ % There's no point writing out anything if this
+ % module doesn't have any module init or final preds.
+ true
+ ;
+ io.write_string("/*\n", !IO),
+ io.write_string("INIT ", !IO),
output_init_name(ModuleName, !IO),
- io__write_string("init\n", !IO),
- list__foldl(mlds_output_required_user_init_comment,
+ io.write_string("init\n", !IO),
+ list.foldl(mlds_output_required_user_init_comment,
UserInitPredCNames, !IO),
- io__write_string("ENDINIT\n", !IO),
- io__write_string("*/\n\n", !IO)
- ;
- % There's no point writing out anything if this
- % module doesn't have any module init preds.
- UserInitPredCNames = []
+ list.foldl(mlds_output_required_user_final_comment,
+ UserFinalPredCNames, !IO),
+ io.write_string("ENDINIT\n", !IO),
+ io.write_string("*/\n\n", !IO)
).
-
+
:- pred mlds_output_required_user_init_comment(string::in, io::di, io::uo)
is det.
@@ -417,6 +428,12 @@
io__write_string("REQUIRED_INIT ", !IO),
io__write_string(CName, !IO),
io__nl(!IO).
+
+:- pred mlds_output_required_user_final_comment(string::in, io::di, io::uo)
+ is det.
+
+mlds_output_required_user_final_comment(CName, !IO) :-
+ io.write_string("REQUIRED_FINAL " ++ CName ++ "\n", !IO).
% Output any #defines which are required to bootstrap in the hlc
% grade.
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.106
diff -u -r1.106 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 12 Sep 2005 05:24:15 -0000 1.106
+++ compiler/mlds_to_gcc.m 28 Sep 2005 06:47:08 -0000
@@ -247,7 +247,7 @@
mlds_to_gcc__compile_to_asm(MLDS, MaybeRLFile, ContainsCCode) -->
% XXX We need to handle initialise declarations properly here.
{ MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns0,
- InitPreds) },
+ InitPreds, FinalPreds) },
%
% Handle output of any foreign code (C, Ada, Fortran, etc.)
@@ -300,7 +300,8 @@
% them from the asm file!) and pass that to mlds_to_c.m
% to create the .mih file, and if necessary the .c file.
{ ForeignMLDS = mlds(ModuleName, AllForeignCode, Imports,
- list__map(make_public, ForeignDefns), InitPreds) },
+ list__map(make_public, ForeignDefns), InitPreds,
+ FinalPreds) },
mlds_to_c__output_c_file(ForeignMLDS, MaybeRLFile, "")
),
%
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.150
diff -u -r1.150 mlds_to_il.m
--- compiler/mlds_to_il.m 12 Sep 2005 05:24:16 -0000 1.150
+++ compiler/mlds_to_il.m 28 Sep 2005 06:35:43 -0000
@@ -273,7 +273,7 @@
generate_il(MLDS, Version, ILAsm, ForeignLangs, !IO) :-
% XXX initialise declarations NYI for IL backend
- mlds(MercuryModuleName, ForeignCode, Imports, Defns, _) =
+ mlds(MercuryModuleName, ForeignCode, Imports, Defns, _, _) =
transform_mlds(MLDS),
ModuleName = mercury_module_name_to_mlds(MercuryModuleName),
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.27
diff -u -r1.27 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 1 Sep 2005 09:06:35 -0000 1.27
+++ compiler/mlds_to_ilasm.m 28 Sep 2005 06:36:11 -0000
@@ -123,7 +123,8 @@
io::di, io::uo) is det.
output_assembler(MLDS, ForeignLangs, !IO) :-
- MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns, _InitPreds),
+ MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns,
+ _InitPreds, _FinalPreds),
output_src_start(ModuleName, !IO),
io__nl(!IO),
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.68
diff -u -r1.68 mlds_to_java.m
--- compiler/mlds_to_java.m 12 Sep 2005 05:24:16 -0000 1.68
+++ compiler/mlds_to_java.m 28 Sep 2005 06:36:40 -0000
@@ -417,7 +417,8 @@
%
% Run further transformations on the MLDS.
%
- MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns0, _InitPreds),
+ MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns0,
+ _InitPreds, _FinalPreds),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
%
% Find and build list of all methods which would have their addresses
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.20
diff -u -r1.20 mlds_to_managed.m
--- compiler/mlds_to_managed.m 1 Sep 2005 09:06:35 -0000 1.20
+++ compiler/mlds_to_managed.m 28 Sep 2005 06:37:31 -0000
@@ -72,7 +72,8 @@
:- import_module term.
output_managed_code(Lang, MLDS, !IO) :-
- MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns, _InitPred),
+ MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns,
+ _InitPreds, _FinalPreds),
output_src_start(ModuleName, !IO),
io__nl(!IO),
generate_code(Lang, MLDS, !IO),
@@ -104,7 +105,8 @@
io::di, io::uo) is det.
generate_code(Lang, MLDS, !IO) :-
- MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns, _InitPreds),
+ MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns,
+ _InitPreds, _FinalPreds),
ClassName = class_name(mercury_module_name_to_mlds(ModuleName),
wrapper_class_name),
io__nl(!IO),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.114
diff -u -r1.114 module_qual.m
--- compiler/module_qual.m 14 Sep 2005 05:26:38 -0000 1.114
+++ compiler/module_qual.m 23 Sep 2005 07:21:50 -0000
@@ -335,6 +335,7 @@
).
collect_mq_info_2(instance(_, _, _, _, _, _), !Info).
collect_mq_info_2(initialise(_, _), !Info).
+collect_mq_info_2(finalise(_, _), !Info).
collect_mq_info_2(mutable(_, _, _, _, _), !Info).
:- pred collect_mq_info_qualified_symname(sym_name::in,
@@ -725,6 +726,11 @@
!Info, yes, !IO).
module_qualify_item(
+ finalise(Origin, PredSymName) - Context,
+ finalise(Origin, PredSymName) - Context,
+ !Info, yes, !IO).
+
+module_qualify_item(
mutable(Name, Type0, InitTerm, Inst0, Attrs) - Context,
mutable(Name, Type, InitTerm, Inst, Attrs) - Context,
!Info, yes, !IO) :-
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.345
diff -u -r1.345 modules.m
--- compiler/modules.m 26 Sep 2005 08:24:09 -0000 1.345
+++ compiler/modules.m 28 Sep 2005 13:55:23 -0000
@@ -2020,9 +2020,9 @@
% This is used when creating the private interface (`.int0') files for
% packages with sub-modules.
%
- % We treat initialise declarations as a special kind of clause, since they
- % should always be grouped together with the clauses and should not appear
- % in private interfaces.
+ % We treat initialise and finalise declarations as special kinds of
+ % clause, since they should always be grouped together with the clauses
+ % and should not appear in private interfaces.
%
:- pred strip_clauses_from_interface(item_list::in, item_list::out) is det.
@@ -2050,6 +2050,8 @@
pragma_allowed_in_interface(Pragma, no)
;
Item0 = initialise(_, _)
+ ;
+ Item0 = finalise(_, _)
)
->
split_clauses_and_decls(Items0, ClauseItems1, InterfaceItems),
@@ -7346,6 +7348,7 @@
item_needs_imports(instance(_, _, _, _, _, _)) = yes.
item_needs_imports(promise(_, _, _, _)) = yes.
item_needs_imports(initialise(_, _)) = yes.
+item_needs_imports(finalise(_, _)) = yes.
item_needs_imports(mutable(_, _, _, _, _)) = yes.
item_needs_imports(nothing(_)) = no.
@@ -7692,6 +7695,7 @@
reorderable_item(pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _)) = no.
reorderable_item(pred_or_func_mode(_, _, _, _, _, _, _)) = no.
reorderable_item(initialise(_, _)) = no.
+reorderable_item(finalise(_, _)) = no.
reorderable_item(mutable(_, _, _, _, _)) = no.
:- pred is_chunkable(item_and_context::in) is semidet.
@@ -7778,6 +7782,7 @@
chunkable_item(instance(_, _, _, _, _, _)) = yes.
chunkable_item(clause(_, _, _, _, _, _)) = yes.
chunkable_item(initialise(_, _)) = yes.
+chunkable_item(finalise(_, _)) = yes.
chunkable_item(mutable(_, _, _, _, _)) = no.
chunkable_item(nothing(_)) = yes.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.137
diff -u -r1.137 prog_data.m
--- compiler/prog_data.m 12 Sep 2005 05:24:20 -0000 1.137
+++ compiler/prog_data.m 22 Sep 2005 14:25:52 -0000
@@ -63,6 +63,11 @@
% for `:- initialise' decls. This should only
% apply to export pragms.
+ ; finalise_decl
+ % This item was introduced by the transformation
+ % for `:- finalise' decls. This should only
+ % apply to export pragmas.
+
; mutable_decl
% The item was introduced by the transformation
% for `:- mutable' decls. This should only apply
@@ -194,9 +199,12 @@
ci_module_containing_instance :: module_name
)
- % :- initialise(pred_name).
+ % :- initialise pred_name.
; initialise(item_origin, sym_name)
-
+
+ % :- finalise pred_name.
+ ; finalise(item_origin, sym_name)
+
% :- mutable(var_name, type, inst, value, attrs).
; mutable(
mut_name :: string,
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.250
diff -u -r1.250 prog_io.m
--- compiler/prog_io.m 26 Sep 2005 06:52:06 -0000 1.250
+++ compiler/prog_io.m 28 Sep 2005 06:01:54 -0000
@@ -1426,6 +1426,10 @@
parse_initialise_decl(ModuleName, VarSet, Args, Result0),
check_no_attributes(Result0, Attributes, Result).
+process_decl(ModuleName, VarSet, "finalise", Args, Attributes, Result) :-
+ parse_finalise_decl(ModuleName, VarSet, Args, Result0),
+ check_no_attributes(Result0, Attributes, Result).
+
process_decl(ModuleName, VarSet, "mutable", Args, Attributes, Result) :-
parse_mutable_decl(ModuleName, VarSet, Args, Result0),
check_no_attributes(Result0, Attributes, Result).
@@ -1817,6 +1821,35 @@
%-----------------------------------------------------------------------------%
+:- pred parse_finalise_decl(module_name::in, varset::in, list(term)::in,
+ maybe1(item)::out) is semidet.
+
+parse_finalise_decl(_ModuleName, _VarSet, [Term], Result) :-
+ parse_symbol_name_specifier(Term, MaybeSymNameSpecifier),
+ (
+ MaybeSymNameSpecifier = error(ErrMsg, Trm),
+ Result = error(ErrMsg, Trm)
+ ;
+ MaybeSymNameSpecifier = ok(SymNameSpecifier),
+ (
+ SymNameSpecifier = name(SymName),
+ Result = ok(finalise(user, SymName))
+ ;
+ SymNameSpecifier = name_arity(SymName, Arity),
+ (
+ Arity = 2
+ ->
+ Result = ok(finalise(user, SymName))
+ ;
+ Result = error("a finalise " ++
+ "declaration can only apply to " ++
+ "an arity 2 predicate", Term)
+ )
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
% Mutable declaration syntax:
%
% :- mutable(name, type, value, inst, [untrailed, promise_thread_safe]).
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.19
diff -u -r1.19 recompilation.check.m
--- compiler/recompilation.check.m 26 Sep 2005 05:48:10 -0000 1.19
+++ compiler/recompilation.check.m 28 Sep 2005 06:01:54 -0000
@@ -957,6 +957,7 @@
check_for_ambiguities(_, _, _, module_defn(_, _) - _, !Info).
check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _, !Info).
check_for_ambiguities(_, _, _, initialise(_, _) - _, !Info).
+check_for_ambiguities(_, _, _, finalise(_, _) - _, !Info).
check_for_ambiguities(_, _, _, mutable(_, _, _, _, _) - _, !Info).
check_for_ambiguities(_, _, _, nothing(_) - _, !Info).
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.25
diff -u -r1.25 recompilation.version.m
--- compiler/recompilation.version.m 12 Sep 2005 05:24:23 -0000 1.25
+++ compiler/recompilation.version.m 23 Sep 2005 07:36:42 -0000
@@ -578,6 +578,7 @@
% the class, not the module containing the instance).
item_to_item_id_2(instance(_, _, _, _, _, _), no).
item_to_item_id_2(initialise(_, _), no).
+item_to_item_id_2(finalise(_, _), no).
item_to_item_id_2(mutable(_, _, _, _, _), no).
item_to_item_id_2(nothing(_), no).
@@ -743,6 +744,8 @@
item_is_unchanged(nothing(A), Item2) = ( Item2 = nothing(A) -> yes ; no ).
item_is_unchanged(initialise(O, A), Item2) =
( Item2 = initialise(O, A) -> yes ; no ).
+item_is_unchanged(finalise(O, A), Item2) =
+ ( Item2 = finalise(O, A) -> yes ; no ).
item_is_unchanged(mutable(A, B, C, D, E), Item2) =
( Item2 = mutable(A, B, C, D, E) -> yes ; no ).
Index: compiler/transform_llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_llds.m,v
retrieving revision 1.16
diff -u -r1.16 transform_llds.m
--- compiler/transform_llds.m 29 Aug 2005 03:22:27 -0000 1.16
+++ compiler/transform_llds.m 28 Sep 2005 07:07:36 -0000
@@ -60,7 +60,7 @@
:- pred transform_c_file(c_file::in, c_file::out, globals::in) is det.
transform_c_file(CFile0, CFile, Globals) :-
- CFile0 = c_file(ModuleName, _, _, _, _, _, Modules0, _),
+ CFile0 = c_file(ModuleName, _, _, _, _, _, Modules0, _, _),
% split up large computed gotos
globals__lookup_int_option(Globals, max_jump_table_size, MaxSize),
( MaxSize = 0 ->
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.328
diff -u -r1.328 reference_manual.texi
--- doc/reference_manual.texi 26 Sep 2005 06:52:07 -0000 1.328
+++ doc/reference_manual.texi 28 Sep 2005 07:38:56 -0000
@@ -4227,7 +4227,8 @@
* The module system::
* An example module::
* Sub-modules::
-* Optional module initialisation::
+* Module initialisation::
+* Module finalisation::
* Module-local mutable variables::
@end menu
@@ -4543,14 +4544,14 @@
sub-modules, i.e.@: to put the sub-modules in separate source files.)
@end itemize
- at node Optional module initialisation
- at section Optional module initialisation
+ at node Module initialisation
+ at section Module initialisation
Modules that interact with foreign libraries or services
may require special initialisation before use.
Such modules may include any number of @samp{initialise} directives
in their implementation sections.
-An @samp{initialise} directive takes the following form:
+An @samp{initialise} directive has the following form:
@example
:- initialise initpredname.
@@ -4567,7 +4568,33 @@
@samp{initpredname} is invoked before the program's @samp{main}
predicate. Initialisation predicates within a module are executed in the
order in which they are specified, although no order may be assumed between
-different modules or submodules.
+different modules or sub-modules.
+
+ at node Module finalisation
+ at section Module finalisation
+
+Modules that required special finalisation at program termination
+may include any number of @samp{finalise} directives in their
+implementation sections.
+
+A @samp{finalise} directive has the following form:
+
+ at example
+:- finalise finalpredname.
+ at end example
+
+where the predicate @samp{finalpredname/2} must be declared with the following
+signature:
+
+ at example
+:- pred finalpredname(io::di, io::uo) is det.
+ at end example
+
+The effect of the @samp{finalise} declaration is to ensure that
+ at samp{finalpredname} is invoked after the program's @samp{main}
+predicate. Finalisation predicates within a module are executed in
+the order in which they are specified, although no order may be assumed between
+different modules or sub-modules.
@node Module-local mutable variables
@section Module-local mutable variables
@@ -5717,7 +5744,8 @@
@dfn{strict sequential} operational semantics. In this semantics,
the program is executed top-down, starting from @samp{main/2}
preceded by any module initialisation goals
-(as per @ref{Optional module initialisation}),
+(as per @ref{Module initialisation}), followed by any module finalisation
+goals (as per @ref{Module finalisation}),
and function calls within a goal, conjunctions and disjunctions are all
executed in depth-first left-to-right order.
Conjunctions and function calls are ``minimally'' reordered as required
Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.53
diff -u -r1.53 ops.m
--- library/ops.m 26 Sep 2005 06:52:08 -0000 1.53
+++ library/ops.m 28 Sep 2005 06:01:59 -0000
@@ -12,7 +12,7 @@
% operator precedence tables for use by `parser__read_term_with_op_table'
% and `term_io__write_term_with_op_table'.
%
-% It also exports an instance `ops__mercury_op_table' which implements the
+% It also exports an instance `ops__mercury_op_table' that implements the
% Mercury operator table defined in the Mercury Language Reference Manual.
%
% See samples/calculator2.m for an example program.
@@ -311,6 +311,7 @@
ops__op_table("include_module", before, fx, 1199). % Mercury extension
ops__op_table("impure", before, fy, 800). % Mercury extension
ops__op_table("initialise", before, fx, 1199). % Mercury extension
+ops__op_table("finalise", before, fx, 1199). % Mercury extension
ops__op_table("inst", before, fx, 1199). % Mercury extension
ops__op_table("instance", before, fx, 1199). % Mercury extension
ops__op_table("is", after, xfx, 701). % ISO Prolog says prec 700
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.155
diff -u -r1.155 mercury_wrapper.c
--- runtime/mercury_wrapper.c 28 Sep 2005 06:00:57 -0000 1.155
+++ runtime/mercury_wrapper.c 28 Sep 2005 13:50:57 -0000
@@ -342,7 +342,7 @@
void (*MR_address_of_write_out_proc_statics)(FILE *fp);
#endif
void (*MR_address_of_init_modules_required)(void);
-void (*MR_address_of_final_modules_required)(void);
+void (*MR_address_of_final_modules_required)(void);
MR_TypeCtorInfo MR_type_ctor_info_for_univ;
MR_TypeCtorInfo MR_type_info_for_type_info;
@@ -2259,6 +2259,9 @@
*/
MR_save_regs_to_mem(c_regs);
+ /* run any user-defined finalisation predicates */
+ (*MR_address_of_final_modules_required)();
+
MR_trace_end();
(*MR_library_finalizer)();
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.267
diff -u -r1.267 Mmakefile
--- tests/hard_coded/Mmakefile 9 Sep 2005 07:00:56 -0000 1.267
+++ tests/hard_coded/Mmakefile 28 Sep 2005 07:45:34 -0000
@@ -65,6 +65,7 @@
external_unification_pred \
failure_unify \
field_syntax \
+ finalise_decl \
float_field \
float_map \
float_reg \
Index: tests/hard_coded/finalise_decl.exp
===================================================================
RCS file: tests/hard_coded/finalise_decl.exp
diff -N tests/hard_coded/finalise_decl.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/finalise_decl.exp 28 Sep 2005 07:45:05 -0000
@@ -0,0 +1,3 @@
+This is main/2.
+This is the first finalise pred, i1/2.
+This is the second finalise pred, i2/2.
Index: tests/hard_coded/finalise_decl.m
===================================================================
RCS file: tests/hard_coded/finalise_decl.m
diff -N tests/hard_coded/finalise_decl.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/finalise_decl.m 28 Sep 2005 07:44:25 -0000
@@ -0,0 +1,33 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% Test the `:- finalise finalpred' directive.
+%
+%-----------------------------------------------------------------------------%
+
+:- module finalise_decl.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io :: di, io :: uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- finalise i1.
+:- finalise i2.
+
+:- pred i1(io::di, io::uo) is det.
+i1(!IO) :- io.print("This is the first finalise pred, i1/2.\n", !IO).
+
+:- pred i2(io::di, io::uo) is det.
+i2(!IO) :- io.print("This is the second finalise pred, i2/2.\n", !IO).
+
+main(!IO) :- io.print("This is main/2.\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: tests/hard_coded/sub-modules/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/Mmakefile,v
retrieving revision 1.12
diff -u -r1.12 Mmakefile
--- tests/hard_coded/sub-modules/Mmakefile 15 Sep 2005 07:38:46 -0000 1.12
+++ tests/hard_coded/sub-modules/Mmakefile 28 Sep 2005 09:25:02 -0000
@@ -28,7 +28,8 @@
nested_intermod_main \
initialise_parent \
ts \
- mutable_parent
+ mutable_parent \
+ finalise_parent
# We currently don't do any testing in grade java on this directory.
ifneq "$(findstring java,$(GRADE))" ""
Index: tests/hard_coded/sub-modules/finalise_child.m
===================================================================
RCS file: tests/hard_coded/sub-modules/finalise_child.m
diff -N tests/hard_coded/sub-modules/finalise_child.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/finalise_child.m 28 Sep 2005 07:55:13 -0000
@@ -0,0 +1,13 @@
+:- module finalise_parent.finalise_child.
+
+:- interface.
+
+:- type foo ---> foo.
+
+:- implementation.
+
+:- finalise child_final/2.
+
+:- pred child_final(io::di, io::uo) is det.
+
+child_final(!IO) :- io.write_string("This is child_final/2...\n", !IO).
Index: tests/hard_coded/sub-modules/finalise_parent.exp
===================================================================
RCS file: tests/hard_coded/sub-modules/finalise_parent.exp
diff -N tests/hard_coded/sub-modules/finalise_parent.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/finalise_parent.exp 28 Sep 2005 13:02:17 -0000
@@ -0,0 +1,3 @@
+This is main/2...
+This is parent_final/2...
+This is child_final/2...
Index: tests/hard_coded/sub-modules/finalise_parent.exp2
===================================================================
RCS file: tests/hard_coded/sub-modules/finalise_parent.exp2
diff -N tests/hard_coded/sub-modules/finalise_parent.exp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/finalise_parent.exp2 28 Sep 2005 13:02:56 -0000
@@ -0,0 +1,3 @@
+This is main/2...
+This is child_final/2...
+This is parent_final/2...
Index: tests/hard_coded/sub-modules/finalise_parent.m
===================================================================
RCS file: tests/hard_coded/sub-modules/finalise_parent.m
diff -N tests/hard_coded/sub-modules/finalise_parent.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/finalise_parent.m 28 Sep 2005 07:58:01 -0000
@@ -0,0 +1,25 @@
+%
+% This is to test that `:- finalise' declarations are not
+% written out to private interfaces.
+%
+:- module finalise_parent.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- include_module finalise_child.
+
+:- implementation.
+
+:- finalise parent_final.
+
+:- pred parent_final(io::di, io::uo) is det.
+
+main(!IO) :-
+ io.write_string("This is main/2...\n", !IO).
+
+parent_final(!IO) :-
+ io.write_string("This is parent_final/2...\n", !IO).
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.176
diff -u -r1.176 Mmakefile
--- tests/invalid/Mmakefile 13 Sep 2005 01:54:13 -0000 1.176
+++ tests/invalid/Mmakefile 28 Sep 2005 07:42:33 -0000
@@ -39,6 +39,7 @@
any_should_not_match_bound \
any_to_ground_in_ite_cond \
assert_in_interface \
+ bad_finalise_decl \
bad_mutable \
bad_initialise_decl \
bad_instance \
Index: tests/invalid/bad_finalise_decl.err_exp
===================================================================
RCS file: tests/invalid/bad_finalise_decl.err_exp
diff -N tests/invalid/bad_finalise_decl.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bad_finalise_decl.err_exp 28 Sep 2005 07:42:08 -0000
@@ -0,0 +1,7 @@
+bad_finalise_decl.m:016: Error: `finalise' declaration in module interface.
+bad_finalise_decl.m:016: Error: `i2'/2 used in finalise declaration does not
+bad_finalise_decl.m:016: have signature `pred(io::di, io::uo) is det'
+bad_finalise_decl.m:023: Error: `i1'/2 used in finalise declaration does not
+bad_finalise_decl.m:023: have signature `pred(io::di, io::uo) is det'
+bad_finalise_decl.m:024: Error: `i3'/2 used in finalise declaration does not
+bad_finalise_decl.m:024: have a corresponding pred declaration.
Index: tests/invalid/bad_finalise_decl.m
===================================================================
RCS file: tests/invalid/bad_finalise_decl.m
diff -N tests/invalid/bad_finalise_decl.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bad_finalise_decl.m 28 Sep 2005 07:41:44 -0000
@@ -0,0 +1,35 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% Test error messages for the `:- finalise finalpredname' directive.
+%
+%-----------------------------------------------------------------------------%
+
+:- module bad_finalise_decl.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- finalise i2.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- finalise i1.
+:- finalise i3.
+
+:- pred i1(T::di, T::uo) is det.
+i1(X, X).
+
+:- pred i2(io::in, io::out) is det.
+i2(!IO).
+
+main(!IO) :- io.print("This is main/2.\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list