[m-rev.] for review: pragma foreign_import_module on the IL backend

[Peter Ross]

Hi,


===================================================================


Estimated hours taken: 8
Branches: main

Get pragma foreign_import_module working on the IL backend.

compiler/foreign.m:
	Add two utility predicates which are used to get the module
	name a foreign_module_import refers to.

compiler/ml_code_gen.m:
	The wanted foreign imports are the imports for every backend
	language.  This is because, for example, managed C++ can refer
	to something defined in IL.

compiler/mlds_to_managed.m:
	For managed C++ output a #using for every module implied by the
	pragma foreign_import_module.
	
compiler/modules.m:
	Factor the code for outputting the dependencies implied by the
	pragma foreign_import_modules so that they work for both the
	IL and C backend.
	For C# add a reference to every module implied by the pragma
	foreign_import_module.

compiler/modules.m:
compiler/prog_io_pragma.m:
	Remove constraints the pragma foreign_import_modules can only
	work on the C backend.

tests/hard_coded/foreign_import_module.exp:
tests/hard_coded/foreign_import_module.m:
tests/hard_coded/foreign_import_module_2.m:
	Adapt the test case so that we test that C# and MC++ code all
	correctly have the correct assembly references passed to them.

Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.22
diff -u -r1.22 foreign.m
--- compiler/foreign.m	5 Aug 2002 21:46:09 -0000	1.22
+++ compiler/foreign.m	10 Dec 2002 13:54:01 -0000
@@ -89,6 +89,26 @@
 :- func foreign__to_type_string(foreign_language, exported_type) = string.
 :- func foreign__to_type_string(foreign_language, module_info, (type)) = string.
 
+	%
+	% foreign__module_name(ForeignImport)
+	%
+	% returns the module name which represents the ForeignImport.
+	%
+	% For instance for the foreign_import_module representing
+	% 	:- foreign_import_module("MC++", module)
+	% would return the module_name
+	% 	unqualified("module__cpp_code")
+	%
+:- func foreign__module_name(foreign_import_module) = module_name.
+
+	% foreign__module_name(ForeignImport, CurrentModule)
+	%
+	% returns the module name needed to refer to ForeignImport from the
+	% CurrentModule.
+	%
+:- func foreign__module_name(foreign_import_module, module_name) =
+		module_name.
+
 	% Filter the decls for the given foreign language. 
 	% The first return value is the list of matches, the second is
 	% the list of mis-matches.
@@ -201,6 +221,7 @@
 :- import_module check_hlds__mode_util, hlds__error_util.
 :- import_module hlds__hlds_data, parse_tree__prog_out.
 :- import_module backend_libs__code_model, libs__globals.
+:- import_module parse_tree__modules.
 
 	% Currently we don't use the globals to compare foreign language
 	% interfaces, but if we added appropriate options we might want
@@ -685,6 +706,53 @@
 	).
 to_type_string(il, mercury(_Type)) = _ :-
 	sorry(this_file, "to_type_string for il").
+
+%-----------------------------------------------------------------------------%
+
+foreign__module_name(foreign_import_module(Lang, ForeignImportModule, _)) =
+		ModuleName :-
+	( Lang = c,
+		ModuleName = ForeignImportModule
+	; Lang = il,
+		ModuleName = ForeignImportModule
+	; Lang = managed_cplusplus,
+		ModuleName = foreign_language_module_name(ForeignImportModule,
+				Lang)
+	; Lang = csharp,
+		ModuleName = foreign_language_module_name(ForeignImportModule,
+				Lang)
+	).
+
+foreign__module_name(ForeignImportModule, CurrentModule) =
+		ModuleName :-
+	ForeignImportModule = foreign_import_module(Lang, _, _),
+	ModuleName1 = ForeignImportModule ^ foreign__module_name,
+	( Lang = c,
+		ModuleName = ModuleName1
+	; Lang = il,
+		ModuleName = handle_std_library(CurrentModule, ModuleName1)
+	; Lang = managed_cplusplus,
+		ModuleName = handle_std_library(CurrentModule, ModuleName1)
+	; Lang = csharp,
+		ModuleName = handle_std_library(CurrentModule, ModuleName1)
+	).
+
+	%
+	% On the il backend, we need to refer to the module "mercury" when
+	% referencing a std library module when we are not actually building
+	% the std library.
+	%
+:- func handle_std_library(module_name, module_name) = module_name.
+
+handle_std_library(CurrentModule, ModuleName0) = ModuleName :-
+	(
+		mercury_std_library_module_name(ModuleName0),
+		\+ mercury_std_library_module_name(CurrentModule)
+	->
+		ModuleName = unqualified("mercury")
+	;
+		ModuleName = ModuleName0
+	).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.121
diff -u -r1.121 ml_code_gen.m
--- compiler/ml_code_gen.m	14 Jul 2002 04:08:26 -0000	1.121
+++ compiler/ml_code_gen.m	10 Dec 2002 13:54:02 -0000
@@ -817,14 +817,16 @@
 	{ module_info_get_foreign_import_module(ModuleInfo, ForeignImports) },
 	{ module_info_get_foreign_body_code(ModuleInfo, ForeignBodys) },
 	globals__io_get_backend_foreign_languages(BackendForeignLanguages),
