[m-rev.] for review: fix foreign type import bug
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Dec 24 12:24:37 AEDT 2003
Estimated hours taken: 15
Branches: main
If a module exports foreign types, the interface files need
to contain a `:- pragma foreign_import_module' declaration
for the module to avoid target code compilation errors in
importing modules.
compiler/modules.m:
Add a foreign_import_module declaration to item
lists files where needed.
compiler/modules.m:
compiler/make.dependencies.m:
Handle extra dependencies.
compiler/intermod.m:
compiler/mercury_compile.m:
Remove code to add foreign_import_module declarations;
this is now handled in modules.m.
tests/hard_coded/export_test2.m:
Test case.
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.155
diff -u -u -r1.155 intermod.m
--- compiler/intermod.m 21 Dec 2003 05:04:34 -0000 1.155
+++ compiler/intermod.m 22 Dec 2003 12:18:29 -0000
@@ -1059,6 +1059,9 @@
have_foreign_type_for_backend(Target,
ForeignTypeBody0, yes)
->
+ % The header code must be written since
+ % it could be used by the foreign type.
+ intermod_info_set_write_header(!Info),
intermod__resolve_foreign_type_body_overloading(
ModuleInfo, TypeCtor, ForeignTypeBody0,
ForeignTypeBody, !Info),
@@ -1078,6 +1081,9 @@
TypeBody0 = foreign_type(ForeignTypeBody0,
IsSolverType)
->
+ % The header code must be written since
+ % it could be used by the foreign type.
+ intermod_info_set_write_header(!Info),
intermod__resolve_foreign_type_body_overloading(
ModuleInfo, TypeCtor,
ForeignTypeBody0, ForeignTypeBody, !Info),
@@ -1260,37 +1266,9 @@
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, RevForeignDecls) },
- { module_info_get_pragma_exported_procs(ModuleInfo,
- PragmaExportedProcs) },
{ module_info_get_foreign_import_module(ModuleInfo,
RevForeignImports) },
- { ForeignImports0 = list__reverse(RevForeignImports) },
-
- %
- % If this module contains `:- pragma export' or
- % `:- pragma foreign_decl' declarations,
- % they may be referred to by the C code we are writing
- % to the `.opt' file, so write the implicit
- % `:- pragma foreign_import_module("C", ModuleName).'
- % to the `.opt' file.
- %
- % XXX Currently we only handle procedures
- % exported to C.
- {
- % Check that the import could contain anything.
- ( PragmaExportedProcs \= []
- ; RevForeignDecls \= []
- )
- ->
- module_info_name(ModuleInfo, ModuleName),
- ForeignImportThisModule = foreign_import_module(c,
- ModuleName, term__context_init),
- ForeignImports =
- [ForeignImportThisModule | ForeignImports0]
- ;
- ForeignImports = ForeignImports0
- },
+ { ForeignImports = list__reverse(RevForeignImports) },
list__foldl(
(pred(ForeignImport::in, di, uo) is det -->
Index: compiler/make.dependencies.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.dependencies.m,v
retrieving revision 1.14
diff -u -u -r1.14 make.dependencies.m
--- compiler/make.dependencies.m 1 Dec 2003 15:55:39 -0000 1.14
+++ compiler/make.dependencies.m 8 Dec 2003 06:04:33 -0000
@@ -548,6 +548,25 @@
find_module_foreign_imports(Languages, ModuleName,
Success, ForeignModules, Info0, Info) -->
+ find_transitive_implementation_imports(ModuleName, Success0,
+ ImportedModules, Info0, Info1),
+ ( { Success0 = yes } ->
+ foldl3_maybe_stop_at_error(Info1 ^ keep_going,
+ union_deps(find_module_foreign_imports_2(Languages)),
+ [ModuleName | to_sorted_list(ImportedModules)],
+ Success, set__init, ForeignModules, Info1, Info)
+ ;
+ { Success = no },
+ { ForeignModules = set__init },
+ { Info = Info1 }
+ ).
+
+:- pred find_module_foreign_imports_2(set(foreign_language)::in,
+ module_name::in, bool::out, set(module_name)::out,
+ make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+find_module_foreign_imports_2(Languages, ModuleName,
+ Success, ForeignModules, Info0, Info) -->
get_module_dependencies(ModuleName, MaybeImports, Info0, Info),
{
MaybeImports = yes(Imports),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.298
diff -u -u -r1.298 mercury_compile.m
--- compiler/mercury_compile.m 21 Dec 2003 05:04:35 -0000 1.298
+++ compiler/mercury_compile.m 22 Dec 2003 07:05:50 -0000
@@ -3596,26 +3596,11 @@
foreign__filter_decls(UseForeignLanguage, ForeignDecls,
WantedForeignDecls, _OtherDecls),
foreign__filter_imports(UseForeignLanguage, ForeignImports,
- WantedForeignImports0, _OtherImports),
+ WantedForeignImports, _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.
- 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.
- Import = foreign_import_module(c, ModuleName,
- term__context_init),
- WantedForeignImports = WantedForeignImports0 ++ [Import]
- ;
- WantedForeignImports = WantedForeignImports0
- ),
Foreign_InterfaceInfo = foreign_interface_info(ModuleName,
WantedForeignDecls, WantedForeignImports,
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.284
diff -u -u -r1.284 modules.m
--- compiler/modules.m 22 Dec 2003 11:21:47 -0000 1.284
+++ compiler/modules.m 22 Dec 2003 12:58:06 -0000
@@ -1377,7 +1377,7 @@
% possible. Then write out the .int and .int2 files.
make_interface(SourceFileName, SourceFileModuleName, ModuleName,
MaybeTimestamp, Items0) -->
- { get_interface(yes, Items0, InterfaceItems0) },
+ { get_interface(ModuleName, yes, Items0, InterfaceItems0) },
%
% Get the .int3 files for imported modules
%
@@ -1437,7 +1437,7 @@
% This qualifies everything as much as it can given the
% information in the current module and writes out the .int3 file.
make_short_interface(SourceFileName, ModuleName, Items0) -->
- { get_interface(no, Items0, InterfaceItems0) },
+ { get_interface(ModuleName, no, Items0, InterfaceItems0) },
% assertions are also stripped since they should
% only be written to .opt files,
{ strip_assertions(InterfaceItems0, InterfaceItems1) },
@@ -1555,12 +1555,13 @@
), !.ImplTypesMap, ImplItems0, ImplItems1),
IntItems = [make_pseudo_decl(interface) | IntItems0],
+
maybe_strip_import_decls(ImplItems1, ImplItems2),
( ImplItems2 = [] ->
Items = IntItems
;
Items = IntItems ++
- [make_pseudo_decl(implementation) | ImplItems2]
+ [make_pseudo_decl(implementation) | ImplItems2]
)
).
@@ -1696,7 +1697,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_import_module(_, _), yes).
pragma_allowed_in_interface(foreign_code(_, _), no).
pragma_allowed_in_interface(foreign_proc(_, _, _, _, _, _), no).
pragma_allowed_in_interface(inline(_, _), no).
@@ -1737,7 +1738,7 @@
( { ExportWarning = no } ->
[]
;
- { get_interface(no, Items, InterfaceItems) },
+ { get_interface(ModuleName, no, Items, InterfaceItems) },
check_int_for_no_exports(InterfaceItems, ModuleName)
).
@@ -2056,7 +2057,7 @@
ImpUsedModules0, ImpUsedModules),
{ get_fact_table_dependencies(Items0, FactDeps) },
- { get_interface_and_implementation(no, Items0,
+ { get_interface_and_implementation(ModuleName, no, Items0,
InterfaceItems, ImplItems) },
{ get_children(InterfaceItems, PublicChildren) },
{ MaybeTimestamp = yes(Timestamp) ->
@@ -2297,12 +2298,13 @@
:- mode init_module_imports(in, in, in, in, in, in, in, in, out) is det.
init_module_imports(SourceFileName, SourceFileModuleName, ModuleName,
- Items, PublicChildren, NestedChildren, FactDeps,
+ Items0, PublicChildren, NestedChildren, FactDeps,
MaybeTimestamps, Module) :-
+ maybe_add_foreign_import_module(ModuleName, Items0, Items),
Module = module_imports(SourceFileName, SourceFileModuleName,
ModuleName, [], [], [], [], [], PublicChildren,
- NestedChildren, FactDeps, unknown, [], no_foreign_export,
- Items, no_module_errors,
+ NestedChildren, FactDeps, unknown, [],
+ no_foreign_export, Items, no_module_errors,
MaybeTimestamps, no_main, dir__this_directory).
module_imports_get_source_file_name(Module, Module ^ source_file_name).
@@ -2987,7 +2989,18 @@
ForeignImports = ForeignImports0
; ContainsForeignCode = unknown,
get_item_list_foreign_code(Globals, Items,
- LangSet, ForeignImports, _)
+ LangSet, ForeignImports1, _),
+ % If we're generating the `.dep' file
+ % ForeignImports0 will contain a conservative
+ % approximation to the set of foreign imports
+ % needed which will include imports required
+ % by imported modules.
+ ForeignImports =
+ ( ForeignImports0 = [] ->
+ ForeignImports1
+ ;
+ ForeignImports0
+ )
; ContainsForeignCode = no_foreign_code,
set__init(LangSet),
ForeignImports = ForeignImports0
@@ -3750,14 +3763,15 @@
generate_dependencies_write_d_files([Dep | Deps],
IntDepsRel, ImplDepsRel, IndirectDepsRel, IndirectOptDepsRel,
TransOptOrder, DepsMap) -->
- { Dep = deps(_, Module0) },
+ some [!Module] (
+ { Dep = deps(_, !:Module) },
%
% Look up the interface/implementation/indirect dependencies
% for this module from the respective dependency relations,
% and save them in the module_imports structure.
%
- { module_imports_get_module_name(Module0, ModuleName) },
+ { module_imports_get_module_name(!.Module, ModuleName) },
{ get_dependencies_from_relation(IndirectOptDepsRel, ModuleName,
IndirectOptDeps) },
globals__io_lookup_bool_option(intermodule_optimization, Intermod),
@@ -3776,10 +3790,24 @@
get_dependencies_from_relation(IndirectDepsRel,
ModuleName, IndirectDeps)
},
+
+ globals__io_get_target(Target),
+ { Target = c, Lang = c
+ ; Target = asm, Lang = c
+ ; Target = java, Lang = java
+ ; Target = il, Lang = il
+ },
+ % Assume we need the `.mh' files for all imported
+ % modules (we will if they define foreign types).
+ { ForeignImports = list__map(
+ (func(ThisDep) = foreign_import_module(Lang,
+ ThisDep, term__context_init)),
+ IndirectOptDeps) },
+ { !:Module = !.Module ^ foreign_import_module_info := ForeignImports },
- { module_imports_set_int_deps(Module0, IntDeps, Module1) },
- { module_imports_set_impl_deps(Module1, ImplDeps, Module2) },
- { module_imports_set_indirect_deps(Module2, IndirectDeps, Module) },
+ { module_imports_set_int_deps(!.Module, IntDeps, !:Module) },
+ { module_imports_set_impl_deps(!.Module, ImplDeps, !:Module) },
+ { module_imports_set_indirect_deps(!.Module, IndirectDeps, !:Module) },
%
% Compute the trans-opt dependencies for this module.
@@ -3802,16 +3830,17 @@
% Note that even if a fatal error occured for one of the files that
% the current Module depends on, a .d file is still produced, even
% though it probably contains incorrect information.
- { module_imports_get_error(Module, Error) },
+ { module_imports_get_error(!.Module, Error) },
( { Error \= fatal_module_errors } ->
- write_dependency_file(Module,
+ write_dependency_file(!.Module,
set__list_to_set(IndirectOptDeps), yes(TransOptDeps))
;
[]
),
generate_dependencies_write_d_files(Deps,
IntDepsRel, ImplDepsRel, IndirectDepsRel, IndirectOptDepsRel,
- TransOptOrder, DepsMap).
+ TransOptOrder, DepsMap)
+ ).
:- pred get_dependencies_from_relation(deps_rel, module_name,
list(module_name)).
@@ -3911,7 +3940,7 @@
relation__add_element(IntRel0, ModuleName, IntModuleKey,
IntRel1),
add_int_deps(IntModuleKey, ModuleImports, IntRel1, IntRel2),
- list__foldl(add_parent_impl_deps(DepsMap, IntModuleKey),
+ add_parent_impl_deps_list(DepsMap, IntModuleKey,
ParentDeps, IntRel2, IntRel3),
%
@@ -3927,7 +3956,7 @@
relation__add_element(ImplRel0, ModuleName, ImplModuleKey,
ImplRel1),
add_impl_deps(ImplModuleKey, ModuleImports, ImplRel1, ImplRel2),
- list__foldl(add_parent_impl_deps(DepsMap, ImplModuleKey),
+ add_parent_impl_deps_list(DepsMap, ImplModuleKey,
ParentDeps, ImplRel2, ImplRel3)
;
IntRel3 = IntRel0,
@@ -3940,6 +3969,7 @@
%
:- pred add_int_deps(relation_key, module_imports, deps_rel, deps_rel).
:- mode add_int_deps(in, in, in, out) is det.
+:- pragma no_inline(add_int_deps/4).
add_int_deps(ModuleKey, ModuleImports, Rel0, Rel) :-
AddDep = add_dep(ModuleKey),
@@ -3951,6 +3981,7 @@
%
:- pred add_impl_deps(relation_key, module_imports, deps_rel, deps_rel).
:- mode add_impl_deps(in, in, in, out) is det.
+:- pragma no_inline(add_impl_deps/4).
add_impl_deps(ModuleKey, ModuleImports, Rel0, Rel) :-
% the implementation dependencies are a superset of the
@@ -3971,6 +4002,15 @@
map__lookup(DepsMap, Parent, deps(_, ParentModuleImports)),
add_impl_deps(ModuleKey, ParentModuleImports, Rel0, Rel).
+:- pred add_parent_impl_deps_list(deps_map, relation_key, list(module_name),
+ deps_rel, deps_rel).
+:- mode add_parent_impl_deps_list(in, in, in, in, out) is det.
+
+add_parent_impl_deps_list(_, _, [], !Rel).
+add_parent_impl_deps_list(DepsMap, ModuleKey, [Parent | Parents], !Rel) :-
+ add_parent_impl_deps(DepsMap, ModuleKey, Parent, !Rel),
+ add_parent_impl_deps_list(DepsMap, ModuleKey, Parents, !Rel).
+
% add a single dependency to a relation
%
:- pred add_dep(relation_key, T, relation(T), relation(T)).
@@ -5590,7 +5630,7 @@
ImplUseDeps0, ImplUseDeps),
list__append(ImplImportDeps, ImplUseDeps, ImplementationDeps),
- get_interface(no, Items, InterfaceItems),
+ get_interface(ModuleName, no, Items, InterfaceItems),
get_dependencies(InterfaceItems, InterfaceImportDeps0,
InterfaceUseDeps0),
add_implicit_imports(InterfaceItems, Globals,
@@ -5614,7 +5654,7 @@
get_fact_table_dependencies(Items, FactTableDeps),
% Figure out whether the items contain foreign code.
- get_item_list_foreign_code(Globals, Items, LangSet, ForeignImports,
+ get_item_list_foreign_code(Globals, Items, LangSet, ForeignImports0,
ContainsPragmaExport),
ContainsForeignCode =
(if
@@ -5625,6 +5665,16 @@
no_foreign_code
),
+ % If this module contains `:- pragma export' or
+ % `:- pragma foreign_type' declarations, importing modules
+ % may need to import its `.mh' file.
+ get_foreign_self_imports(Items, SelfImportLangs),
+ ForeignSelfImports = list__map(
+ (func(Lang) = foreign_import_module(Lang, ModuleName,
+ term__context_init)),
+ SelfImportLangs),
+ ForeignImports = ForeignSelfImports ++ ForeignImports0,
+
%
% Work out whether the items contain main/2.
%
@@ -6680,26 +6730,50 @@
% and `:- implementation'.
% The bodies of instance definitions are removed because
% the instance methods have not yet been module qualified.
-:- pred get_interface(bool, item_list, item_list).
-:- mode get_interface(in, in, out) is det.
+:- pred get_interface(module_name, bool, item_list, item_list).
+:- mode get_interface(in, in, in, out) is det.
-get_interface(IncludeImplTypes, Items0, Items) :-
+get_interface(ModuleName, IncludeImplTypes, Items0, Items) :-
AddToImpl = (func(_, ImplItems) = ImplItems),
- get_interface_and_implementation_2(IncludeImplTypes, Items0, no,
- [], RevItems, AddToImpl, unit, _),
- list__reverse(RevItems, Items).
+ get_interface_and_implementation_2(IncludeImplTypes,
+ Items0, no, [], RevItems, AddToImpl, unit, _),
+ list__reverse(RevItems, Items1),
+ maybe_add_foreign_import_module(ModuleName, Items1, Items).
-:- pred get_interface_and_implementation(bool,
+:- pred get_interface_and_implementation(module_name, bool,
item_list, item_list, item_list).
-:- mode get_interface_and_implementation(in, in, out, out) is det.
+:- mode get_interface_and_implementation(in, in, in, out, out) is det.
-get_interface_and_implementation(IncludeImplTypes, Items0, InterfaceItems,
- ImplementationItems) :-
+get_interface_and_implementation(ModuleName, IncludeImplTypes,
+ Items0, InterfaceItems, ImplementationItems) :-
AddToImpl = (func(ImplItem, ImplItems) = [ImplItem | ImplItems]),
get_interface_and_implementation_2(IncludeImplTypes, Items0, no,
[], RevIntItems, AddToImpl, [], RevImplItems),
- list__reverse(RevIntItems, InterfaceItems),
- list__reverse(RevImplItems, ImplementationItems).
+ list__reverse(RevIntItems, InterfaceItems0),
+ list__reverse(RevImplItems, ImplementationItems),
+ maybe_add_foreign_import_module(ModuleName,
+ InterfaceItems0, InterfaceItems).
+
+:- pred maybe_add_foreign_import_module(module_name, item_list, item_list).
+:- mode maybe_add_foreign_import_module(in, in, out) is det.
+
+maybe_add_foreign_import_module(ModuleName, Items0, Items) :-
+ get_foreign_self_imports(Items0, Langs),
+ Imports = list__map(
+ (func(Lang) = pragma(foreign_import_module(Lang,
+ ModuleName)) - term__context_init),
+ Langs),
+ Items = Imports ++ Items0.
+
+:- pred get_foreign_self_imports(item_list, list(foreign_language)).
+:- mode get_foreign_self_imports(in, out) is det.
+
+get_foreign_self_imports(Items, Langs) :-
+ solutions(
+ (pred(Lang::out) is nondet :-
+ list__member(Item - _, Items),
+ item_needs_foreign_imports(Item, Lang)
+ ), Langs).
:- pred get_interface_and_implementation_2(bool, item_list, bool,
item_list, item_list, func(item_and_context, T) = T, T, T).
@@ -6801,29 +6875,6 @@
list__reverse(RevItems, Items1),
maybe_strip_import_decls(Items1, Items).
-:- pred maybe_strip_import_decls(item_list, item_list).
-:- mode maybe_strip_import_decls(in, out) is det.
-
-maybe_strip_import_decls(Items0, Items) :-
- (
- some [Item] (
- list__member(Item - _, Items0),
- item_needs_imports(Item) = yes
- )
- ->
- Items = list__filter(
- (pred((ThisItem - _)::in) is semidet :-
- \+ (
- ThisItem = module_defn(_, Defn),
- ( Defn = imported(_)
- ; Defn = used(_)
- )
- )
- ), Items0)
- ;
- Items = Items0
- ).
-
:- pred get_short_interface_2(item_list, short_interface_kind,
item_list, item_list).
:- mode get_short_interface_2(in, in, in, out) is det.
@@ -6850,6 +6901,7 @@
include_in_short_interface(mode_defn(_, _, _, _, _)).
include_in_short_interface(module_defn(_, _)).
include_in_short_interface(instance(_, _, _, _, _, _)).
+include_in_short_interface(pragma(foreign_import_module(_, _))).
% Could this item use items from imported modules.
:- func item_needs_imports(item) = bool.
@@ -6881,6 +6933,20 @@
item_needs_imports(promise(_, _, _, _)) = yes.
item_needs_imports(nothing(_)) = no.
+:- pred item_needs_foreign_imports(item, foreign_language).
+:- mode item_needs_foreign_imports(in, out) is semidet.
+
+item_needs_foreign_imports(Item @ type_defn(_, _, _, _, _), Lang) :-
+ Item ^ td_ctor_defn = foreign_type(ForeignType, _),
+ ( ForeignType = il(_), Lang = il
+ ; ForeignType = c(_), Lang = c
+ ; ForeignType = java(_), Lang = java
+ ).
+item_needs_foreign_imports(pragma(foreign_decl(Lang, _)), Lang).
+item_needs_foreign_imports(pragma(foreign_code(Lang, _)), Lang).
+item_needs_foreign_imports(pragma(foreign_proc(Attrs, _, _, _, _, _)),
+ foreign_language(Attrs)).
+
:- pred include_in_int_file_implementation(item).
:- mode include_in_int_file_implementation(in) is semidet.
@@ -6893,6 +6959,7 @@
% Since these constructors are abstractly exported,
% we won't need the local instance declarations.
include_in_int_file_implementation(typeclass(_, _, _, _, _)).
+include_in_int_file_implementation(pragma(foreign_import_module(_, _))).
:- pred make_abstract_defn(item, short_interface_kind, item).
:- mode make_abstract_defn(in, in, out) is semidet.
@@ -6967,6 +7034,42 @@
Body = abstract,
Item = instance(Constraints, Class, ClassTypes, Body, TVarSet,
ModName).
+
+:- pred maybe_strip_import_decls(item_list, item_list).
+:- mode maybe_strip_import_decls(in, out) is det.
+
+maybe_strip_import_decls(!Items) :-
+ (
+ \+ (some [Item] (
+ list__member(Item - _, !.Items),
+ item_needs_imports(Item) = yes
+ ))
+ ->
+ list__filter(
+ (pred((ThisItem - _)::in) is semidet :-
+ \+ (
+ ThisItem = module_defn(_, Defn),
+ ( Defn = imported(_)
+ ; Defn = used(_)
+ )
+ )
+ ), !Items)
+ ;
+ true
+ ),
+ (
+ \+ (some [Item] (
+ list__member(Item - _, !.Items),
+ item_needs_foreign_imports(Item, _)
+ ))
+ ->
+ list__filter(
+ (pred((ThisItem - _)::in) is semidet :-
+ ThisItem \= pragma(foreign_import_module(_, _))
+ ), !Items)
+ ;
+ true
+ ).
%-----------------------------------------------------------------------------%
Index: tests/hard_coded/export_test2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/export_test2.m,v
retrieving revision 1.1
diff -u -u -r1.1 export_test2.m
--- tests/hard_coded/export_test2.m 1 Dec 2003 15:56:08 -0000 1.1
+++ tests/hard_coded/export_test2.m 24 Dec 2003 01:00:39 -0000
@@ -2,37 +2,54 @@
:- interface.
-:- import_module int, io.
+:- import_module int, io, export_test2.sub.
:- pred main(io__state::di, io__state::uo) is det.
:- pred foo(io__output_stream::in, io__output_stream::out,
- int::in, int::out) is det.
+ foo::in, foo::out) is det.
:- pred bar(io__output_stream::in, io__output_stream::out,
- int::in, int::out) is det.
+ foo::in, foo::out) is det.
+ :- module export_test2.sub.
+ :- interface.
+ :- import_module enum.
+ :- type foo.
+ :- instance enum(foo).
+ :- end_module export_test2.sub.
:- implementation.
+:- import_module enum, require.
+
main -->
io__stdout_stream(Stream0),
- { bar(Stream0, Stream, 41, X) },
- io__write(Stream, X),
- io__write_char(Stream, '\n').
-
-foo(S, S, X, X+1).
+ ( { Foo = from_int(41) } ->
+ { bar(Stream0, Stream, Foo, X) },
+ io__write(Stream, to_int(X)),
+ io__write_char(Stream, '\n')
+ ;
+ { error("from_int failed") }
+ ).
+
+foo(S, S, X0, X) :-
+ ( X1 = from_int(to_int(X0) + 1)) ->
+ X = X1
+ ;
+ error("from_int failed")
+ .
-:- pragma foreign_decl("C",
-"#include ""mercury_library_types.h""
+:- pragma foreign_decl("C", "
+#include ""mercury_library_types.h""
/*
-** Make sure the foreign type definition of io__input_stream
-** is available here. If it is not, the automatically generated
-** definition of foo() will be
-** void foo(MR_Word, MR_Word *, MR_Integer, MR_Integer *);
+** Make sure the foreign type definitions of io__input_stream
+** and export_test2.sub.foo are available here. If not, the
+** automatically generated definition of foo() will be
+** void foo(MR_Word, MR_Word *, MR_Word, MR_Word *);
*/
-void foo(MercuryFilePtr, MercuryFilePtr *, MR_Integer, MR_Integer *);
+void foo(MercuryFilePtr, MercuryFilePtr *, int, int *);
").
@@ -48,3 +65,34 @@
[may_call_mercury, promise_pure], "
export_test2.mercury_code.foo(S, ref T, X, ref Y);
").
+
+ :- module export_test2.sub.
+ :- implementation.
+
+ :- type foo ---> foo(int).
+ :- pragma foreign_type("C", foo, "MT_Foo").
+
+ % This needs to be visible in export_test2 for any use
+ % of the foreign type to work.
+ :- pragma foreign_decl("C", "typedef int MT_Foo;").
+
+ :- instance enum(foo) where [
+ to_int(X) = foo_to_int(X),
+ from_int(X) = foo_from_int(X)
+ ].
+
+ :- func foo_to_int(foo) = int.
+ foo_to_int(foo(Int)) = Int.
+ :- pragma foreign_proc("C",
+ foo_to_int(Foo::in) = (Int::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "Int = Foo;").
+
+ :- func foo_from_int(int) = foo.
+ foo_from_int(Int) = foo(Int).
+ :- pragma foreign_proc("C",
+ foo_from_int(Int::in) = (Foo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "Foo = Int;").
+ :- end_module export_test2.sub.
+
--------------------------------------------------------------------------
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