[m-rev.] for review: pragma foreign_import_module
Simon Taylor
stayl at cs.mu.OZ.AU
Thu Oct 25 16:15:34 AEST 2001
Estimated hours taken: 10
Implement `:- pragma foreign_import_module(Lang, Module)', which tells
the compiler that the foreign code in the module containing the
declaration uses `:- pragma export'ed procedures from module `Module'.
This information is needed for mmake to build things in the right order.
Currently programmers can hand code the required mmake rules, but
`mmc --make' will have no mechanism for doing this.
`:- pragma c_import_module(Module)' is a synonym for
`:- pragma foreign_import_module("C", Module)'.
compiler/prog_io_pragma.m:
Parse the new pragmas.
compiler/prog_data.m:
compiler/foreign.m:
compiler/hlds_module.m:
compiler/mlds.m:
compiler/modules.m:
Add the `:- pragma foreign_import_module' to the
compiler's datastructures.
compiler/make_hlds.m:
Insert `:- pragma foreign_import_module' declarations
into the HLDS.
compiler/modules.m:
Add the extra dependency information from
`:- pragma foreign_import_module' declarations
to the `.d' files.
compiler/llds.m:
compiler/foreign.m:
Move some non-backend-specific types describing the foreign
language interface from llds.m to foreign.m.
compiler/intermod.m:
Write `:- pragma foreign_import_module' declarations
to `.opt' files. XXX mmake doesn't support this properly yet.
compiler/mercury_compile.m:
compiler/foreign.m:
compiler/ml_code_gen.m:
compiler/ml_code_gen.m:
compiler/mlds_to_c.m:
compiler/mlds_to_csharp.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_mcpp.m:
Convert `:- pragma foreign_import_module' to `#include'
statements where appropriate depending on the target
language.
compiler/*.m:
Handle `:- pragma foreign_import_module'.
Import foreign.m rather than llds.m for the foreign
interface types.
doc/reference_manual.texi:
NEWS:
Document the new pragmas.
Minor fixes for the foreign code documentation.
tests/hard_coded/Mmakefile:
tests/hard_coded/foreign_import_module.m:
tests/hard_coded/foreign_import_module_2.m:
tests/hard_coded/foreign_import_module.exp:
Test case.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.220
diff -u -u -r1.220 NEWS
--- NEWS 12 Oct 2001 05:23:31 -0000 1.220
+++ NEWS 25 Oct 2001 06:03:39 -0000
@@ -36,6 +36,14 @@
information, see the "Impurity" chapter of the Mercury Language
Reference Manual.
+* We've added `:- pragma c_import_module' declarations, which are
+ used to make the C declarations for predicates and functions with
+ `:- pragma export' declarations in the imported module visible
+ to any C code in the importing module. `mmake' uses
+ `:- pragma c_import_module' declarations to make sure that the
+ header file for the imported module is built before it is needed,
+ which it can't do if the header file is explicitly #included.
+
Changes to the Mercury standard library:
* As mentioned above, the constructor for lists has changed from './2'
to `[|]/2'. This change affects the behaviour of the term manipulation
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.49
diff -u -u -r1.49 export.m
--- compiler/export.m 24 Oct 2001 13:34:09 -0000 1.49
+++ compiler/export.m 24 Oct 2001 14:18:32 -0000
@@ -18,7 +18,7 @@
:- interface.
-:- import_module prog_data, hlds_module, llds.
+:- import_module prog_data, hlds_module, foreign.
:- import_module io.
% From the module_info, get a list of foreign_export_decls,
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.8
diff -u -u -r1.8 foreign.m
--- compiler/foreign.m 24 Oct 2001 13:34:10 -0000 1.8
+++ compiler/foreign.m 24 Oct 2001 14:21:18 -0000
@@ -20,9 +20,48 @@
:- import_module prog_data, globals.
:- import_module hlds_module, hlds_pred.
-:- import_module llds.
-:- import_module bool, list, string.
+:- import_module bool, list, string, term.
+
+:- type foreign_decl_info == list(foreign_decl_code).
+ % in reverse order
+:- type foreign_import_module_info == list(foreign_import_module).
+ % in reverse order
+:- type foreign_body_info == list(foreign_body_code).
+ % in reverse order
+
+:- type foreign_decl_code --->
+ foreign_decl_code(foreign_language, string, prog_context).
+:- type foreign_import_module --->
+ foreign_import_module(foreign_language, module_name,
+ prog_context).
+:- type foreign_body_code --->
+ 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_decl
+ ---> foreign_export_decl(
+ foreign_language, % language of the export
+ string, % return type
+ string, % function name
+ string % argument declarations
+ ).
+
+ % Some code from a `pragma foreign_code' declaration that is not
+ % associated with a given procedure.
+:- type user_foreign_code
+ ---> user_foreign_code(
+ foreign_language, % language of this code
+ string, % code
+ term__context % source code location
+ ).
+
+ % the code for `pragma export' is generated directly as strings
+ % by export.m.
+:- type foreign_export == string.
+
% A type which is used to determine the string representation of a
% mercury type for various foreign languages.
:- type exported_type.
@@ -47,6 +86,13 @@
foreign_decl_info, foreign_decl_info).
:- mode foreign__filter_decls(in, in, out, out) is det.
+ % Filter the module imports for the given foreign language.
+ % The first return value is the list of matches, the second is
+ % the list of mis-matches.
+:- pred foreign__filter_imports(foreign_language, foreign_import_module_info,
+ foreign_import_module_info, foreign_import_module_info).
+:- mode foreign__filter_imports(in, in, out, out) is det.
+
% Filter the bodys for the given foreign language.
% The first return value is the list of matches, the second is
% the list of mis-matches.
@@ -178,6 +224,12 @@
list__filter((pred(foreign_decl_code(Lang, _, _)::in) is semidet :-
WantedLang = Lang),
Decls0, LangDecls, NotLangDecls).
+
+foreign__filter_imports(WantedLang, Imports0, LangImports, NotLangImports) :-
+ list__filter(
+ (pred(foreign_import_module(Lang, _, _)::in) is semidet :-
+ WantedLang = Lang),
+ Imports0, LangImports, NotLangImports).
foreign__filter_bodys(WantedLang, Bodys0, LangBodys, NotLangBodys) :-
list__filter((pred(foreign_body_code(Lang, _, _)::in) is semidet :-
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.68
diff -u -u -r1.68 hlds_module.m
--- compiler/hlds_module.m 5 Sep 2001 09:10:07 -0000 1.68
+++ compiler/hlds_module.m 24 Oct 2001 13:11:09 -0000
@@ -23,7 +23,7 @@
:- import_module prog_data, module_qual, recompilation.
:- import_module hlds_pred, hlds_data, unify_proc, special_pred.
-:- import_module globals, llds.
+:- import_module globals, foreign.
:- import_module relation, map, std_util, list, set, multi_map, counter.
:- implementation.
@@ -270,13 +270,26 @@
:- pred module_info_get_foreign_body_code(module_info, foreign_body_info).
:- mode module_info_get_foreign_body_code(in, out) is det.
-:- pred module_info_set_foreign_body_code(module_info, foreign_body_info, module_info).
+:- pred module_info_set_foreign_body_code(module_info,
+ foreign_body_info, module_info).
:- mode module_info_set_foreign_body_code(in, in, out) is det.
+:- pred module_info_get_foreign_import_module(module_info,
+ foreign_import_module_info).
+:- mode module_info_get_foreign_import_module(in, out) is det.
+
+:- pred module_info_set_foreign_import_module(module_info,
+ foreign_import_module_info, module_info).
+:- mode module_info_set_foreign_import_module(in, in, out) is det.
+
:- pred module_add_foreign_decl(foreign_language, string, prog_context,
module_info, module_info).
:- mode module_add_foreign_decl(in, in, in, in, out) is det.
+:- pred module_add_foreign_import_module(foreign_language,
+ module_name, prog_context, module_info, module_info).
+:- mode module_add_foreign_import_module(in, in, in, in, out) is det.
+
:- pred module_add_foreign_body_code(foreign_language, string, prog_context,
module_info, module_info).
:- mode module_add_foreign_body_code(in, in, in, in, out) is det.
@@ -508,6 +521,7 @@
globals :: globals,
foreign_decl_info :: foreign_decl_info,
foreign_body_info :: foreign_body_info,
+ foreign_import_module_info :: foreign_import_module_info,
% This dependency info is constrained to be only
% for between procedures which have clauses
@@ -586,7 +600,7 @@
map__init(FieldNameTable),
map__init(NoTagTypes),
- ModuleSubInfo = module_sub(Name, Globals, [], [], no, 0, 0, [],
+ ModuleSubInfo = module_sub(Name, Globals, [], [], [], no, 0, 0, [],
[], StratPreds, UnusedArgInfo, 0, ImportedModules,
IndirectlyImportedModules, no_aditi_compilation,
TypeSpecInfo, NoTagTypes),
@@ -646,6 +660,8 @@
module_info_globals(MI, MI ^ sub_info ^ globals).
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,
+ MI ^ sub_info ^ foreign_import_module_info).
module_info_get_maybe_dependency_info(MI,
MI ^ sub_info ^ maybe_dependency_info).
module_info_num_errors(MI, MI ^ sub_info ^ num_errors).
@@ -677,6 +693,8 @@
MI ^ sub_info ^ foreign_decl_info := NewVal).
module_info_set_foreign_body_code(MI, NewVal,
MI ^ sub_info ^ foreign_body_info := NewVal).
+module_info_set_foreign_import_module(MI, NewVal,
+ MI ^ sub_info ^ foreign_import_module_info := NewVal).
module_info_set_maybe_dependency_info(MI, NewVal,
MI ^ sub_info ^ maybe_dependency_info := NewVal).
module_info_set_num_errors(MI, NewVal,
@@ -890,6 +908,16 @@
ForeignDeclIndex1 = [foreign_decl_code(Lang, ForeignDecl, Context) |
ForeignDeclIndex0],
module_info_set_foreign_decl(Module0, ForeignDeclIndex1, Module).
+
+module_add_foreign_import_module(Lang, ModuleName, Context, Module0, Module) :-
+ module_info_get_foreign_import_module(Module0, ForeignImportIndex0),
+ % store the decls in reverse order and reverse them later
+ % for efficiency
+ ForeignImportIndex1 =
+ [foreign_import_module(Lang, ModuleName, Context) |
+ ForeignImportIndex0],
+ module_info_set_foreign_import_module(Module0,
+ ForeignImportIndex1, Module).
module_add_foreign_body_code(Lang, Foreign_Body_Code, Context,
Module0, Module) :-
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.108
diff -u -u -r1.108 intermod.m
--- compiler/intermod.m 24 Oct 2001 13:34:14 -0000 1.108
+++ compiler/intermod.m 24 Oct 2001 14:18:38 -0000
@@ -90,7 +90,7 @@
:- import_module hlds_data, hlds_goal, hlds_pred, hlds_out, inlining, llds.
:- import_module mercury_to_mercury, mode_util, modules.
:- import_module options, passes_aux, prog_data, prog_io, prog_out, prog_util.
-:- import_module special_pred, typecheck, type_util, instmap, (inst).
+:- import_module special_pred, typecheck, type_util, instmap, (inst), foreign.
%-----------------------------------------------------------------------------%
@@ -1115,8 +1115,46 @@
globals__io_lookup_string_option(dump_hlds_options, VerboseDump),
globals__io_set_option(dump_hlds_options, string("")),
( { WriteHeader = yes } ->
- { module_info_get_foreign_decl(ModuleInfo, ForeignDecl) },
- intermod__write_foreign_decl(ForeignDecl)
+ { module_info_get_foreign_decl(ModuleInfo, RevForeignDecls) },
+ { module_info_get_foreign_import_module(ModuleInfo,
+ RevForeignImports) },
+ { module_info_get_pragma_exported_procs(ModuleInfo,
+ PragmaExportedProcs) },
+ { ForeignDecls = list__reverse(RevForeignDecls) },
+ { ForeignImports0 = list__reverse(RevForeignImports) },
+ { PragmaExportedProcs = [] ->
+ ForeignImports = ForeignImports0
+ ;
+ ForeignImports = ForeignImports0
+ /*
+ % XXX We should do this, but mmake can't
+ % handle the extra dependencies properly yet,
+ % so building the standard library fails.
+
+ % The `:- pragma export'ed procedures may be
+ % referred to by the C code we are writing to
+ % the `.opt' file.
+ % XXX Currently we only handle procedures
+ % exported to C.
+ module_info_name(ModuleInfo, ModuleName),
+ ForeignImportThisModule = foreign_import_module(c,
+ ModuleName, term__context_init),
+ ForeignImports =
+ [ForeignImportThisModule | ForeignImports0]
+ */
+ },
+ list__foldl(
+ (pred(ForeignImport::in, di, uo) is det -->
+ { ForeignImport = foreign_import_module(Lang,
+ Import, _) },
+ mercury_output_pragma_foreign_import_module(Lang,
+ Import)
+ ), ForeignImports),
+ list__foldl(
+ (pred(ForeignDecl::in, di, uo) is det -->
+ { ForeignDecl = foreign_decl_code(Lang, Header, _) },
+ mercury_output_pragma_foreign_decl(Lang, Header)
+ ), ForeignDecls)
;
[]
),
@@ -1139,15 +1177,6 @@
intermod__write_modules(Rest)
).
-:- pred intermod__write_foreign_decl(list(foreign_decl_code)::in,
- io__state::di, io__state::uo) is det.
-
-intermod__write_foreign_decl([]) --> [].
-intermod__write_foreign_decl(
- [foreign_decl_code(Language, Header, _) | Headers]) -->
- intermod__write_foreign_decl(Headers),
- mercury_output_pragma_foreign_decl(Language, Header).
-
:- pred intermod__write_types(assoc_list(type_id, hlds_type_defn)::in,
io__state::di, io__state::uo) is det.
@@ -2013,7 +2042,7 @@
% Read in the .opt files for imported and ancestor modules.
%
{ Module0 = module_imports(_, ModuleName, Ancestors0, InterfaceDeps0,
- ImplementationDeps0, _, _, _, _, _, _, _) },
+ ImplementationDeps0, _, _, _, _, _, _, _, _) },
{ list__condense([Ancestors0, InterfaceDeps0, ImplementationDeps0],
OptFiles) },
read_optimization_interfaces(OptFiles, [], OptItems, no, OptError),
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.279
diff -u -u -r1.279 llds.m
--- compiler/llds.m 24 Oct 2001 13:34:15 -0000 1.279
+++ compiler/llds.m 24 Oct 2001 14:18:40 -0000
@@ -18,7 +18,7 @@
:- import_module prog_data, (inst).
:- import_module hlds_pred, hlds_goal, hlds_data.
-:- import_module code_model, rtti, layout, builtin_ops.
+:- import_module foreign, code_model, rtti, layout, builtin_ops.
:- import_module tree.
:- import_module bool, assoc_list, list, map, set, std_util, counter, term.
@@ -32,37 +32,13 @@
module_name,
% info about stuff imported from C:
foreign_decl_info,
+ foreign_import_module_info,
foreign_body_info,
% info about stuff exported to C:
foreign_export_decls,
foreign_export_defns
).
-:- type foreign_decl_info == list(foreign_decl_code).
- % in reverse order
-:- type foreign_body_info == list(foreign_body_code).
- % in reverse order
-
-:- type foreign_decl_code --->
- foreign_decl_code(foreign_language, string, prog_context).
-:- type foreign_body_code --->
- 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_decl
- ---> foreign_export_decl(
- foreign_language, % language of the export
- string, % return type
- string, % function name
- string % argument declarations
- ).
-
- % the code for `pragma export' is generated directly as strings
- % by export.m.
-:- type foreign_export == string.
-
%-----------------------------------------------------------------------------%
:- import_module continuation_info.
@@ -118,15 +94,6 @@
list(comp_gen_c_var),
list(comp_gen_c_data),
list(comp_gen_c_module)
- ).
-
- % Some code from a `pragma foreign_code' declaration that is not
- % associated with a given procedure.
-:- type user_foreign_code
- ---> user_foreign_code(
- foreign_language, % language of this code
- string, % code
- term__context % source code location
).
% 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.181
diff -u -u -r1.181 llds_out.m
--- compiler/llds_out.m 24 Oct 2001 13:34:17 -0000 1.181
+++ compiler/llds_out.m 24 Oct 2001 14:18:41 -0000
@@ -259,7 +259,7 @@
:- import_module rtti, rtti_out, layout, layout_out, options, trace_params.
:- import_module exprn_aux, prog_util, prog_out, hlds_pred.
:- import_module export, mercury_to_mercury, modules, passes_aux.
-:- import_module c_util.
+:- import_module c_util, foreign.
:- import_module int, char, string, std_util.
:- import_module set, bintree_set, assoc_list, require.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.388
diff -u -u -r1.388 make_hlds.m
--- compiler/make_hlds.m 24 Oct 2001 13:34:19 -0000 1.388
+++ compiler/make_hlds.m 24 Oct 2001 14:18:42 -0000
@@ -386,6 +386,10 @@
{ module_add_foreign_decl(Lang, C_Header, Context,
Module0, Module) }
;
+ { Pragma = foreign_import_module(Lang, Import) },
+ { module_add_foreign_import_module(Lang, Import, Context,
+ Module0, Module) }
+ ;
% Handle pragma foreign procs later on (when we process
% clauses).
{ Pragma = foreign_proc(_, _, _, _, _, _) },
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.221
diff -u -u -r1.221 mercury_compile.m
--- compiler/mercury_compile.m 24 Oct 2001 05:56:27 -0000 1.221
+++ compiler/mercury_compile.m 24 Oct 2001 13:36:26 -0000
@@ -1299,7 +1299,8 @@
{ Imports0 = module_imports(_File, _Module, Ancestors,
InterfaceImports, ImplementationImports,
_IndirectImports, _PublicChildren, _FactDeps,
- _ForeignCode, _Items, _Error, _Timestamps) },
+ _ForeignCode, _ForeignImports, _Items,
+ _Error, _Timestamps) },
{ list__condense([Ancestors, InterfaceImports,
ImplementationImports], TransOptFiles) },
trans_opt__grab_optfiles(Imports1, TransOptFiles,
@@ -2953,16 +2954,34 @@
get_c_interface_info(HLDS, UseForeignLanguage, Foreign_InterfaceInfo) :-
module_info_name(HLDS, ModuleName),
module_info_get_foreign_decl(HLDS, ForeignDecls),
+ module_info_get_foreign_import_module(HLDS, ForeignImports),
module_info_get_foreign_body_code(HLDS, ForeignBodyCode),
foreign__filter_decls(UseForeignLanguage, ForeignDecls,
WantedForeignDecls, _OtherDecls),
+ foreign__filter_imports(UseForeignLanguage, ForeignImports,
+ WantedForeignImports0, _OtherImports),
foreign__filter_bodys(UseForeignLanguage, ForeignBodyCode,
WantedForeignBodys, _OtherBodys),
export__get_foreign_export_decls(HLDS, Foreign_ExportDecls),
export__get_foreign_export_defns(HLDS, Foreign_ExportDefns),
+
+ % 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 \= [] ->
+ % We put the new include at the end since the list is
+ % stored in reverse, and we want this include to come
+ % first.
+ Import = foreign_import_module(c, ModuleName,
+ term__context_init),
+ WantedForeignImports = WantedForeignImports0 ++ [Import]
+ ;
+ WantedForeignImports = WantedForeignImports0
+ ),
+
Foreign_InterfaceInfo = foreign_interface_info(ModuleName,
- WantedForeignDecls, WantedForeignBodys,
- Foreign_ExportDecls, Foreign_ExportDefns).
+ WantedForeignDecls, WantedForeignImports,
+ WantedForeignBodys, Foreign_ExportDecls, Foreign_ExportDefns).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -3024,7 +3043,7 @@
mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
MaybeRLFile, Verbose, Stats),
- { C_InterfaceInfo = foreign_interface_info(_, _, _, C_ExportDecls, _) },
+ { C_InterfaceInfo = foreign_interface_info(_, _, _, _, C_ExportDecls, _) },
export__produce_header_file(C_ExportDecls, ModuleName),
%
@@ -3049,7 +3068,8 @@
mercury_compile__construct_c_file(C_InterfaceInfo, Procedures, GlobalVars,
AllData, CFile, ComponentCount) -->
{ C_InterfaceInfo = foreign_interface_info(ModuleSymName,
- C_HeaderCode0, C_BodyCode0, C_ExportDecls, C_ExportDefns) },
+ C_HeaderCode0, C_Includes, C_BodyCode0,
+ _C_ExportDecls, C_ExportDefns) },
{ llds_out__sym_name_mangle(ModuleSymName, MangledModuleName) },
{ string__append(MangledModuleName, "_module", ModuleName) },
globals__io_lookup_int_option(procs_per_c_function, ProcsPerFunc),
@@ -3064,8 +3084,9 @@
{ mercury_compile__combine_chunks(ChunkedProcs, ModuleName,
ChunkedModules) }
),
- maybe_add_header_file_include(C_ExportDecls, ModuleSymName,
- C_HeaderCode0, C_HeaderCode),
+ list__map_foldl(make_foreign_import_header_code, C_Includes,
+ 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) },
@@ -3076,29 +3097,29 @@
{ ComponentCount is UserCCodeCount + ExportCount
+ CompGenVarCount + CompGenDataCount + CompGenCodeCount }.
-:- pred maybe_add_header_file_include(foreign_export_decls, module_name,
- foreign_decl_info, foreign_decl_info, io__state, io__state).
-:- mode maybe_add_header_file_include(in, in, in, out, di, uo) is det.
-
-maybe_add_header_file_include(C_ExportDecls, ModuleName,
- C_HeaderCode0, C_HeaderCode) -->
+:- pred make_foreign_import_header_code(foreign_import_module,
+ foreign_decl_code, io__state, io__state).
+:- mode make_foreign_import_header_code(in, out, di, uo) is det.
+
+make_foreign_import_header_code(
+ foreign_import_module(Lang, ModuleName, Context),
+ Include) -->
(
- { C_ExportDecls = [] },
- { C_HeaderCode = C_HeaderCode0 }
- ;
- { C_ExportDecls = [_|_] },
+ { Lang = c },
module_name_to_file_name(ModuleName, ".h", no, HeaderFileName),
{ string__append_list(
["#include """, HeaderFileName, """\n"],
IncludeString) },
-
- { term__context_init(Context) },
- { Include = foreign_decl_code(c, IncludeString, Context) },
-
- % We put the new include at the end since the list is
- % stored in reverse, and we want this include to come
- % first.
- { list__append(C_HeaderCode0, [Include], C_HeaderCode) }
+ { Include = foreign_decl_code(c, IncludeString, Context) }
+ ;
+ { Lang = csharp },
+ { error("sorry, not yet implemented: `:- pragma foreign_import_module' for C#") }
+ ;
+ { Lang = managed_cplusplus },
+ { error("sorry, not yet implemented: `:- pragma foreign_import_module' for Managed C++") }
+ ;
+ { Lang = il },
+ { error("sorry, not yet implemented: `:- pragma foreign_import_module' for IL") }
).
:- pred get_c_body_code(foreign_body_info, list(user_foreign_code)).
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.195
diff -u -u -r1.195 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 24 Oct 2001 13:34:23 -0000 1.195
+++ compiler/mercury_to_mercury.m 24 Oct 2001 14:18:44 -0000
@@ -171,6 +171,10 @@
:- func mercury_pragma_foreign_decl_to_string(foreign_language, string)
= string.
+:- pred mercury_output_pragma_foreign_import_module(foreign_language,
+ module_name, io__state, io__state).
+:- mode mercury_output_pragma_foreign_import_module(in, in, di, uo) is det.
+
:- pred mercury_output_ctor(constructor, tvarset, io__state, io__state).
:- mode mercury_output_ctor(in, in, di, uo) is det.
@@ -451,6 +455,9 @@
{ Pragma = foreign_decl(Lang, ForeignHeaderString) },
mercury_output_pragma_foreign_decl(Lang, ForeignHeaderString)
;
+ { Pragma = foreign_import_module(Lang, ModuleName) },
+ mercury_output_pragma_foreign_import_module(Lang, ModuleName)
+ ;
{ Pragma = foreign_code(Lang, Code) },
mercury_output_pragma_foreign_body_code(Lang, Code)
;
@@ -2390,6 +2397,14 @@
mercury_format_foreign_language_string(Lang) -->
add_string("""" ++ foreign_language_string(Lang) ++ """").
+
+mercury_output_pragma_foreign_import_module(Lang, ModuleName) -->
+ io__write_string(":- pragma foreign_import_module("),
+ mercury_format_foreign_language_string(Lang),
+ io__write_string(", "),
+ mercury_output_bracketed_sym_name(ModuleName,
+ not_next_to_graphic_token),
+ io__write_string(").\n").
%-----------------------------------------------------------------------------%
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.102
diff -u -u -r1.102 ml_code_gen.m
--- compiler/ml_code_gen.m 24 Oct 2001 13:34:25 -0000 1.102
+++ compiler/ml_code_gen.m 24 Oct 2001 14:18:44 -0000
@@ -804,6 +804,7 @@
ml_gen_foreign_code(ModuleInfo, All_MLDS_ForeignCode) -->
{ module_info_get_foreign_decl(ModuleInfo, ForeignDecls) },
+ { module_info_get_foreign_import_module(ModuleInfo, ForeignImports) },
{ module_info_get_foreign_body_code(ModuleInfo, ForeignBodys) },
globals__io_get_backend_foreign_languages(BackendForeignLanguages),
@@ -811,6 +812,9 @@
foreign__filter_decls(Lang,
ForeignDecls, WantedForeignDecls,
_OtherForeignDecls),
+ foreign__filter_imports(Lang,
+ ForeignImports, WantedForeignImports,
+ _OtherForeignImports),
foreign__filter_bodys(Lang,
ForeignBodys, WantedForeignBodys,
_OtherForeignBodys),
@@ -827,8 +831,8 @@
MLDS_PragmaExports = []
),
MLDS_ForeignCode = mlds__foreign_code(
- WantedForeignDecls, MLDSWantedForeignBodys,
- MLDS_PragmaExports),
+ WantedForeignDecls, WantedForeignImports,
+ MLDSWantedForeignBodys, MLDS_PragmaExports),
map__det_insert(Map0, Lang,
MLDS_ForeignCode, Map)
), BackendForeignLanguages, map__init, All_MLDS_ForeignCode) }.
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.72
diff -u -u -r1.72 mlds.m
--- compiler/mlds.m 24 Oct 2001 13:34:28 -0000 1.72
+++ compiler/mlds.m 24 Oct 2001 14:21:39 -0000
@@ -282,11 +282,6 @@
:- import_module prog_data, builtin_ops, rtti, code_model.
:- import_module foreign, type_util.
-% To avoid duplication, we use a few things from the LLDS
-% (specifically stuff for the C interface).
-% It would be nice to avoid this dependency...
-:- import_module llds.
-
:- import_module bool, list, assoc_list, std_util, map.
%-----------------------------------------------------------------------------%
@@ -740,6 +735,7 @@
:- type mlds__foreign_code
---> mlds__foreign_code(
foreign_decl_info,
+ foreign_import_module_info,
list(user_foreign_code),
list(mlds__pragma_export)
).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.105
diff -u -u -r1.105 mlds_to_c.m
--- compiler/mlds_to_c.m 24 Oct 2001 13:34:28 -0000 1.105
+++ compiler/mlds_to_c.m 24 Oct 2001 14:22:48 -0000
@@ -49,7 +49,6 @@
:- implementation.
:- import_module ml_util.
-:- import_module llds. % XXX needed for C interface types
:- import_module llds_out. % XXX needed for llds_out__name_mangle,
% llds_out__sym_name_mangle,
% llds_out__make_base_typeclass_info_name,
@@ -383,7 +382,7 @@
;
% this can occur when compiling to a non-C target
% using "--mlds-dump all"
- ForeignCode = foreign_code([], [], [])
+ ForeignCode = foreign_code([], [], [], [])
).
%-----------------------------------------------------------------------------%
@@ -519,8 +518,8 @@
:- mode mlds_output_c_hdr_decls(in, in, in, di, uo) is det.
mlds_output_c_hdr_decls(ModuleName, Indent, ForeignCode) -->
- { ForeignCode = mlds__foreign_code(RevHeaderCode, _RevBodyCode,
- ExportDefns) },
+ { ForeignCode = mlds__foreign_code(RevHeaderCode, _RevImports,
+ _RevBodyCode, ExportDefns) },
{ HeaderCode = list__reverse(RevHeaderCode) },
io__write_list(HeaderCode, "\n", mlds_output_c_hdr_decl(Indent)),
io__write_string("\n"),
@@ -552,8 +551,19 @@
:- mode mlds_output_c_defns(in, in, in, di, uo) is det.
mlds_output_c_defns(ModuleName, Indent, ForeignCode) -->
- { ForeignCode = mlds__foreign_code(_RevHeaderCode, RevBodyCode,
- ExportDefns) },
+ { ForeignCode = mlds__foreign_code(_RevHeaderCode, RevImports,
+ RevBodyCode, ExportDefns) },
+ { Imports = list__reverse(RevImports) },
+ list__foldl(
+ (pred(ForeignImport::in, di, uo) is det -->
+ { ForeignImport = foreign_import_module(Lang, Import, _) },
+ ( { Lang = c } ->
+ mlds_output_src_import(Indent,
+ mercury_module_name_to_mlds(Import))
+ ;
+ { sorry(this_file, "foreign code other than C") }
+ )
+ ), Imports),
{ BodyCode = list__reverse(RevBodyCode) },
io__write_list(BodyCode, "\n", mlds_output_c_defn(Indent)),
io__write_string("\n"),
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
retrieving revision 1.18
diff -u -u -r1.18 mlds_to_csharp.m
--- compiler/mlds_to_csharp.m 24 Oct 2001 13:34:29 -0000 1.18
+++ compiler/mlds_to_csharp.m 24 Oct 2001 14:18:47 -0000
@@ -29,11 +29,10 @@
:- import_module builtin_ops, c_util, modules, tree.
:- import_module hlds_pred. % for `pred_proc_id'.
:- import_module prog_data, prog_out.
-:- import_module rtti, type_util, error_util.
+:- import_module foreign, rtti, type_util, error_util.
:- import_module ilds, ilasm, il_peephole.
:- import_module ml_util, ml_code_util.
-:- use_module llds. /* for user_c_code */
:- import_module bool, int, map, string, list, assoc_list, term, std_util.
:- import_module library, require, counter.
@@ -153,16 +152,17 @@
io__nl.
- % XXX we don't handle export decls.
+ % XXX we don't handle export decls or
+ % `:- pragma foreign_import_module'.
:- pred generate_foreign_code(mlds_module_name, mlds__foreign_code,
io__state, io__state).
:- mode generate_foreign_code(in, in, di, uo) is det.
generate_foreign_code(_ModuleName,
- mlds__foreign_code(_RevHeaderCode, RevBodyCode,
+ mlds__foreign_code(_RevHeaderCode, _RevImports, RevBodyCode,
_ExportDefns)) -->
{ BodyCode = list__reverse(RevBodyCode) },
io__write_list(BodyCode, "\n",
- (pred(llds__user_foreign_code(Lang, Code, _Context)::in,
+ (pred(user_foreign_code(Lang, Code, _Context)::in,
di, uo) is det -->
( { Lang = csharp } ->
io__write_string(Code)
@@ -172,16 +172,17 @@
)
)).
- % XXX we don't handle export decls.
+ % XXX we don't handle export decls or
+ % `:- pragma foreign_import_module'.
:- pred generate_foreign_header_code(mlds_module_name, mlds__foreign_code,
io__state, io__state).
:- mode generate_foreign_header_code(in, in, di, uo) is det.
generate_foreign_header_code(_ModuleName,
- mlds__foreign_code(RevHeaderCode, _RevBodyCode,
+ mlds__foreign_code(RevHeaderCode, _RevImports, _RevBodyCode,
_ExportDefns)) -->
{ HeaderCode = list__reverse(RevHeaderCode) },
io__write_list(HeaderCode, "\n",
- (pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
+ (pred(foreign_decl_code(Lang, Code, _Context)::in,
di, uo) is det -->
( { Lang = csharp } ->
io__write_string(Code)
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.54
diff -u -u -r1.54 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 24 Oct 2001 13:34:29 -0000 1.54
+++ compiler/mlds_to_gcc.m 24 Oct 2001 14:18:47 -0000
@@ -250,7 +250,7 @@
% that were defined in other modules, but to call mlds_to_c
% for foreign_decls that were defined in the module that
% we're compiling.
- { ForeignCode = mlds__foreign_code(_Decls, [], []) },
+ { ForeignCode = mlds__foreign_code(_Decls, _Imports, [], []) },
{ ForeignDefns = [] }
->
{ ContainsCCode = no },
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.87
diff -u -u -r1.87 mlds_to_il.m
--- compiler/mlds_to_il.m 24 Oct 2001 13:34:30 -0000 1.87
+++ compiler/mlds_to_il.m 24 Oct 2001 14:18:48 -0000
@@ -280,7 +280,7 @@
transform_mlds(MLDS0) = MLDS :-
AllExports = list__condense(
list__map(
- (func(mlds__foreign_code(_, _, Exports)) = Exports),
+ (func(mlds__foreign_code(_, _, _, Exports)) = Exports),
map__values(MLDS0 ^ foreign_code))
),
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.22
diff -u -u -r1.22 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m 24 Oct 2001 13:34:32 -0000 1.22
+++ compiler/mlds_to_mcpp.m 24 Oct 2001 14:18:48 -0000
@@ -44,7 +44,7 @@
:- import_module builtin_ops, c_util, modules, tree.
:- import_module hlds_pred. % for `pred_proc_id'.
:- import_module prog_data, prog_out, llds_out.
-:- import_module rtti, type_util, error_util.
+:- import_module foreign, rtti, type_util, error_util.
:- import_module ilds, ilasm, il_peephole.
:- import_module ml_util, ml_code_util.
@@ -172,11 +172,11 @@
io__state, io__state).
:- mode generate_foreign_code(in, in, di, uo) is det.
generate_foreign_code(_ModuleName,
- mlds__foreign_code(_RevHeaderCode, RevBodyCode,
+ mlds__foreign_code(_RevHeaderCode, _RevImports, RevBodyCode,
_ExportDefns)) -->
{ BodyCode = list__reverse(RevBodyCode) },
io__write_list(BodyCode, "\n",
- (pred(llds__user_foreign_code(Lang, Code, Context)::in,
+ (pred(user_foreign_code(Lang, Code, Context)::in,
di, uo) is det -->
( { Lang = managed_cplusplus } ->
mlds_to_c__output_context(mlds__make_context(
@@ -193,11 +193,11 @@
io__state, io__state).
:- mode generate_foreign_header_code(in, in, di, uo) is det.
generate_foreign_header_code(_ModuleName,
- mlds__foreign_code(RevHeaderCode, _RevBodyCode,
+ mlds__foreign_code(RevHeaderCode, _RevImports, _RevBodyCode,
_ExportDefns)) -->
{ HeaderCode = list__reverse(RevHeaderCode) },
io__write_list(HeaderCode, "\n",
- (pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
+ (pred(foreign_decl_code(Lang, Code, _Context)::in,
di, uo) is det -->
( { Lang = managed_cplusplus } ->
io__write_string(Code)
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.69
diff -u -u -r1.69 module_qual.m
--- compiler/module_qual.m 24 Oct 2001 13:34:32 -0000 1.69
+++ compiler/module_qual.m 24 Oct 2001 14:23:25 -0000
@@ -893,6 +893,8 @@
qualify_pragma(source_file(File), source_file(File), Info, Info) --> [].
qualify_pragma(foreign_decl(L, Code), foreign_decl(L, Code), Info, Info) --> [].
qualify_pragma(foreign_code(L, C), foreign_code(L, C), Info, Info) --> [].
+qualify_pragma(foreign_import_module(L, M), foreign_import_module(L, M),
+ Info, Info) --> [].
qualify_pragma(foreign_type(Backend, Type0, SymName, F),
foreign_type(Backend, Type, SymName, F), Info0, Info) -->
qualify_type(Type0, Type, Info0, Info).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.199
diff -u -u -r1.199 modules.m
--- compiler/modules.m 24 Oct 2001 13:34:33 -0000 1.199
+++ compiler/modules.m 25 Oct 2001 04:16:12 -0000
@@ -39,7 +39,7 @@
:- interface.
-:- import_module prog_data, prog_io, globals, timestamp.
+:- import_module foreign, prog_data, prog_io, globals, timestamp.
:- import_module std_util, bool, list, map, set, io.
%-----------------------------------------------------------------------------%
@@ -277,6 +277,9 @@
foreign_code :: contains_foreign_code,
% Whether or not the module contains
% foreign code (and which languages if it does)
+ foreign_import_module_info :: foreign_import_module_info,
+ % The `:- pragma foreign_import_module'
+ % declarations.
items :: item_list,
% The contents of the module and its imports
error :: module_error,
@@ -1139,6 +1142,7 @@
% header file, which currently we don't.
pragma_allowed_in_interface(foreign_decl(_, _), no).
+pragma_allowed_in_interface(foreign_import_module(_, _), no).
pragma_allowed_in_interface(foreign_code(_, _), no).
pragma_allowed_in_interface(foreign_proc(_, _, _, _, _, _), no).
pragma_allowed_in_interface(foreign_type(_, _, _, _), yes).
@@ -1555,7 +1559,7 @@
init_module_imports(SourceFileName, ModuleName, Items, PublicChildren,
FactDeps, MaybeTimestamps, Module) :-
Module = module_imports(SourceFileName, ModuleName, [], [], [], [],
- PublicChildren, FactDeps, unknown, Items, no_module_errors,
+ PublicChildren, FactDeps, unknown, [], Items, no_module_errors,
MaybeTimestamps).
module_imports_get_source_file_name(Module, Module ^ source_file_name).
@@ -1785,7 +1789,8 @@
write_dependency_file(Module, AllDepsSet, MaybeTransOptDeps) -->
{ Module = module_imports(SourceFileName, ModuleName, ParentDeps,
IntDeps, ImplDeps, IndirectDeps, _InclDeps, FactDeps0,
- ContainsForeignCode, Items, _Error, _Timestamps) },
+ ContainsForeignCode, ForeignImports0,
+ Items, _Error, _Timestamps) },
globals__io_lookup_bool_option(verbose, Verbose),
{ module_name_to_make_var_name(ModuleName, MakeVarName) },
module_name_to_file_name(ModuleName, ".d", yes, DependencyFileName),
@@ -2006,26 +2011,36 @@
ObjFileName, " ",
SplitObjPattern, " :"
]),
- write_dependencies_list(AllDeps, ".h", DepStream),
-
- %
- % We also need to tell make how to make the header
- % files. The header files are actually built by
- % the same command that creates the .c files, so
- % we just make them depend on the .c files.
- %
- module_name_to_file_name(ModuleName, ".c", no,
- CFileName),
- module_name_to_file_name(ModuleName, ".h", no,
- HeaderFileName),
- io__write_strings(DepStream, [
- "\n\n", HeaderFileName,
- " : ", CFileName
- ])
+ write_dependencies_list(AllDeps, ".h", DepStream)
;
[]
),
+ %
+ % We need to tell make how to make the header
+ % files. The header files are actually built by
+ % the same command that creates the .c or .s file,
+ % so we just make them depend on the .c or .s files.
+ % This is needed for the --high-level-code rule above,
+ % and for the rules introduced for
+ % `:- pragma foreign_import_module' declarations.
+ % In some grades the header file won't actually be built
+ % (e.g. LLDS grades for modules not containing
+ % `:- pragma export' declarations), but this
+ % rule won't do any harm.
+ %
+ module_name_to_file_name(ModuleName, ".c", no, CFileName),
+ module_name_to_file_name(ModuleName, ".s", no, AsmFileName),
+ module_name_to_file_name(ModuleName, ".h", no, HeaderFileName),
+ io__write_strings(DepStream, [
+ "\n\n",
+ "ifeq ($(TARGET_ASM),yes)\n",
+ HeaderFileName, " : ", AsmFileName, "\n",
+ "else\n",
+ HeaderFileName, " : ", CFileName, "\n",
+ "endif"
+ ]),
+
module_name_to_file_name(ModuleName, ".date", no,
DateFileName),
module_name_to_file_name(ModuleName, ".date0", no,
@@ -2072,12 +2087,36 @@
[]
),
- { ContainsForeignCode = contains_foreign_code(LangSet)
+ { ContainsForeignCode = contains_foreign_code(LangSet),
+ ForeignImports = ForeignImports0
; ContainsForeignCode = unknown,
- get_item_list_foreign_code(Globals, Items, LangSet)
+ get_item_list_foreign_code(Globals, Items,
+ LangSet, ForeignImports)
; ContainsForeignCode = no_foreign_code,
- set__init(LangSet)
+ set__init(LangSet),
+ ForeignImports = ForeignImports0
},
+
+ %
+ % Handle dependencies introduced by
+ % `:- pragma foreign_import_module' declarations.
+ %
+ { ForeignImportedModules =
+ list__map(
+ (func(foreign_import_module(_, ForeignImportModule, _))
+ = ForeignImportModule),
+ ForeignImports) },
+ ( { ForeignImports = [] } ->
+ []
+ ;
+ io__write_string(DepStream, "\n\n"),
+ io__write_string(DepStream, ObjFileName),
+ io__write_string(DepStream, " : "),
+ write_dependencies_list(ForeignImportedModules, ".h",
+ DepStream),
+ io__write_string(DepStream, "\n\n")
+ ),
+
(
{ Target = il },
{ not set__empty(LangSet) }
@@ -2787,11 +2826,17 @@
( { Done = no } ->
{ map__set(DepsMap1, Module, deps(yes, ModuleImports),
DepsMap2) },
+ { ForeignImportedModules =
+ list__map(
+ (func(foreign_import_module(_, ImportedModule, _))
+ = ImportedModule),
+ ModuleImports ^ foreign_import_module_info) },
{ list__condense(
[ModuleImports ^ parent_deps,
ModuleImports ^ int_deps,
ModuleImports ^ impl_deps,
ModuleImports ^ public_children, % a.k.a. incl_deps
+ ForeignImportedModules,
Modules],
Modules1) }
;
@@ -3936,15 +3981,15 @@
ExtraLinkObjs).
:- pred get_item_list_foreign_code(globals::in, item_list::in,
- set(foreign_language)::out) is det.
+ set(foreign_language)::out, foreign_import_module_info::out) is det.
-get_item_list_foreign_code(Globals, Items, LangSet) :-
+get_item_list_foreign_code(Globals, Items, LangSet, ForeignImports) :-
globals__get_backend_foreign_languages(Globals, BackendLangs),
globals__get_target(Globals, Target),
- list__foldl2((pred(Item::in, Set0::in, Set::out, Seen0::in, Seen::out)
- is det :-
+ list__foldl3((pred(Item::in, Set0::in, Set::out, Seen0::in, Seen::out,
+ Imports0::in, Imports::out) is det :-
(
- Item = pragma(Pragma) - _Context
+ Item = pragma(Pragma) - Context
->
% The code here should match the way that mlds_to_gcc.m
% decides whether or not to call mlds_to_c.m. XXX Note
@@ -3959,7 +4004,8 @@
list__member(Lang, BackendLangs)
->
set__insert(Set0, Lang, Set),
- Seen = Seen0
+ Seen = Seen0,
+ Imports = Imports0
;
Pragma = foreign_proc(Attrs, Name, _, _, _, _)
->
@@ -3990,7 +4036,8 @@
Seen = Seen0
)
),
- Set = Set0
+ Set = Set0,
+ Imports = Imports0
;
% XXX `pragma export' should not be treated as
% foreign, but currently mlds_to_gcc.m doesn't
@@ -4005,15 +4052,30 @@
% XXX we assume lang = c for exports
Lang = c,
set__insert(Set0, Lang, Set),
- Seen = Seen0
+ Seen = Seen0,
+ Imports = Imports0
+ ;
+ % XXX handle lang \= c for
+ % `:- pragma foreign_import_module'.
+ Pragma = foreign_import_module(Lang, Import),
+ Lang = c,
+ list__member(c, BackendLangs)
+ ->
+ Set = Set0,
+ Seen = Seen0,
+ Imports = [foreign_import_module(Lang,
+ Import, Context) | Imports0]
;
Set = Set0,
- Seen = Seen0
+ Seen = Seen0,
+ Imports = Imports0
)
;
Set = Set0,
- Seen = Seen0
- )), Items, set__init, LangSet0, map__init, LangMap),
+ Seen = Seen0,
+ Imports = Imports0
+ )), Items, set__init, LangSet0, map__init, LangMap,
+ [], ForeignImports),
Values = map__values(LangMap),
LangSet = set__insert_list(LangSet0, Values).
@@ -4312,27 +4374,20 @@
get_fact_table_dependencies(Items, FactTableDeps),
% Figure out whether the items contain foreign code.
- % As an optimization, we do this only if target = asm or target = il
- % since those are the only times we'll need that field.
- globals__get_target(Globals, Target),
+ get_item_list_foreign_code(Globals, Items, LangSet, ForeignImports),
ContainsForeignCode =
- (if (Target = asm ; Target = il) then
- (if
- get_item_list_foreign_code(Globals,
- Items, LangSet),
- not set__empty(LangSet)
- then
- contains_foreign_code(LangSet)
- else
- no_foreign_code
- )
+ (if
+ not set__empty(LangSet)
+ then
+ contains_foreign_code(LangSet)
else
- unknown
+ no_foreign_code
),
ModuleImports = module_imports(FileName, ModuleName, ParentDeps,
InterfaceDeps, ImplementationDeps, IndirectDeps, IncludeDeps,
- FactTableDeps, ContainsForeignCode, [], Error, no).
+ FactTableDeps, ContainsForeignCode, ForeignImports,
+ [], Error, no).
%-----------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.70
diff -u -u -r1.70 prog_data.m
--- compiler/prog_data.m 24 Oct 2001 13:34:35 -0000 1.70
+++ compiler/prog_data.m 24 Oct 2001 17:37:12 -0000
@@ -156,27 +156,17 @@
% whether or not the code is thread-safe
% PredName, Predicate or Function, Vars/Mode,
% VarNames, Foreign Code Implementation Info
-
- ; type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
- maybe(list(mode)), type_subst, tvarset, set(type_id))
- % PredName, SpecializedPredName, Arity,
- % PredOrFunc, Modes if a specific procedure was
- % specified, type substitution (using the variable
- % names from the pred declaration), TVarSet,
- % Equivalence types used
; foreign_type(backend, (type), sym_name, sym_name)
% Backend, MercuryType, MercuryTypeName,
% ForeignType, ForeignTypeLocation
- ; inline(sym_name, arity)
- % Predname, Arity
-
- ; no_inline(sym_name, arity)
- % Predname, Arity
-
- ; obsolete(sym_name, arity)
- % Predname, Arity
+ ; foreign_import_module(foreign_language, module_name)
+ % Equivalent to
+ % `:- pragma foreign_decl(Lang, "#include <module>.h").'
+ % except that the name of the header file is not
+ % hard-coded, and mmake can use the dependency
+ % information.
; export(sym_name, pred_or_func, list(mode),
string)
@@ -190,6 +180,23 @@
% whether or not the foreign code may call Mercury,
% whether or not the foreign code is thread-safe
% foreign function name.
+
+ ; type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
+ maybe(list(mode)), type_subst, tvarset, set(type_id))
+ % PredName, SpecializedPredName, Arity,
+ % PredOrFunc, Modes if a specific procedure was
+ % specified, type substitution (using the variable
+ % names from the pred declaration), TVarSet,
+ % Equivalence types used
+
+ ; inline(sym_name, arity)
+ % Predname, Arity
+
+ ; no_inline(sym_name, arity)
+ % Predname, Arity
+
+ ; obsolete(sym_name, arity)
+ % Predname, Arity
; source_file(string)
% Source file name.
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.35
diff -u -u -r1.35 prog_io_pragma.m
--- compiler/prog_io_pragma.m 24 Oct 2001 13:34:36 -0000 1.35
+++ compiler/prog_io_pragma.m 24 Oct 2001 16:45:21 -0000
@@ -171,6 +171,41 @@
ErrorTerm)
).
+parse_pragma_type(_ModuleName, "c_import_module", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ (
+ PragmaTerms = [ImportTerm],
+ sym_name_and_args(ImportTerm, Import, [])
+ ->
+ Result = ok(pragma(foreign_import_module(c, Import)))
+ ;
+ Result = error("wrong number of arguments or invalid module name in `:- pragma c_import_module' declaration",
+ ErrorTerm)
+ ).
+
+parse_pragma_type(_ModuleName, "foreign_import_module", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ (
+ PragmaTerms = [LangTerm, ImportTerm],
+ sym_name_and_args(ImportTerm, Import, [])
+ ->
+ ( parse_foreign_language(LangTerm, Language) ->
+ ( Language = c ->
+ Result = ok(pragma(
+ foreign_import_module(Language, Import)))
+ ;
+ Result = error("`:- pragma foreign_import_module' not yet supported for languages other than C", LangTerm)
+ )
+ ;
+ Result = error("invalid foreign language in `:- pragma foreign_import_module' declaration",
+ LangTerm)
+ )
+ ;
+ Result = error("wrong number of arguments or invalid module name in `:- pragma foreign_import_module' declaration",
+ ErrorTerm)
+
+ ).
+
:- pred parse_foreign_language(term, foreign_language).
:- mode parse_foreign_language(in, out) is semidet.
Index: compiler/recompilation_version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation_version.m,v
retrieving revision 1.5
diff -u -u -r1.5 recompilation_version.m
--- compiler/recompilation_version.m 24 Oct 2001 13:34:37 -0000 1.5
+++ compiler/recompilation_version.m 24 Oct 2001 14:18:55 -0000
@@ -448,6 +448,7 @@
maybe(maybe_pred_or_func_id)::out) is det.
is_pred_pragma(foreign_decl(_, _), no).
+is_pred_pragma(foreign_import_module(_, _), no).
is_pred_pragma(foreign_code(_, _), no).
is_pred_pragma(foreign_proc(_, Name, PredOrFunc, Args, _, _),
yes(yes(PredOrFunc) - Name / Arity)) :-
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.220
diff -u -u -r1.220 reference_manual.texi
--- doc/reference_manual.texi 24 Oct 2001 13:34:41 -0000 1.220
+++ doc/reference_manual.texi 25 Oct 2001 06:02:32 -0000
@@ -4923,11 +4923,38 @@
(after having compiled it with a compiler for the specified programming
language, if appropriate).
-Entities declared in @samp{pragma foreign_decl} declarations should be
+Entities declared in @samp{pragma foreign_decl} declarations are
visible in @samp{pragma foreign_code} and @samp{pragma foreign_proc}
declarations that specify the same foreign language and occur in in the
same Mercury module.
+To make the declarations for Mercury predicates or functions
+exported to a foreign language using a @samp{pragma export}
+declaration visible to foreign code in a @samp{pragma foreign_code}
+or @samp{pragma foreign_proc} declaration, use a declaration of the form
+
+ at example
+:- pragma foreign_import_module("@var{Lang}", @var{ImportedModule}).
+ at end example
+
+where @var{ImportedModule} is the name of the module containing
+the @samp{pragma export} declarations.
+
+If @var{Lang} is @code{"C"} this is equivalent to
+ at example
+:- pragma foreign_decl("C", "#include ""@var{ImportedModule.h}""").
+ at end example
+
+where @file{@var{ImportedModule}.h} is the automatically generated
+header file containing the C declarations for the predicates
+and functions exported to C.
+
+ at samp{pragma foreign_import_module} should be used instead of the
+explicit @code{#include} because @samp{pragma foreign_import_module}
+tells the implementation that @file{@var{ImportedModule}.h} must be built
+before the object file for the module containing the
+ at samp{pragma foreign_import_module} declaration.
+
@node Adding foreign definitions
@section Adding foreign definitions
@@ -4939,13 +4966,13 @@
@end example
This declaration will have effects equivalent to including the specified
- at var{DeclCode} in an automatically-generated source file of the specified
+ at var{Code} in an automatically-generated source file of the specified
programming language, in a place appropriate for definitions,
and linking that source file with the Mercury program
(after having compiled it with a compiler for the specified programming
language, if appropriate).
-Entities declared in @samp{pragma foreign_code} declarations should be
+Entities declared in @samp{pragma foreign_code} declarations are
visible in @samp{pragma foreign_proc} declarations that specify the same
foreign language and occur in in the same Mercury module.
@@ -5004,8 +5031,7 @@
The input and output variables will have C types corresponding
to their Mercury types, as determined by the rules specified in
-``Passing data to and from C'' in the ``C Interface''
-chapter of the Mercury Language Reference Manual.
+ at ref{Passing data to and from C}.
The C code fragment may declare local variables, but it should not
declare any labels or static variables unless there is also a Mercury
@@ -5089,6 +5115,17 @@
but you should not rely on this, as the set of headers which Mercury
automatically includes is subject to change.
+If a Mercury predicate or function exported using
+a @samp{pragma export} declaration is to be used within a
+ at samp{:- pragma foreign_code} or @samp{:- pragma foreign_proc}
+declaration the header file for the module containing the
+ at samp{pragma export} declaration should be included using a
+ at samp{pragma foreign_import_module} declaration, for example
+
+ at example
+:- pragma foreign_import_module("C", exporting_module).
+ at end example
+
@node Using pragma foreign_code for C
@subsubsection Using pragma foreign_code for C
@@ -5820,6 +5857,22 @@
of the other arguments passed. These @samp{type_info} arguments can
be obtained using the Mercury @samp{type_of} function in the Mercury
standard library module @samp{std_util}.
+
+To use the C declarations produced for @samp{pragma export} declarations
+in C code within a Mercury module, use a @samp{pragma c_import_module}
+declaration, for example
+
+ at example
+:- pragma c_import_module(imported_module).
+ at end example
+
+This is equivalent to
+ at example
+:- pragma c_header_code("#include ""imported_module.h""").
+ at end example
+but it tells the implementation that the object file for the
+module containing the @samp{pragma c_import_module} declaration
+should not be built before @file{imported_module.h} is built.
@node Linking with C object files
@section Linking with C object files
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.131
diff -u -u -r1.131 Mmakefile
--- tests/hard_coded/Mmakefile 12 Oct 2001 05:23:49 -0000 1.131
+++ tests/hard_coded/Mmakefile 24 Oct 2001 17:01:18 -0000
@@ -53,6 +53,7 @@
float_map \
float_reg \
float_rounding_bug \
+ foreign_import_module \
frameopt_pragma_redirect \
free_free_mode \
func_and_pred \
Index: tests/hard_coded/foreign_import_module.exp
===================================================================
RCS file: tests/hard_coded/foreign_import_module.exp
diff -N tests/hard_coded/foreign_import_module.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_import_module.exp 25 Oct 2001 04:30:32 -0000
@@ -0,0 +1 @@
+42
Index: tests/hard_coded/foreign_import_module.m
===================================================================
RCS file: tests/hard_coded/foreign_import_module.m
diff -N tests/hard_coded/foreign_import_module.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_import_module.m 24 Oct 2001 17:00:07 -0000
@@ -0,0 +1,23 @@
+:- module foreign_import_module.
+
+:- interface.
+
+:- import_module int, io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- pred bar(int::in, int::out) is det.
+
+:- implementation.
+
+main -->
+ { bar(41, X) },
+ io__write(X),
+ io__write_char('\n').
+
+:- pragma foreign_import_module("C", foreign_import_module_2).
+
+:- pragma c_code(bar(X::in, Y::out), may_call_mercury,
+"
+ foo(X, &Y);
+").
Index: tests/hard_coded/foreign_import_module_2.m
===================================================================
RCS file: tests/hard_coded/foreign_import_module_2.m
diff -N tests/hard_coded/foreign_import_module_2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_import_module_2.m 24 Oct 2001 16:52:04 -0000
@@ -0,0 +1,13 @@
+:- module foreign_import_module_2.
+
+:- interface.
+
+:- pred foo(int::in, int::out) is det.
+
+:- implementation.
+
+:- import_module int.
+
+:- pragma export(foo(in, out), "foo").
+
+foo(X, X+1).
--------------------------------------------------------------------------
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