[m-rev.] Add `:- initialise' directive to the language.
Ralph Becket
rafe at cs.mu.OZ.AU
Mon Aug 22 15:23:15 AEST 2005
Here's a revised diff addressing review comments and a missing feature,
namely including the module name in the C names of exported init preds:
diff -u compiler/hlds_module.m compiler/hlds_module.m
--- compiler/hlds_module.m 16 Aug 2005 05:54:30 -0000
+++ compiler/hlds_module.m 18 Aug 2005 05:16:56 -0000
@@ -433,16 +433,14 @@
:- pred module_info_next_aditi_top_down_proc(module_info::in, int::out,
module_info::out) is det.
-:- pred module_info_new_user_init_pred(sym_name::in, int::out, module_info::in,
- module_info::out) is det.
+:- pred module_info_new_user_init_pred(sym_name::in, string::out,
+ module_info::in, module_info::out) is det.
-:- pred module_info_user_init_pred_num(module_info::in, sym_name::in, int::out)
- is det.
+:- pred module_info_user_init_pred_c_name(module_info::in, sym_name::in,
+ string::out) is det.
-:- pred module_info_num_user_init_preds(module_info::in, int::out) is det.
-
-
-:- func user_init_pred_c_name(int) = string.
+:- pred module_info_user_init_pred_c_names(module_info::in,
+ list(string)::out) is det.
%-----------------------------------------------------------------------------%
@@ -554,7 +552,9 @@
:- implementation.
+:- import_module assoc_list.
:- import_module counter.
+:- import_module parse_tree__error_util.
:- pred module_info_get_lambdas_per_context(module_info::in,
map(prog_context, counter)::out) is det.
@@ -696,13 +696,12 @@
% which could be called from
% bottom-up Aditi procedures.
aditi_proc_counter :: counter,
- user_init_preds :: list(sym_name)
- % From `:- initialise initpred'
- % declarations in this module.
- % Items are added to the end;
- % the C export name of each
- % initpred is taken from its
- % position in the list.
+ user_init_pred_c_names :: assoc_list(sym_name, string)
+ % Exported C names for
+ % preds appearing in
+ % `:- initialise initpred'
+ % directives in this module,
+ % in order of appearance.
).
% A predicate which creates an empty module
@@ -839,22 +838,39 @@
counter__allocate(Proc, Counter0, Counter),
MI = MI0 ^ sub_info ^ aditi_proc_counter := Counter.
-module_info_new_user_init_pred(SymName, UserInitPredNo, MI0, MI) :-
- InitPreds = MI0 ^ sub_info ^ user_init_preds ++ [SymName],
- UserInitPredNo = list__length(InitPreds),
- MI = MI0 ^ sub_info ^ user_init_preds := InitPreds.
-
-module_info_user_init_pred_num(MI, SymName, UserInitPredNo) :-
- InitPreds = MI ^ sub_info ^ user_init_preds,
- UserInitPredNo =
- list__index1_of_first_occurrence_det(InitPreds, SymName).
-
-module_info_num_user_init_preds(MI, NumUserInitPreds) :-
- NumUserInitPreds = list__length(MI ^ sub_info ^ user_init_preds).
-
+ % XXX There is some debate as to whether duplicate
+ % initialise directives in the same module should
+ % constitute an error. Currently it is not, but
+ % we may wish to revisit this code. The reference
+ % manual is therefore deliberately quiet on the
+ % subject.
+ %
+module_info_new_user_init_pred(SymName, CName, MI0, MI) :-
+ InitPredCNames0 = MI0 ^ sub_info ^ user_init_pred_c_names,
+ UserInitPredNo = list__length(InitPredCNames0),
+ module_info_name(MI0, ModuleSymName),
+ ModuleName = prog_foreign__sym_name_mangle(ModuleSymName),
+ CName = string.format("%s__user_init_pred_%d",
+ [s(ModuleName), i(UserInitPredNo)]),
+ InitPredCNames = InitPredCNames0 ++ [SymName - CName],
+ MI = MI0 ^ sub_info ^ user_init_pred_c_names := InitPredCNames.
+
+module_info_user_init_pred_c_name(MI, SymName, CName) :-
+ InitPredCNames = MI ^ sub_info ^ user_init_pred_c_names,
+ (
+ assoc_list__search(InitPredCNames, SymName, CName0)
+ ->
+ CName = CName0
+ ;
+ module_info_name(MI, ModuleSymName),
+ ModuleName = sym_name_to_string(ModuleSymName),
+ unexpected(ModuleName,
+ "lookup failure in module_info_user_init_pred_c_name")
+ ).
-user_init_pred_c_name(UserInitPredNo) =
- string.format("user_init_pred_%d", [i(UserInitPredNo)]).
+module_info_user_init_pred_c_names(MI, CNames) :-
+ InitPredCNames = MI ^ sub_info ^ user_init_pred_c_names,
+ CNames = list__map(snd, InitPredCNames).
%-----------------------------------------------------------------------------%
diff -u compiler/llds.m compiler/llds.m
--- compiler/llds.m 17 Aug 2005 04:21:13 -0000
+++ compiler/llds.m 18 Aug 2005 05:31:30 -0000
@@ -64,14 +64,14 @@
:- 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_num_user_inits :: int
+ 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)
).
% Global variables generated by the compiler.
diff -u compiler/llds_out.m compiler/llds_out.m
--- compiler/llds_out.m 16 Aug 2005 01:46:03 -0000
+++ compiler/llds_out.m 18 Aug 2005 05:39:15 -0000
@@ -223,7 +223,7 @@
output_llds(C_File, ComplexityProcs, StackLayoutLabels, MaybeRLFile, !IO) :-
C_File = c_file(ModuleName, C_HeaderInfo,
UserForeignCodes, Exports, Vars, Datas, Modules,
- NumUserInitPreds),
+ UserInitPredCNames),
globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
(
SplitFiles = yes,
@@ -233,7 +233,7 @@
output_split_c_file_init(ModuleName, Modules, Datas, Vars,
ComplexityProcs, StackLayoutLabels, MaybeRLFile,
- NumUserInitPreds, !IO),
+ UserInitPredCNames, !IO),
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
C_HeaderInfo, ComplexityProcs, StackLayoutLabels,
1, Num1, !IO),
@@ -274,7 +274,7 @@
ModuleName, C_HeaderLines, ComplexityProcs, StackLayoutLabels,
!Num, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, [UserForeignCode],
- [], [], [], [], 0),
+ [], [], [], [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -288,7 +288,8 @@
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], [], [], [], 0),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [Export], [], [], [],
+ []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -303,7 +304,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], [], [], 0),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [Var], [], [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -318,7 +319,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], [], 0),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [Data], [], []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -333,7 +334,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], 0),
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [], [Module],
+ []),
output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
@@ -343,10 +345,10 @@
:- 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, int::in, io::di, io::uo) is det.
+ maybe(rl_file)::in, list(string)::in, io::di, io::uo) is det.
output_split_c_file_init(ModuleName, Modules, Datas, Vars, ComplexityProcs,
- StackLayoutLabels, MaybeRLFile, NumUserInitPreds, !IO) :-
+ StackLayoutLabels, MaybeRLFile, UserInitPredCNames, !IO) :-
module_name_to_file_name(ModuleName, ".m", no, SourceFileName, !IO),
module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName, !IO),
@@ -356,7 +358,7 @@
library__version(Version),
io__set_output_stream(FileStream, OutputStream, !IO),
output_c_file_intro_and_grade(SourceFileName, Version, !IO),
- output_init_comment(ModuleName, NumUserInitPreds, !IO),
+ output_init_comment(ModuleName, UserInitPredCNames, !IO),
output_c_file_mercury_headers(!IO),
io__write_string("\n", !IO),
decl_set_init(DeclSet0),
@@ -446,7 +448,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, NumUserInitPreds),
+ Vars, Datas, Modules, UserInitPredCNames),
library__version(Version),
io__set_output_stream(FileStream, OutputStream, !IO),
module_name_to_file_name(ModuleName, ".m", no, SourceFileName,
@@ -456,7 +458,7 @@
SplitFiles = yes(_)
;
SplitFiles = no,
- output_init_comment(ModuleName, NumUserInitPreds, !IO)
+ output_init_comment(ModuleName, UserInitPredCNames, !IO)
),
output_c_file_mercury_headers(!IO),
@@ -948,9 +950,10 @@
% Output a comment to tell mkinit what functions to
% call from <module>_init.c.
-:- pred output_init_comment(module_name::in, int::in, io::di, io::uo) is det.
+:- pred output_init_comment(module_name::in, list(string)::in,
+ io::di, io::uo) is det.
-output_init_comment(ModuleName, NumUserInitPreds, !IO) :-
+output_init_comment(ModuleName, UserInitPredCNames, !IO) :-
io__write_string("/*\n", !IO),
io__write_string("INIT ", !IO),
output_init_name(ModuleName, !IO),
@@ -965,23 +968,17 @@
;
Aditi = no
),
- output_required_user_init_comments(NumUserInitPreds, !IO),
+ list__foldl(output_required_user_init_comment, UserInitPredCNames,
+ !IO),
io__write_string("ENDINIT\n", !IO),
io__write_string("*/\n\n", !IO).
-:- pred output_required_user_init_comments(int::in, io::di, io::uo) is det.
+:- pred output_required_user_init_comment(string::in, io::di, io::uo) is det.
-output_required_user_init_comments(N, !IO) :-
- (
- N > 0
- ->
- output_required_user_init_comments(N - 1, !IO),
- io__write_string("REQUIRED_INIT ", !IO),
- io__write_string(user_init_pred_c_name(N), !IO),
- io__nl(!IO)
- ;
- true
- ).
+output_required_user_init_comment(CName, !IO) :-
+ io__write_string("REQUIRED_INIT ", !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.
diff -u compiler/make_hlds_passes.m compiler/make_hlds_passes.m
--- compiler/make_hlds_passes.m 17 Aug 2005 04:19:57 -0000
+++ compiler/make_hlds_passes.m 18 Aug 2005 04:20:44 -0000
@@ -514,8 +514,7 @@
% code generation can ensure cname is called during module
% initialisation.
%
- module_info_new_user_init_pred(SymName, UserInitPredNo, !ModuleInfo),
- CName = user_init_pred_c_name(UserInitPredNo),
+ module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
PragmaExportItem =
pragma(export(SymName, predicate, [di_mode, uo_mode], CName)),
add_item_decl_pass_2(PragmaExportItem, Context, !Status, !ModuleInfo, !IO).
@@ -713,12 +712,11 @@
% here. For now the arg modes and detism will be checked by
% the implicit `:- pragma export(...).' added for this pred.
->
- module_info_user_init_pred_num(!.ModuleInfo, SymName,
- UserInitPredNo),
- CExportName = user_init_pred_c_name(UserInitPredNo),
+ module_info_user_init_pred_c_name(!.ModuleInfo, SymName,
+ CName),
PragmaExportItem =
pragma(export(SymName, predicate, [di_mode, uo_mode],
- CExportName)),
+ CName)),
add_item_clause(PragmaExportItem, !Status, Context,
!ModuleInfo, !QualInfo, !IO)
;
diff -u compiler/mercury_compile.m compiler/mercury_compile.m
--- compiler/mercury_compile.m 17 Aug 2005 04:15:48 -0000
+++ compiler/mercury_compile.m 18 Aug 2005 05:49:50 -0000
@@ -4163,10 +4163,10 @@
C_HeaderCode = list__reverse(C_IncludeHeaderCode) ++
C_LocalHeaderCode ++ [Start | C_ExportedHeaderCode] ++ [End],
- module_info_num_user_init_preds(ModuleInfo, NumUserInitPreds),
+ module_info_user_init_pred_c_names(ModuleInfo, UserInitPredCNames),
- CFile = c_file(ModuleSymName, C_HeaderCode, C_BodyCode,
- C_ExportDefns, GlobalVars, AllData, ChunkedModules, NumUserInitPreds),
+ CFile = c_file(ModuleSymName, C_HeaderCode, C_BodyCode, C_ExportDefns,
+ GlobalVars, AllData, ChunkedModules, UserInitPredCNames),
list__length(C_BodyCode, UserCCodeCount),
list__length(C_ExportDefns, ExportCount),
list__length(GlobalVars, CompGenVarCount),
diff -u doc/reference_manual.texi doc/reference_manual.texi
--- doc/reference_manual.texi 17 Aug 2005 04:44:22 -0000
+++ doc/reference_manual.texi 18 Aug 2005 04:47:30 -0000
@@ -4559,8 +4559,8 @@
@node Optional module initialisation
@section Optional module initialisation
-Some modules that interact with foreign libraries or services
-require special initialisation before use.
+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:
@@ -4569,7 +4569,7 @@
:- initialise initpredname.
@end example
-where the predicate @samp{initpredname} must be declared with the following
+where the predicate @samp{initpredname/2} must be declared with the following
signature:
@example
diff -u runtime/mercury_wrapper.c runtime/mercury_wrapper.c
--- runtime/mercury_wrapper.c 17 Aug 2005 03:10:36 -0000
+++ runtime/mercury_wrapper.c 18 Aug 2005 05:00:34 -0000
@@ -611,7 +611,7 @@
/* initialize the Mercury library */
(*MR_library_initializer)();
- /* run any ...*/
+ /* run any user-defined initialisation predicates */
(*MR_address_of_init_modules_required)();
#ifndef MR_HIGHLEVEL_CODE
diff -u tests/hard_coded/initialise_decl.exp tests/hard_coded/initialise_decl.exp
--- tests/hard_coded/initialise_decl.exp 17 Aug 2005 04:27:58 -0000
+++ tests/hard_coded/initialise_decl.exp 17 Aug 2005 05:01:34 -0000
@@ -1,3 +1 @@
-This is the first initialise pred, i1/2.
-This is the second initialise pred, i2/2.
This is main/2.
only in patch2:
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bad_initialise_decl.m 18 Aug 2005 05:09:45 -0000
@@ -0,0 +1,38 @@
+%-----------------------------------------------------------------------------%
+% initialise_decl.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Wed Aug 17 14:25:01 EST 2005
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% Test the `:- initialise initpred' directive.
+%
+%-----------------------------------------------------------------------------%
+
+:- module initialise_decl.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io :: di, io :: uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- initialise i1.
+:- initialise i2.
+
+:- pred i1(T::di, T::uo) is det.
+i1(!IO) :- io.print("This is the first initialise pred, i1/2.\n", !IO).
+
+:- pred i2(io::in, io::out) is det.
+i2(!IO) :- io.print("This is the second initialise pred, i2/2.\n", !IO).
+
+main(!IO) :- io.print("This is main/2.\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
only in patch2:
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bad_initialise_decl.err_exp 18 Aug 2005 05:13:27 -0000
@@ -0,0 +1,17 @@
+Making Mercury/cs/bad_initialise_decl.c
+Error: file `bad_initialise_decl.m' contains the wrong module.
+Expected module `bad_initialise_decl', found module `initialise_decl'.
+bad_initialise_decl.m:011: Warning: source file `bad_initialise_decl.m' contains module named `initialise_decl': :- module initialise_decl.
+bad_initialise_decl.m:026: `i1'/2 used in initialise declaration does not have
+bad_initialise_decl.m:026: signature `pred(io::di, io::uo) is det'
+bad_initialise_decl.m:027: Error: `:- pragma export' declaration for `i2'/2
+bad_initialise_decl.m:027: specifies non-existent mode.
+bad_initialise_decl.m:030: In clause for predicate `initialise_decl.i1/2':
+bad_initialise_decl.m:030: in argument 2 of call to predicate `io.print/3':
+bad_initialise_decl.m:030: type error: variable `STATE_VARIABLE_IO_0' has type `(some [T] T)',
+bad_initialise_decl.m:030: expected type was `(io.state)'.
+bad_initialise_decl.m:030: In clause for predicate `initialise_decl.i1/2':
+bad_initialise_decl.m:030: in implicit state variable unification:
+bad_initialise_decl.m:030: type error in unification of variable `STATE_VARIABLE_IO'
+bad_initialise_decl.m:030: and variable `STATE_VARIABLE_IO_1'.
+** Error making `Mercury/cs/bad_initialise_decl.c'.
only in patch2:
--- tests/invalid/Mmakefile 14 Aug 2005 03:20:53 -0000 1.172
+++ tests/invalid/Mmakefile 18 Aug 2005 05:15:54 -0000
@@ -37,6 +37,7 @@
any_mode \
any_should_not_match_bound \
assert_in_interface \
+ bad_initialise_decl \
bad_instance \
bigtest \
bind_in_negated \
diff -u library/list.m library/list.m
--- library/list.m 16 Aug 2005 01:55:34 -0000
+++ library/list.m 22 Aug 2005 05:20:12 -0000
@@ -341,15 +341,15 @@
% list__index*_of_first_occurrence(List, Elem, Position):
% Computes the least value of Position such that
- % list_index*(List, Position, Elem). The `_det' funcs
+ % list_index*(List, Position, Elem). The `det_' funcs
% call error/1 if Elem is not a member of List.
%
:- pred list__index0_of_first_occurrence(list(T)::in, T::in, int::out)
is semidet.
:- pred list__index1_of_first_occurrence(list(T)::in, T::in, int::out)
is semidet.
-:- func list__index0_of_first_occurrence_det(list(T), T) = int.
-:- func list__index1_of_first_occurrence_det(list(T), T) = int.
+:- func list__det_index0_of_first_occurrence(list(T), T) = int.
+:- func list__det_index1_of_first_occurrence(list(T), T) = int.
% list__zip(ListA, ListB, List):
% List is the result of alternating the elements
@@ -1211,18 +1211,18 @@
list__index0_of_first_occurrence(List, Elem, N).
-list__index0_of_first_occurrence_det(List, Elem) = N :-
+list__det_index0_of_first_occurrence(List, Elem) = N :-
( list__index0_of_first_occurrence(List, Elem, N0) ->
N = N0
;
- error("list__index0_of_first_occurrence_det: item not found")
+ error("list__det_index0_of_first_occurrence: item not found")
).
-list__index1_of_first_occurrence_det(List, Elem) = N :-
+list__det_index1_of_first_occurrence(List, Elem) = N :-
( list__index1_of_first_occurrence(List, Elem, N0) ->
N = N0
;
- error("list__index1_of_first_occurrence_det: item not found")
+ error("list__det_index1_of_first_occurrence: item not found")
).
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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