[m-rev.] for review: fix foreign_decls in the LLDS grades

[Peter Ross]

Hi,

For Simon or Fergus to review.

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


Estimated hours taken: 2
Branches: main

Record foreign_decls in the .mh file in the LLDS grades.  This allows
these declarations to be reused in different modules by just adding a
foreign_import_module declaration, rather than duplicating the
declarations using intermodule optimization.

compiler/export.m:
    Output the foreign_decls in the .mh file.
    A .mh file is now created if there is a pragma export or any
    foreign_decls in the module.

compiler/foreign.m:
    Change the type foreign_export_decls so that it records the foreign
    decls.
    Add the utility predicate decl_guard which is used to get the name
    used to protect foreign decls..

compiler/intermod.m:
    Don't add pragma foreign_code to .opt files until the limitation
    with foreign_import_module documented in
    intermod__write_intermod_info_2 is fixed.
    No longer output the foreign_decls in the .opt files instead replace
    it with a foreign_import_module to obtain the decls, currently this
    is disable until the limitation with foreign_import_module
    documented in intermod__write_intermod_info_2 is fixed.

compiler/mercury_compile.m:
    Guard the declarations output in the C file with decl_guard.  We
    output this second copy because it uses the line numbers of the
    source file for the declarations allowing one to debug problems more
    easily.

compiler/mlds_to_c.m:
    Guard the declaration output in the .mih file with decl_guard.

Index: compiler/export.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/export.m,v
retrieving revision 1.61
diff -u -r1.61 export.m
--- compiler/export.m	24 Jul 2002 16:05:08 -0000	1.61
+++ compiler/export.m	31 Jul 2002 12:00:19 -0000
@@ -69,6 +69,7 @@
 :- import_module backend_libs__foreign.
 :- import_module parse_tree__modules.
 :- import_module hlds__hlds_pred, check_hlds__type_util.
+:- import_module hlds__error_util.
 :- import_module backend_libs__code_model.
 :- import_module ll_backend__code_gen, ll_backend__code_util.
 :- import_module ll_backend__llds_out, ll_backend__arg_info.
@@ -80,13 +81,24 @@
 
 %-----------------------------------------------------------------------------%
 
-export__get_foreign_export_decls(HLDS, C_ExportDecls) :-
+export__get_foreign_export_decls(HLDS, ForeignExportDecls) :-
 	module_info_get_predicate_table(HLDS, PredicateTable),
 	predicate_table_get_preds(PredicateTable, Preds),
+
+	( module_info_contains_foreign_type(HLDS) ->
+		module_info_get_foreign_decl(HLDS, ForeignDecls),
+		MaybeForeignDecls = yes(ForeignDecls)
+	;
+		MaybeForeignDecls = no
+	),
+
 	module_info_get_pragma_exported_procs(HLDS, ExportedProcs),
 	module_info_globals(HLDS, Globals),
 	export__get_foreign_export_decls_2(Preds, ExportedProcs, Globals,
-		HLDS, C_ExportDecls).
+		HLDS, C_ExportDecls),
+
+	ForeignExportDecls = foreign_export_decls(MaybeForeignDecls,
+			C_ExportDecls).
 
 :- pred export__get_foreign_export_decls_2(pred_table,
 		list(pragma_exported_proc), globals,
@@ -597,31 +609,38 @@
 
 % Should this predicate go in llds_out.m?
 
-export__produce_header_file([], _) --> [].
-export__produce_header_file(C_ExportDecls, ModuleName) -->
-	{ C_ExportDecls = [_|_] },
-	export__produce_header_file(C_ExportDecls, ModuleName, ".mh"),
-
-	% XXX  We still need to produce the `.h' file for bootstrapping.
-	% The C files in the trace directory refer to std_util.h and io.h.
-	globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
-	{
-		HighLevelCode = yes,
-		ModuleName = unqualified(StdLibModule),
-		mercury_std_library_module(StdLibModule)
-	->
-		HeaderModuleName = qualified(unqualified("mercury"),
-			       StdLibModule)
-	;
-		HeaderModuleName = ModuleName
-	},
-	export__produce_header_file(C_ExportDecls, HeaderModuleName, ".h").
+export__produce_header_file(ForeignExportDecls, ModuleName) -->
+	( { ForeignExportDecls = foreign_export_decls(no, []) } ->
+		[]
+	;
+		export__produce_header_file(ForeignExportDecls,
+				ModuleName, ".mh"),
+
+		% XXX  We still need to produce the `.h' file for
+		% bootstrapping.  The C files in the trace directory refer to
+		% std_util.h and io.h.
+		globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
+		{
+			HighLevelCode = yes,
+			ModuleName = unqualified(StdLibModule),
+			mercury_std_library_module(StdLibModule)
+		->
+			HeaderModuleName = qualified(unqualified("mercury"),
+				       StdLibModule)
+		;
+			HeaderModuleName = ModuleName
+		},
+		export__produce_header_file(ForeignExportDecls,
+				HeaderModuleName, ".h")
+	).
 