-	
+
+	{ WantedForeignImports = list__condense(
+		list__map((func(L) = Imports :-
+			foreign__filter_imports(L, ForeignImports, Imports, _)
+		), BackendForeignLanguages)) },
+
 	{ list__foldl((pred(Lang::in, Map0::in, Map::out) is det :-
 			foreign__filter_decls(Lang,
 				ForeignDecls, WantedForeignDecls, 
 				_OtherForeignDecls),
-			foreign__filter_imports(Lang,
-				ForeignImports, WantedForeignImports, 
-				_OtherForeignImports),
 			foreign__filter_bodys(Lang,
 				ForeignBodys, WantedForeignBodys,
 				_OtherForeignBodys),
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.5
diff -u -r1.5 mlds_to_managed.m
--- compiler/mlds_to_managed.m	28 Nov 2002 13:05:20 -0000	1.5
+++ compiler/mlds_to_managed.m	10 Dec 2002 13:54:03 -0000
@@ -89,7 +89,6 @@
 :- mode generate_code(in(managed_lang), in, di, uo) is det.
 
 generate_code(Lang, MLDS) -->
-
 	{ MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns) },
 	{ ClassName = class_name(mercury_module_name_to_mlds(ModuleName), 
 			wrapper_class_name) },
@@ -102,8 +101,7 @@
 
 		% Get the foreign code for the required language.
 	{ ForeignCode = map__lookup(AllForeignCode, Lang) },
-	generate_foreign_header_code(Lang,
-			mercury_module_name_to_mlds(ModuleName), ForeignCode),
+	generate_foreign_header_code(Lang, ModuleName, ForeignCode),
 
 		% Output the namespace.
 	{ generate_namespace_details(Lang, ClassName,
@@ -239,14 +237,32 @@
 	).
 
 
-	% XXX we don't handle `:- pragma foreign_import_module'.
 :- pred generate_foreign_header_code(foreign_language::in(managed_lang),
-		mlds_module_name::in, mlds__foreign_code::in,
+		module_name::in, mlds__foreign_code::in,
 		io__state::di, io__state::uo) is det.
 
-generate_foreign_header_code(Lang, _ModuleName, 
-		mlds__foreign_code(RevHeaderCode, _RevImports, _RevBodyCode,
+generate_foreign_header_code(Lang, ModuleName, 
+		mlds__foreign_code(RevHeaderCode, RevImports, _RevBodyCode,
 			_ExportDefns)) -->
+
+	% Only MC++ can declare which assemblies it refers to in its
+	% source file.  C# declares which assemblies it refers to via
+	% command line arguments to the C# compiler.
+	( { Lang = managed_cplusplus },
+		{ Imports = list__reverse(RevImports) },
+		list__foldl(
+			(pred(ForeignImport::in, di, uo) is det -->
+				module_name_to_search_file_name(
+					foreign__module_name(ForeignImport,
+								ModuleName),
+						".dll", FileName),
+				io__write_strings(["#using """,
+						FileName, """\n"])
+			), Imports)
+	; { Lang = csharp },
+		[]
+	),
+
 	{ HeaderCode = list__reverse(RevHeaderCode) },
 	io__write_list(HeaderCode, "\n", 
 		(pred(foreign_decl_code(CodeLang, Code, Context)::in,
@@ -282,7 +298,6 @@
 		Namespace = Namespace0
 	).
 
-	% XXX we don't handle `:- pragma foreign_import_module'.
 :- pred generate_foreign_code(foreign_language::in(managed_lang),
 		mlds_module_name::in, mlds__foreign_code::in,
 		io__state::di, io__state::uo) is det.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.255
diff -u -r1.255 modules.m
--- compiler/modules.m	10 Dec 2002 07:38:09 -0000	1.255
+++ compiler/modules.m	10 Dec 2002 13:54:13 -0000
@@ -2574,10 +2574,9 @@
 		    % of it sub-modules dlls, as they are referenced from
 		    % inside the top level dll.
 
+		module_name_to_file_name(ModuleName, ".dll", no, DllFileName),
 		{ SubModules = submodules(ModuleName, AllDeps) },
 		( { Target = il, SubModules \= [] } ->
-			module_name_to_file_name(ModuleName, ".dll", no,
-					DllFileName),
 			io__write_strings(DepStream, [DllFileName, " : "]),
 			write_dll_dependencies_list(SubModules, "", DepStream),
 			io__nl(DepStream)
@@ -2599,19 +2598,31 @@
 		% Handle dependencies introduced by
 		% `:- pragma foreign_import_module' declarations.
 		%
-		{ ForeignImportedModules =
-		    list__map(
-			(func(foreign_import_module(_, ForeignImportModule, _))
-				= ForeignImportModule),
-			ForeignImports) },
-		( { ForeignImports = [] } ->
+		{ list__filter_map(
+			(pred(ForeignImportMod::in, Import::out) is semidet :-
+				Import = foreign__module_name(
+						ForeignImportMod,
+						SourceFileModuleName),
+
+				% We can't include mercury.dll as mmake
+				% can't find it, but we know that it exists.
+				Import \= unqualified("mercury")
+			), ForeignImports, ForeignImportedModules) },
+		( { ForeignImportedModules = [] } ->
 			[]
 		;
+			{ Target = il ->
+				ForeignImportTarget = DllFileName,
+				ForeignImportExt = ".dll"
+			;
+				ForeignImportTarget = ObjFileName,
+				ForeignImportExt = ".mh"
+			},
 			io__write_string(DepStream, "\n\n"),
-			io__write_string(DepStream, ObjFileName),
+			io__write_string(DepStream, ForeignImportTarget),
 			io__write_string(DepStream, " : "),
-			write_dependencies_list(ForeignImportedModules, ".mh",
-				DepStream),
+			write_dependencies_list(ForeignImportedModules,
+					ForeignImportExt, DepStream),
 			io__write_string(DepStream, "\n\n")
 		),
 
@@ -2621,7 +2632,7 @@
 		->
 			{ Langs = set__to_sorted_list(LangSet) },
 			list__foldl(write_foreign_dependency_for_il(DepStream,
-				ModuleName, AllDeps), Langs)
+				ModuleName, AllDeps, ForeignImports), Langs)
 		;
 			[]
 		),
@@ -2833,10 +2844,10 @@
 	% scripts/Mmake.rules).
 	% 
 :- pred write_foreign_dependency_for_il(io__output_stream::in,sym_name::in,
-		list(module_name)::in, foreign_language::in,
-		io__state::di, io__state::uo) is det.
-write_foreign_dependency_for_il(DepStream, ModuleName, AllDeps, ForeignLang)
-		-->
+		list(module_name)::in, foreign_import_module_info::in,
+		foreign_language::in, io__state::di, io__state::uo) is det.
+write_foreign_dependency_for_il(DepStream, ModuleName, AllDeps,
+		ForeignImports, ForeignLang) -->
 	( 
 		{ ForeignModuleName = foreign_language_module_name(
 			ModuleName, ForeignLang) },
@@ -2880,8 +2891,13 @@
 			;
 				Prefix = "/r:"
 			},
+			{ ForeignDeps = list__map(
+				(func(M) =
+					foreign__module_name(M, ModuleName)
+				), ForeignImports) },
+			{ Deps = AllDeps ++ ForeignDeps },
 			write_dll_dependencies_list(
-				referenced_dlls(ModuleName, AllDeps),
+				referenced_dlls(ModuleName, Deps),
 				Prefix, DepStream),
 			io__nl(DepStream)
 		;
@@ -4851,11 +4867,8 @@
 		Info = Info1 ^ module_contains_foreign_export :=
 				contains_foreign_export
 	;
-		% XXX handle lang \= c for
-		% `:- pragma foreign_import_module'.
 		Pragma = foreign_import_module(Lang, Import),
-		Lang = c,
-		list__member(c, BackendLangs)
+		list__member(Lang, BackendLangs)
 	->
 		Info = Info0 ^ all_foreign_import_module_info :=
 	    		[foreign_import_module(Lang, Import, Context) | 	
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.52
diff -u -r1.52 prog_io_pragma.m
--- compiler/prog_io_pragma.m	26 Jul 2002 04:18:28 -0000	1.52
+++ compiler/prog_io_pragma.m	10 Dec 2002 13:54:14 -0000
@@ -179,12 +179,8 @@
 	    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 = ok(pragma(
+			foreign_import_module(Language, Import)))
 	    ;
 		Result = error("invalid foreign language in `:- pragma foreign_import_module' declaration",
 			LangTerm)
Index: tests/hard_coded/foreign_import_module.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/foreign_import_module.exp,v
retrieving revision 1.1
diff -u -r1.1 foreign_import_module.exp
--- tests/hard_coded/foreign_import_module.exp	6 Nov 2001 15:21:26 -0000	1.1
+++ tests/hard_coded/foreign_import_module.exp	10 Dec 2002 13:54:14 -0000
@@ -1 +1,2 @@
 42
+42
Index: tests/hard_coded/foreign_import_module.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/foreign_import_module.m,v
retrieving revision 1.2
diff -u -r1.2 foreign_import_module.m
--- tests/hard_coded/foreign_import_module.m	28 Nov 2002 16:33:44 -0000	1.2
+++ tests/hard_coded/foreign_import_module.m	10 Dec 2002 13:54:14 -0000
@@ -13,15 +13,50 @@
 main -->
 	{ bar(41, X) },
 	io__write(X),
-	io__write_char('\n').
+	io__nl,
 
-:- pragma foreign_import_module("C", foreign_import_module_2).
+	{ bar2(41, Y) },
+	io__write(Y),
+	io__nl.
+
+:- pragma foreign_import_module(c, foreign_import_module_2).
+:- pragma foreign_import_module(il, foreign_import_module_2).
+:- pragma foreign_import_module("MC++", foreign_import_module_2).
 
 :- pragma c_code(bar(X::in, Y::out), may_call_mercury,
 "
 	foo(X, &Y);
 ").
-:- pragma foreign_proc("C#", bar(X::in, Y::out),
+:- pragma foreign_proc("MC++", bar(X::in, Y::out),
 		[may_call_mercury, promise_pure], "
-	foreign_import_module_2.mercury_code.foo(X, ref Y);
+	MR_Integer Y1, Y2;
+
+	foreign_import_module_2::mercury_code::foo(X, &Y1);
+	foreign_import_module_2__cpp_code::mercury_code::foo2(X, &Y2);
+
+	if (Y1 == Y2) {
+		Y = Y1;
+	} else {
+		throw new System::Exception(""Y1 != Y2"");
+	}
+").
+
+:- pred bar2(int::in, int::out) is det.
+:- pragma c_code(bar2(X::in, Y::out), may_call_mercury,
+"
+	foo(X, &Y);
+").
+:- pragma foreign_proc("C#", bar2(X::in, Y::out),
+		[may_call_mercury, promise_pure], "
+	int Y1 = 0, Y2 = 0;
+
+	foreign_import_module_2.mercury_code.foo(X, ref Y1);
+	foreign_import_module_2__cpp_code.mercury_code.foo2(X, ref Y2);
+
+	if (Y1 == Y2) {
+		Y = Y1;
+	} else {
+		throw new System.Exception(""Y1 != Y2"");
+	}
 ").
Index: tests/hard_coded/foreign_import_module_2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/foreign_import_module_2.m,v
retrieving revision 1.1
diff -u -r1.1 foreign_import_module_2.m
--- tests/hard_coded/foreign_import_module_2.m	6 Nov 2001 15:21:27 -0000	1.1
+++ tests/hard_coded/foreign_import_module_2.m	10 Dec 2002 13:54:14 -0000
@@ -11,3 +11,10 @@
 :- pragma export(foo(in, out), "foo").
 
 foo(X, X+1).
+
+:- pragma foreign_code("MC++", "
+	static void foo2(MR_Integer X, MR_Ref(MR_Integer) Y)
+	{
+		*Y = 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
--------------------------------------------------------------------------