[m-rev.] for review: fix foreign_types and pragma export
Peter Ross
petdr at cs.mu.OZ.AU
Thu Jul 18 07:32:06 AEST 2002
Hi,
For Simon to review.
===================================================================
Estimated hours taken: 8
Branches: main
Fix generated C errors where a `:- pragma foreign_type' refers to a C
type which is not in scope where it is used in the prototype for a
predicate with a `:- pragma export' declaration.
compiler/export.m:
Record in the foreign_export_decls type all the foreign_decls iff
the module contains foreign types.
Output the foreign decls in the header file if needed for low-level
code or #include the header file which contains the decls for
high-level code.
compiler/foreign.m:
Change foreign_export_decls so that it records the foreign_decls
if needed by virtue of the module containing foreign_types.
compiler/hlds_module.m:
Add a new field to the module_info which records whether or not a
module contains a foreign type.
compiler/make_hlds.m:
Set the contains_foreign_type field.
compiler/mercury_compile.m:
If the module contains a foreign type then the decls will be placed
in the header file so remove them from processing in the c file.
Index: compiler/export.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/export.m,v
retrieving revision 1.57
diff -u -r1.57 export.m
--- compiler/export.m 18 Jun 2002 11:35:24 -0000 1.57
+++ compiler/export.m 17 Jul 2002 15:30:53 -0000
@@ -69,7 +69,8 @@
:- import_module backend_libs__foreign.
:- import_module parse_tree__modules.
:- import_module hlds__hlds_pred, check_hlds__type_util.
-:- import_module backend_libs__code_model.
+:- import_module hlds__error_util.
+:- import_module backend_libs__code_model, backend_libs__c_util.
:- import_module ll_backend__code_gen, ll_backend__code_util.
:- import_module ll_backend__llds_out, ll_backend__arg_info.
:- import_module libs__globals, libs__options.
@@ -80,13 +81,24 @@
%-----------------------------------------------------------------------------%
-export__get_foreign_export_decls(HLDS, C_ExportDecls) :-
+export__get_foreign_export_decls(HLDS, ForeignExportDecls) :-
module_info_get_predicate_table(HLDS, PredicateTable),
predicate_table_get_preds(PredicateTable, Preds),
+
+ ( module_info_contains_foreign_type(HLDS) ->
+ module_info_get_foreign_decl(HLDS, ForeignDecls),
+ MaybeForeignDecls = yes(ForeignDecls)
+ ;
+ MaybeForeignDecls = no
+ ),
+
module_info_get_pragma_exported_procs(HLDS, ExportedProcs),
module_info_globals(HLDS, Globals),
export__get_foreign_export_decls_2(Preds, ExportedProcs, Globals,
- HLDS, C_ExportDecls).
+ HLDS, C_ExportDecls),
+
+ ForeignExportDecls = foreign_export_decls(MaybeForeignDecls,
+ C_ExportDecls).
:- pred export__get_foreign_export_decls_2(pred_table,
list(pragma_exported_proc), globals,
@@ -597,36 +609,44 @@
% Should this predicate go in llds_out.m?
-export__produce_header_file([], _) --> [].
-export__produce_header_file(C_ExportDecls, ModuleName) -->
- { C_ExportDecls = [_|_] },
- export__produce_header_file(C_ExportDecls, ModuleName, ".mh"),
-
- % XXX We still need to produce the `.h' file for bootstrapping.
- % The C files in the trace directory refer to std_util.h and io.h.
- globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
- {
- HighLevelCode = yes,
- ModuleName = unqualified(StdLibModule),
- mercury_std_library_module(StdLibModule)
- ->
- HeaderModuleName = qualified(unqualified("mercury"),
- StdLibModule)
- ;
- HeaderModuleName = ModuleName
- },
- export__produce_header_file(C_ExportDecls, HeaderModuleName, ".h").
+export__produce_header_file(ForeignExportDecls, ModuleName) -->
+ ( { ForeignExportDecls = foreign_export_decls(no, []) } ->
+ []
+ ;
+ export__produce_header_file(ForeignExportDecls,
+ ModuleName, ".mh"),
+
+ % XXX We still need to produce the `.h' file for
+ % bootstrapping. The C files in the trace directory refer to
+ % std_util.h and io.h.
+ globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
+ {
+ HighLevelCode = yes,
+ ModuleName = unqualified(StdLibModule),
+ mercury_std_library_module(StdLibModule)
+ ->
+ HeaderModuleName = qualified(unqualified("mercury"),
+ StdLibModule)
+ ;
+ HeaderModuleName = ModuleName
+ },
+ export__produce_header_file(ForeignExportDecls,
+ HeaderModuleName, ".h")
+ ).
-:- pred export__produce_header_file(foreign_export_decls, module_name, string,
- io__state, io__state).
+:- pred export__produce_header_file(foreign_export_decls,
+ module_name, string, io__state, io__state).
:- mode export__produce_header_file(in, in, in, di, uo) is det.
-export__produce_header_file(C_ExportDecls, ModuleName, HeaderExt) -->
+export__produce_header_file(ForeignExportDecls, ModuleName, HeaderExt) -->
+ { ForeignExportDecls = foreign_export_decls(MaybeForeignDecls,
+ C_ExportDecls) },
module_name_to_file_name(ModuleName, HeaderExt, yes, FileName),
io__open_output(FileName, Result),
(
{ Result = ok(FileStream) }
->
+ globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
io__set_output_stream(FileStream, OutputStream),
module_name_to_file_name(ModuleName, ".m", no, SourceFileName),
{ library__version(Version) },
@@ -656,6 +676,20 @@
"#include ""mercury_deep_profiling.h""\n",
"#endif\n",
"\n"]),
+
+ ( { MaybeForeignDecls = yes(ForeignDecls) } ->
+ ( { HighLevelCode = yes } ->
+ module_name_to_file_name(ModuleName,
+ ".mih", no, MIHName),
+ io__write_strings(
+ ["#include """, MIHName, """\n"])
+ ;
+ list__foldl(output_foreign_decl, ForeignDecls)
+ )
+ ;
+ []
+ ),
+
export__produce_header_file_2(C_ExportDecls),
io__write_strings([
"\n",
@@ -676,7 +710,7 @@
io__set_exit_status(1)
).
-:- pred export__produce_header_file_2(foreign_export_decls,
+:- pred export__produce_header_file_2(list(foreign_export_decl),
io__state, io__state).
:- mode export__produce_header_file_2(in, di, uo) is det.
export__produce_header_file_2([]) --> [].
@@ -693,8 +727,28 @@
io__write_string(ArgDecls),
io__write_string(");\n")
;
- { error("export__produce_header_file_2: foreign languages other than C unimplemented") }
+ { sorry(this_file,
+ "foreign languages other than C unimplemented") }
),
export__produce_header_file_2(ExportedProcs).
+
+:- pred output_foreign_decl(foreign_decl_code::in, io::di, io::uo) is det.
+
+export__output_foreign_decl(foreign_decl_code(Lang, Code, Context)) -->
+ ( { Lang = c } ->
+ { term__context_file(Context, FileName) },
+ { term__context_line(Context, LineNumber) },
+ c_util__set_line_num(FileName, LineNumber),
+ io__write_string(Code),
+ io__nl,
+ c_util__reset_line_num
+ ;
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "export.m".
%-----------------------------------------------------------------------------%
Index: compiler/foreign.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/foreign.m,v
retrieving revision 1.17
diff -u -r1.17 foreign.m
--- compiler/foreign.m 30 Jun 2002 17:06:13 -0000 1.17
+++ compiler/foreign.m 17 Jul 2002 13:58:19 -0000
@@ -21,7 +21,7 @@
:- import_module parse_tree__prog_data, libs__globals.
:- import_module hlds__hlds_module, hlds__hlds_pred.
-:- import_module bool, list, string, term.
+:- import_module bool, list, std_util, string, term.
:- type foreign_decl_info == list(foreign_decl_code).
% in reverse order
@@ -39,7 +39,16 @@
foreign_body_code(foreign_language, string, prog_context).
:- type foreign_export_defns == list(foreign_export).
-:- type foreign_export_decls == list(foreign_export_decl).
+:- type foreign_export_decls
+ ---> foreign_export_decls(
+ % The foreign decls needed for use by
+ % the foreign exports, if any.
+ % Currently this will be filled out if
+ % there is a foreign_type declared in
+ % the module.
+ maybe(foreign_decl_info),
+ list(foreign_export_decl)
+ ).
:- type foreign_export_decl
---> foreign_export_decl(
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.74
diff -u -r1.74 hlds_module.m
--- compiler/hlds_module.m 7 Apr 2002 10:22:30 -0000 1.74
+++ compiler/hlds_module.m 17 Jul 2002 13:58:19 -0000
@@ -267,6 +267,12 @@
:- pred module_info_set_globals(module_info, globals, module_info).
:- mode module_info_set_globals(in, in, out) is det.
+:- pred module_info_contains_foreign_type(module_info).
+:- mode module_info_contains_foreign_type(in) is semidet.
+
+:- pred module_info_contains_foreign_type(module_info, module_info).
+:- mode module_info_contains_foreign_type(in, out) is det.
+
:- pred module_info_get_foreign_decl(module_info, foreign_decl_info).
:- mode module_info_get_foreign_decl(in, out) is det.
@@ -527,6 +533,7 @@
module_sub(
module_name :: module_name,
globals :: globals,
+ contains_foreign_type :: bool,
foreign_decl_info :: foreign_decl_info,
foreign_body_info :: foreign_body_info,
foreign_import_module_info :: foreign_import_module_info,
@@ -609,7 +616,7 @@
map__init(FieldNameTable),
map__init(NoTagTypes),
- ModuleSubInfo = module_sub(Name, Globals, [], [], [], no, 0, 0, [],
+ ModuleSubInfo = module_sub(Name, Globals, no, [], [], [], no, 0, 0, [],
[], StratPreds, UnusedArgInfo, 0, ImportedModules,
IndirectlyImportedModules, no_aditi_compilation,
TypeSpecInfo, NoTagTypes),
@@ -669,6 +676,8 @@
module_info_name(MI, MI ^ sub_info ^ module_name).
module_info_globals(MI, MI ^ sub_info ^ globals).
+module_info_contains_foreign_type(MI) :-
+ MI ^ sub_info ^ contains_foreign_type = yes.
module_info_get_foreign_decl(MI, MI ^ sub_info ^ foreign_decl_info).
module_info_get_foreign_body_code(MI, MI ^ sub_info ^ foreign_body_info).
module_info_get_foreign_import_module(MI,
@@ -700,6 +709,8 @@
module_info_set_globals(MI, NewVal,
MI ^ sub_info ^ globals := NewVal).
+module_info_contains_foreign_type(MI,
+ MI ^ sub_info ^ contains_foreign_type := yes).
module_info_set_foreign_decl(MI, NewVal,
MI ^ sub_info ^ foreign_decl_info := NewVal).
module_info_set_foreign_body_code(MI, NewVal,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.416
diff -u -r1.416 make_hlds.m
--- compiler/make_hlds.m 9 Jul 2002 06:53:41 -0000 1.416
+++ compiler/make_hlds.m 17 Jul 2002 13:58:19 -0000
@@ -952,7 +952,8 @@
error_util__write_error_pieces(Context, 0, ErrorPieces),
{ module_info_incr_errors(Module0, Module) }
;
- module_add_type_defn_2(Module0, TVarSet, Name,
+ { module_info_contains_foreign_type(Module0, Module1) },
+ module_add_type_defn_2(Module1, TVarSet, Name,
Args, Body, Cond, Context,
item_status(ImportStatus, NeedQual),
Module)
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.257
diff -u -r1.257 mercury_compile.m
--- compiler/mercury_compile.m 9 Jul 2002 01:29:23 -0000 1.257
+++ compiler/mercury_compile.m 17 Jul 2002 13:58:19 -0000
@@ -3178,7 +3178,8 @@
% If this module contains `:- pragma export' declarations,
% add a "#include <module>.h" declaration.
% XXX pragma export is only supported for C.
- ( UseForeignLanguage = c, Foreign_ExportDecls \= [] ->
+ Foreign_ExportDecls = foreign_export_decls(_, ExportDecls),
+ ( UseForeignLanguage = c, ExportDecls \= [] ->
% We put the new include at the end since the list is
% stored in reverse, and we want this include to come
% first.
@@ -3248,8 +3249,8 @@
{ list__condense([CommonableData, NonCommonStaticData, ClosureLayouts,
TypeCtorTables, TypeClassInfos, PossiblyDynamicLayouts],
AllData) },
- mercury_compile__construct_c_file(C_InterfaceInfo, Procs1, GlobalVars,
- AllData, CFile, NumChunks),
+ mercury_compile__construct_c_file(HLDS, C_InterfaceInfo,
+ Procs1, GlobalVars, AllData, CFile, NumChunks),
mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
MaybeRLFile, Verbose, Stats),
@@ -3273,13 +3274,14 @@
% Split the code up into bite-size chunks for the C compiler.
-:- pred mercury_compile__construct_c_file(foreign_interface_info,
+:- pred mercury_compile__construct_c_file(module_info, foreign_interface_info,
list(c_procedure), list(comp_gen_c_var), list(comp_gen_c_data),
c_file, int, io__state, io__state).
-:- mode mercury_compile__construct_c_file(in, in, in, in, out, out, di, uo)
+:- mode mercury_compile__construct_c_file(in, in, in, in, in, out, out, di, uo)
is det.
-mercury_compile__construct_c_file(C_InterfaceInfo, Procedures, GlobalVars,
+mercury_compile__construct_c_file(Module,
+ C_InterfaceInfo, Procedures, GlobalVars,
AllData, CFile, ComponentCount) -->
{ C_InterfaceInfo = foreign_interface_info(ModuleSymName,
C_HeaderCode0, C_Includes, C_BodyCode0,
@@ -3300,7 +3302,16 @@
),
list__map_foldl(make_foreign_import_header_code, C_Includes,
C_HeaderCode1),
- { C_HeaderCode = C_HeaderCode0 ++ C_HeaderCode1 },
+
+ % If the current module contains a foreign_type then all the
+ % declarations will be placed into the header (.mh) file, so
+ % only keep the foreign imports.
+ { module_info_contains_foreign_type(Module) ->
+ C_HeaderCode = C_HeaderCode1
+ ;
+ C_HeaderCode = C_HeaderCode0 ++ C_HeaderCode1
+ },
+
{ CFile = c_file(ModuleSymName, C_HeaderCode, C_BodyCode,
C_ExportDefns, GlobalVars, AllData, ChunkedModules) },
{ list__length(C_BodyCode, UserCCodeCount) },
----
Peter Ross
PhD Student University of Melbourne
http://www.cs.mu.oz.au/~petdr/
--------------------------------------------------------------------------
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