-:- pred export__produce_header_file(foreign_export_decls, module_name, string,
-					io__state, io__state).
+:- pred export__produce_header_file(foreign_export_decls,
+		module_name, string, io__state, io__state).
 :- mode export__produce_header_file(in, in, in, di, uo) is det.
 
-export__produce_header_file(C_ExportDecls, ModuleName, HeaderExt) -->
+export__produce_header_file(ForeignExportDecls, ModuleName, HeaderExt) -->
+	{ ForeignExportDecls = foreign_export_decls(MaybeForeignDecls,
+			C_ExportDecls) },
 	module_name_to_file_name(ModuleName, HeaderExt, yes, FileName),
 	io__open_output(FileName, Result),
 	(
@@ -656,6 +675,16 @@
 			"#include ""mercury_deep_profiling.h""\n",
 			"#endif\n",
 			"\n"]),
+
+		( { MaybeForeignDecls = yes(ForeignDecls) } ->
+			io__write_strings(["#ifndef ", decl_guard(ModuleName),
+				"\n#define ", decl_guard(ModuleName), "\n"]),
+			list__foldl(output_foreign_decl, ForeignDecls),
+			io__write_string("#endif\n")
+		;
+			[]
+		),
+
 		export__produce_header_file_2(C_ExportDecls),
 		io__write_strings([
 			"\n",
@@ -676,7 +705,7 @@
 		io__set_exit_status(1)
 	).
 
-:- pred export__produce_header_file_2(foreign_export_decls, 
+:- pred export__produce_header_file_2(list(foreign_export_decl),
 		io__state, io__state).
 :- mode export__produce_header_file_2(in, di, uo) is det.
 export__produce_header_file_2([]) --> [].
@@ -693,8 +722,24 @@
 		io__write_string(ArgDecls),
 		io__write_string(");\n")
 	;
-		{ error("export__produce_header_file_2: foreign languages other than C unimplemented") }
+		{ sorry(this_file,
+			"foreign languages other than C unimplemented") }
 	),
 	export__produce_header_file_2(ExportedProcs).
+
+:- pred output_foreign_decl(foreign_decl_code::in, io::di, io::uo) is det.
+
+export__output_foreign_decl(foreign_decl_code(Lang, Code, _Context)) -->
+	( { Lang = c } ->
+		io__write_string(Code),
+		io__nl
+	;
+		[]
+	).
+	
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "export.m".
 
 %-----------------------------------------------------------------------------%
Index: compiler/foreign.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/foreign.m,v
retrieving revision 1.21
diff -u -r1.21 foreign.m
--- compiler/foreign.m	24 Jul 2002 16:05:08 -0000	1.21
+++ compiler/foreign.m	31 Jul 2002 11:49:34 -0000
@@ -21,7 +21,7 @@
 :- import_module parse_tree__prog_data, libs__globals.
 :- import_module hlds__hlds_module, hlds__hlds_pred.
 
-:- import_module bool, list, string, term.
+:- import_module bool, list, std_util, string, term.
 
 :- type foreign_decl_info ==	list(foreign_decl_code).	
 		% in reverse order
@@ -39,7 +39,16 @@
 		foreign_body_code(foreign_language, string, prog_context).
 
 :- type foreign_export_defns == list(foreign_export).
-:- type foreign_export_decls == list(foreign_export_decl).
+:- type foreign_export_decls
+	--->	foreign_export_decls(
+				% The foreign decls needed for use by
+				% the foreign exports, if any.
+				% Currently this will be filled out if
+				% there is a foreign_type declared in
+				% the module.
+			maybe(foreign_decl_info),
+			list(foreign_export_decl)
+		).
 
 :- type foreign_export_decl
 	---> foreign_export_decl(
@@ -184,6 +193,10 @@
 :- mode foreign_language_module_name(in, in) = out is semidet.
 :- mode foreign_language_module_name(in, in(lang_gen_ext_file)) = out is det.
 
+	% The name of the #define which can be used to guard declarations with
+	% to prevent entities being declared twice.
+:- func decl_guard(sym_name) = string.
+
 :- implementation.
 
 :- import_module list, map, assoc_list, std_util, string, varset, int, term.
@@ -677,6 +690,14 @@
 	).
 to_type_string(il, mercury(_Type)) = _ :-
 	sorry(this_file, "to_type_string for il").
+
+%-----------------------------------------------------------------------------%
+
+:- import_module ll_backend__llds_out.
+
+decl_guard(ModuleName) = UppercaseModuleName ++ "_DECL_GUARD" :-
+	llds_out__sym_name_mangle(ModuleName, MangledModuleName),
+	string__to_upper(MangledModuleName, UppercaseModuleName).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.123
diff -u -r1.123 intermod.m
--- compiler/intermod.m	22 Jul 2002 06:29:34 -0000	1.123
+++ compiler/intermod.m	31 Jul 2002 10:06:02 -0000
@@ -320,6 +320,12 @@
 		pred_info_clauses_info(PredInfo, ClauseInfo),
 		clauses_info_clauses(ClauseInfo, Clauses),
 
+		% XXX until mmake can handle the extra dependencies introduced
+		% in intermod__write_intermod_info_2 we cannot use
+		% foreign_procs because they might depend on foreign decls
+		% which are in the header file.
+		\+ pred_info_pragma_goal_type(PredInfo),
+
 		pred_info_procids(PredInfo, [ProcId | _ProcIds]),
 		pred_info_procedures(PredInfo, Procs),
 		map__lookup(Procs, ProcId, ProcInfo),
@@ -1104,15 +1110,15 @@
 	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) },
-		{ module_info_get_pragma_exported_procs(ModuleInfo,
-			PragmaExportedProcs) },
-		{ ForeignDecls = list__reverse(RevForeignDecls) },
 		{ ForeignImports0 = list__reverse(RevForeignImports) },
 
 		%
-		% If this module contains `:- pragma export' declarations,
+		% 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).' 
@@ -1123,9 +1129,15 @@
 		% the standard library fails (mmake attempts to build
 		% tree234.o before std_util.h is built).
 		%
-		{ semidet_fail, PragmaExportedProcs \= [] ->
-			% XXX Currently we only handle procedures
-			% exported to C.
+		% XXX Currently we only handle procedures
+		% exported to C.
+		{
+			% Check that the  import could contain anything.
+			( PragmaExportedProcs \= []
+			; RevForeignDecls \= []
+			),
+			semidet_fail
+		->
 			module_info_name(ModuleInfo, ModuleName),
 			ForeignImportThisModule = foreign_import_module(c,
 				ModuleName, term__context_init),
@@ -1134,19 +1146,14 @@
 		;
 			ForeignImports = 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)
+		    ), ForeignImports)
 	;
 		[]
 	),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.263
diff -u -r1.263 mercury_compile.m
--- compiler/mercury_compile.m	30 Jul 2002 08:25:07 -0000	1.263
+++ compiler/mercury_compile.m	31 Jul 2002 11:49:34 -0000
@@ -3181,7 +3181,8 @@
 	% If this module contains `:- pragma export' declarations,
 	% add a "#include <module>.h" declaration.
 	% XXX pragma export is only supported for C.
-	( UseForeignLanguage = c, Foreign_ExportDecls \= [] ->
+	Foreign_ExportDecls = foreign_export_decls(_, ExportDecls),
+	( UseForeignLanguage = c, ExportDecls \= [] ->
 		% We put the new include at the end since the list is
 		% stored in reverse, and we want this include to come
 		% first.
@@ -3251,8 +3252,8 @@
 	{ list__condense([CommonableData, NonCommonStaticData, ClosureLayouts,
 		TypeCtorTables, TypeClassInfos, PossiblyDynamicLayouts],
 		AllData) },
-	mercury_compile__construct_c_file(C_InterfaceInfo, Procs1, GlobalVars,
-		AllData, CFile, NumChunks),
+	mercury_compile__construct_c_file(HLDS, C_InterfaceInfo,
+		Procs1, GlobalVars, AllData, CFile, NumChunks),
 	mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
 		MaybeRLFile, Verbose, Stats),
 
@@ -3276,13 +3277,14 @@
 
 	% Split the code up into bite-size chunks for the C compiler.
 
-:- pred mercury_compile__construct_c_file(foreign_interface_info,
+:- pred mercury_compile__construct_c_file(module_info, foreign_interface_info,
 	list(c_procedure), list(comp_gen_c_var), list(comp_gen_c_data),
 	c_file, int, io__state, io__state).
-:- mode mercury_compile__construct_c_file(in, in, in, in, out, out, di, uo)
+:- mode mercury_compile__construct_c_file(in, in, in, in, in, out, out, di, uo)
 	is det.
 
-mercury_compile__construct_c_file(C_InterfaceInfo, Procedures, GlobalVars,
+mercury_compile__construct_c_file(_Module,
+		C_InterfaceInfo, Procedures, GlobalVars,
 		AllData, CFile, ComponentCount) -->
 	{ C_InterfaceInfo = foreign_interface_info(ModuleSymName,
 		C_HeaderCode0, C_Includes, C_BodyCode0,
@@ -3303,7 +3305,10 @@
 	),
 	list__map_foldl(make_foreign_import_header_code, C_Includes,
 		C_HeaderCode1),
-	{ C_HeaderCode = C_HeaderCode0 ++ C_HeaderCode1 },
+
+	{ make_decl_guards(ModuleSymName, Start, End) },
+	{ C_HeaderCode = [End | C_HeaderCode0] ++ [Start | C_HeaderCode1] },
+
 	{ CFile = c_file(ModuleSymName, C_HeaderCode, C_BodyCode,
 		C_ExportDefns, GlobalVars, AllData, ChunkedModules) },
 	{ list__length(C_BodyCode, UserCCodeCount) },
@@ -3313,6 +3318,16 @@
 	{ list__length(ChunkedModules, CompGenCodeCount) },
 	{ ComponentCount is UserCCodeCount + ExportCount
 		+ CompGenVarCount + CompGenDataCount + CompGenCodeCount }.
+
+:- pred make_decl_guards(sym_name::in,
+		foreign_decl_code::out, foreign_decl_code::out) is det.
+
+make_decl_guards(ModuleName, StartGuard, EndGuard) :-
+	Define = decl_guard(ModuleName),
+	Start = "#ifndef " ++ Define ++ "\n#define " ++ Define ++ "\n",
+	End = "#endif",
+	StartGuard = foreign_decl_code(c, Start, term__context_init),
+	EndGuard = foreign_decl_code(c, End, term__context_init).
 
 :- pred make_foreign_import_header_code(foreign_import_module,
 		foreign_decl_code, io__state, io__state).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.134
diff -u -r1.134 mlds_to_c.m
--- compiler/mlds_to_c.m	23 Jul 2002 16:35:36 -0000	1.134
+++ compiler/mlds_to_c.m	31 Jul 2002 11:58:50 -0000
@@ -547,11 +547,15 @@
 		io__state, io__state).
 :- mode mlds_output_c_hdr_decls(in, in, in, di, uo) is det.
 
-mlds_output_c_hdr_decls(_ModuleName, Indent, ForeignCode) -->
+mlds_output_c_hdr_decls(ModuleName, Indent, ForeignCode) -->
 	{ ForeignCode = mlds__foreign_code(RevHeaderCode, _RevImports,
 		_RevBodyCode, _ExportDefns) },
 	{ HeaderCode = list__reverse(RevHeaderCode) },
-	io__write_list(HeaderCode, "\n", mlds_output_c_hdr_decl(Indent)).
+	{ DeclGuard = decl_guard(mlds_module_name_to_sym_name(ModuleName)) },
+	io__write_strings(["#ifndef ", DeclGuard,
+			 "\n#define ", DeclGuard, "\n"]),
+	io__write_list(HeaderCode, "\n", mlds_output_c_hdr_decl(Indent)),
+	io__write_string("#endif\n").
 
 :- pred mlds_output_c_hdr_decl(indent,
 	foreign_decl_code, io__state, io__state).

----
Peter Ross
PhD Student University of Melbourne
http://www.cs.mu.oz.au/~petdr/
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------