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

Peter Ross pro at missioncriticalit.com
Fri Aug 2 02:03:17 AEST 2002


Hi,


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


Estimated hours taken: 5
Branches: main

Record foreign_decls in the .mh file.
This fixes a bug where a definitions of pragma exported functions where
refereing to undefined pragma foreign_type names.

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.
    No longer create a .h version of the .mh file as these names
    conflict with system header files, and the change was only needed
    for bootstrapping.

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.
    
trace/mercury_trace_browse.c:
trace/mercury_trace_declarative.c:
trace/mercury_trace_external.c:
trace/mercury_trace_help.c:
trace/mercury_trace_internal.c:
    Switch to the .mh extension.

tests/hard_coded/foreign_type.m:
    Enable testing of whether pragma export and pragma foreign_type work
    together.

tests/invalid/Mmakefile:
tests/invalid/foreign_decl_line_number.err_exp:
tests/invalid/foreign_decl_line_number.err_exp2:
tests/invalid/foreign_decl_line_number.m:
    Test that the line numbers for foreign_decl are still correct.

Relative diff:
diff -u compiler/export.m compiler/export.m
--- compiler/export.m	31 Jul 2002 12:00:19 -0000
+++ compiler/export.m	31 Jul 2002 15:28:14 -0000
@@ -85,20 +85,15 @@
 	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_foreign_decl(HLDS, RevForeignDecls),
+	ForeignDecls = list__reverse(RevForeignDecls),
 
 	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),
 
-	ForeignExportDecls = foreign_export_decls(MaybeForeignDecls,
-			C_ExportDecls).
+	ForeignExportDecls = foreign_export_decls(ForeignDecls, C_ExportDecls).
 
 :- pred export__get_foreign_export_decls_2(pred_table,
 		list(pragma_exported_proc), globals,
@@ -610,28 +605,11 @@
 % Should this predicate go in llds_out.m?
 
 export__produce_header_file(ForeignExportDecls, ModuleName) -->
-	( { ForeignExportDecls = foreign_export_decls(no, []) } ->
+	( { ForeignExportDecls = foreign_export_decls([], []) } ->
 		[]
 	;
 		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")
+				ModuleName, ".mh")
 	).
 
 :- pred export__produce_header_file(foreign_export_decls,
@@ -639,7 +617,7 @@
 :- mode export__produce_header_file(in, in, in, di, uo) is det.
 
 export__produce_header_file(ForeignExportDecls, ModuleName, HeaderExt) -->
-	{ ForeignExportDecls = foreign_export_decls(MaybeForeignDecls,
+	{ ForeignExportDecls = foreign_export_decls(ForeignDecls,
 			C_ExportDecls) },
 	module_name_to_file_name(ModuleName, HeaderExt, yes, FileName),
 	io__open_output(FileName, Result),
@@ -676,14 +654,10 @@
 			"#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")
-		;
-			[]
-		),
+		io__write_strings(["#ifndef ", decl_guard(ModuleName),
+				 "\n#define ", decl_guard(ModuleName), "\n"]),
+		list__foldl(output_foreign_decl, ForeignDecls),
+		io__write_string("\n#endif\n"),
 
 		export__produce_header_file_2(C_ExportDecls),
 		io__write_strings([
diff -u compiler/foreign.m compiler/foreign.m
--- compiler/foreign.m	31 Jul 2002 11:49:34 -0000
+++ compiler/foreign.m	31 Jul 2002 15:10:57 -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, std_util, string, term.
+:- import_module bool, list, string, term.
 
 :- type foreign_decl_info ==	list(foreign_decl_code).	
 		% in reverse order
@@ -41,12 +41,7 @@
 :- type foreign_export_defns == list(foreign_export).
 :- 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),
+			foreign_decl_info,
 			list(foreign_export_decl)
 		).
 
diff -u compiler/intermod.m compiler/intermod.m
--- compiler/intermod.m	31 Jul 2002 10:06:02 -0000
+++ compiler/intermod.m	31 Jul 2002 15:27:26 -0000
@@ -1127,7 +1127,10 @@
 		% XXX We should do this, but mmake can't handle
 		% the extra dependencies properly yet, so building
 		% the standard library fails (mmake attempts to build
-		% tree234.o before std_util.h is built).
+		% tree234.o before std_util.h is built). Note that once
+		% this is fixed the restriction on adding pragma
+		% foreign_procs to the .opt file in
+		% intermod__should_be_processed can be removed.
 		%
 		% XXX Currently we only handle procedures
 		% exported to C.
diff -u compiler/mercury_compile.m compiler/mercury_compile.m
--- compiler/mercury_compile.m	31 Jul 2002 11:49:34 -0000
+++ compiler/mercury_compile.m	31 Jul 2002 15:11:11 -0000
@@ -3325,7 +3325,7 @@
 make_decl_guards(ModuleName, StartGuard, EndGuard) :-
 	Define = decl_guard(ModuleName),
 	Start = "#ifndef " ++ Define ++ "\n#define " ++ Define ++ "\n",
-	End = "#endif",
+	End = "\n#endif",
 	StartGuard = foreign_decl_code(c, Start, term__context_init),
 	EndGuard = foreign_decl_code(c, End, term__context_init).
 
diff -u compiler/mlds_to_c.m compiler/mlds_to_c.m
--- compiler/mlds_to_c.m	31 Jul 2002 11:58:50 -0000
+++ compiler/mlds_to_c.m	31 Jul 2002 15:11:18 -0000
@@ -555,7 +555,7 @@
 	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").
+	io__write_string("\n#endif\n").
 
 :- pred mlds_output_c_hdr_decl(indent,
 	foreign_decl_code, io__state, io__state).
only in patch2:
--- trace/mercury_trace_internal.c	29 Jul 2002 11:16:01 -0000	1.131
+++ trace/mercury_trace_internal.c	31 Jul 2002 13:37:31 -0000
@@ -29,9 +29,9 @@
 #include "mercury_trace_readline.h"
 #include "mercury_trace_source.h"
 
-#include "mdb.browse.h"
-#include "mdb.browser_info.h"
-#include "mdb.program_representation.h"
+#include "mdb.browse.mh"
+#include "mdb.browser_info.mh"
+#include "mdb.program_representation.mh"
 
 #include <stdio.h>
 #include <stdlib.h>
only in patch2:
--- trace/mercury_trace_help.c	6 Mar 2002 14:35:03 -0000	1.18
+++ trace/mercury_trace_help.c	31 Jul 2002 15:50:48 -0000
@@ -31,14 +31,10 @@
 #include "mercury_trace_internal.h"
 #include "mercury_trace_util.h"
 
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.type_desc.h"
-  #include "mercury.io.h"
-#else
-  #include "type_desc.h"
-  #include "io.h"
-#endif
-#include "mdb.help.h"
+#include "type_desc.mh"
+#include "io.mh"
+
+#include "mdb.help.mh"
 
 #include <stdio.h>
 
only in patch2:
--- trace/mercury_trace_external.c	15 May 2002 11:24:19 -0000	1.65
+++ trace/mercury_trace_external.c	31 Jul 2002 15:53:29 -0000
@@ -29,13 +29,10 @@
 #include "mercury_trace_browse.h"
 #include "mercury_trace_vars.h"
 
-#include "mdb.debugger_interface.h"
-#include "mdb.collect_lib.h"
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.type_desc.h"
-#else
-  #include "type_desc.h"
-#endif
+#include "mdb.debugger_interface.mh"
+#include "mdb.collect_lib.mh"
+
+#include "type_desc.mh"
 
 #include "mercury_deep_copy.h"
 
only in patch2:
--- trace/mercury_trace_declarative.c	5 Jun 2002 16:41:30 -0000	1.55
+++ trace/mercury_trace_declarative.c	31 Jul 2002 15:50:00 -0000
@@ -45,13 +45,10 @@
 #include "mercury_string.h"
 #include "mercury_trace_base.h"
 
-#include "mdb.declarative_debugger.h"
-#include "mdb.declarative_execution.h"
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.std_util.h"
-#else
-  #include "std_util.h"
-#endif
+#include "mdb.declarative_debugger.mh"
+#include "mdb.declarative_execution.mh"
+
+#include "std_util.mh"
 
 #include <errno.h>
 
only in patch2:
--- trace/mercury_trace_browse.c	18 Feb 2002 07:01:28 -0000	1.25
+++ trace/mercury_trace_browse.c	31 Jul 2002 15:49:10 -0000
@@ -29,14 +29,11 @@
 #include "mercury_trace_internal.h"
 #include "mercury_trace_external.h"
 
-#include "mdb.browse.h"
-#include "mdb.browser_info.h"
-#include "mdb.interactive_query.h"
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.type_desc.h"
-#else
-  #include "type_desc.h"
-#endif
+#include "mdb.browse.mh"
+#include "mdb.browser_info.mh"
+#include "mdb.interactive_query.mh"
+
+#include "type_desc.mh"
 
 #include <stdio.h>
 


Full diff:
Index: mercury/compiler/export.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/export.m,v
retrieving revision 1.61
diff -u -r1.61 export.m
--- mercury/compiler/export.m	24 Jul 2002 16:05:08 -0000	1.61
+++ mercury/compiler/export.m	31 Jul 2002 15:28:14 -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,19 @@
 
 %-----------------------------------------------------------------------------%
 
-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_get_foreign_decl(HLDS, RevForeignDecls),
+	ForeignDecls = list__reverse(RevForeignDecls),
+
 	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(ForeignDecls, C_ExportDecls).
 
 :- pred export__get_foreign_export_decls_2(pred_table,
 		list(pragma_exported_proc), globals,
@@ -597,31 +604,21 @@
 
 % 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([], []) } ->
+		[]
+	;
+		export__produce_header_file(ForeignExportDecls,
+				ModuleName, ".mh")
+	).
 
-:- 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(ForeignDecls,
+			C_ExportDecls) },
 	module_name_to_file_name(ModuleName, HeaderExt, yes, FileName),
 	io__open_output(FileName, Result),
 	(
@@ -656,6 +653,12 @@
 			"#include ""mercury_deep_profiling.h""\n",
 			"#endif\n",
 			"\n"]),
+
+		io__write_strings(["#ifndef ", decl_guard(ModuleName),
+				 "\n#define ", decl_guard(ModuleName), "\n"]),
+		list__foldl(output_foreign_decl, ForeignDecls),
+		io__write_string("\n#endif\n"),
+
 		export__produce_header_file_2(C_ExportDecls),
 		io__write_strings([
 			"\n",
@@ -676,7 +679,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 +696,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: mercury/compiler/foreign.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/foreign.m,v
retrieving revision 1.21
diff -u -r1.21 foreign.m
--- mercury/compiler/foreign.m	24 Jul 2002 16:05:08 -0000	1.21
+++ mercury/compiler/foreign.m	31 Jul 2002 15:10:57 -0000
@@ -39,7 +39,11 @@
 		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(
+			foreign_decl_info,
+			list(foreign_export_decl)
+		).
 
 :- type foreign_export_decl
 	---> foreign_export_decl(
@@ -184,6 +188,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 +685,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: mercury/compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.123
diff -u -r1.123 intermod.m
--- mercury/compiler/intermod.m	22 Jul 2002 06:29:34 -0000	1.123
+++ mercury/compiler/intermod.m	31 Jul 2002 15:27:26 -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).' 
@@ -1121,11 +1127,20 @@
 		% XXX We should do this, but mmake can't handle
 		% the extra dependencies properly yet, so building
 		% the standard library fails (mmake attempts to build
-		% tree234.o before std_util.h is built).
+		% tree234.o before std_util.h is built). Note that once
+		% this is fixed the restriction on adding pragma
+		% foreign_procs to the .opt file in
+		% intermod__should_be_processed can be removed.
 		%
-		{ 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 +1149,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: mercury/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
--- mercury/compiler/mercury_compile.m	30 Jul 2002 08:25:07 -0000	1.263
+++ mercury/compiler/mercury_compile.m	31 Jul 2002 15:11:11 -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 = "\n#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: mercury/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
--- mercury/compiler/mlds_to_c.m	23 Jul 2002 16:35:36 -0000	1.134
+++ mercury/compiler/mlds_to_c.m	31 Jul 2002 15:11:18 -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("\n#endif\n").
 
 :- pred mlds_output_c_hdr_decl(indent,
 	foreign_decl_code, io__state, io__state).
Index: mercury/trace/mercury_trace_browse.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_browse.c,v
retrieving revision 1.25
diff -u -r1.25 mercury_trace_browse.c
--- mercury/trace/mercury_trace_browse.c	18 Feb 2002 07:01:28 -0000	1.25
+++ mercury/trace/mercury_trace_browse.c	31 Jul 2002 15:49:10 -0000
@@ -29,14 +29,11 @@
 #include "mercury_trace_internal.h"
 #include "mercury_trace_external.h"
 
-#include "mdb.browse.h"
-#include "mdb.browser_info.h"
-#include "mdb.interactive_query.h"
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.type_desc.h"
-#else
-  #include "type_desc.h"
-#endif
+#include "mdb.browse.mh"
+#include "mdb.browser_info.mh"
+#include "mdb.interactive_query.mh"
+
+#include "type_desc.mh"
 
 #include <stdio.h>
 
Index: mercury/trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.55
diff -u -r1.55 mercury_trace_declarative.c
--- mercury/trace/mercury_trace_declarative.c	5 Jun 2002 16:41:30 -0000	1.55
+++ mercury/trace/mercury_trace_declarative.c	31 Jul 2002 15:50:00 -0000
@@ -45,13 +45,10 @@
 #include "mercury_string.h"
 #include "mercury_trace_base.h"
 
-#include "mdb.declarative_debugger.h"
-#include "mdb.declarative_execution.h"
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.std_util.h"
-#else
-  #include "std_util.h"
-#endif
+#include "mdb.declarative_debugger.mh"
+#include "mdb.declarative_execution.mh"
+
+#include "std_util.mh"
 
 #include <errno.h>
 
Index: mercury/trace/mercury_trace_external.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.65
diff -u -r1.65 mercury_trace_external.c
--- mercury/trace/mercury_trace_external.c	15 May 2002 11:24:19 -0000	1.65
+++ mercury/trace/mercury_trace_external.c	31 Jul 2002 15:53:29 -0000
@@ -29,13 +29,10 @@
 #include "mercury_trace_browse.h"
 #include "mercury_trace_vars.h"
 
-#include "mdb.debugger_interface.h"
-#include "mdb.collect_lib.h"
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.type_desc.h"
-#else
-  #include "type_desc.h"
-#endif
+#include "mdb.debugger_interface.mh"
+#include "mdb.collect_lib.mh"
+
+#include "type_desc.mh"
 
 #include "mercury_deep_copy.h"
 
Index: mercury/trace/mercury_trace_help.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_help.c,v
retrieving revision 1.18
diff -u -r1.18 mercury_trace_help.c
--- mercury/trace/mercury_trace_help.c	6 Mar 2002 14:35:03 -0000	1.18
+++ mercury/trace/mercury_trace_help.c	31 Jul 2002 15:50:48 -0000
@@ -31,14 +31,10 @@
 #include "mercury_trace_internal.h"
 #include "mercury_trace_util.h"
 
-#ifdef MR_HIGHLEVEL_CODE
-  #include "mercury.type_desc.h"
-  #include "mercury.io.h"
-#else
-  #include "type_desc.h"
-  #include "io.h"
-#endif
-#include "mdb.help.h"
+#include "type_desc.mh"
+#include "io.mh"
+
+#include "mdb.help.mh"
 
 #include <stdio.h>
 
Index: mercury/trace/mercury_trace_internal.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.131
diff -u -r1.131 mercury_trace_internal.c
--- mercury/trace/mercury_trace_internal.c	29 Jul 2002 11:16:01 -0000	1.131
+++ mercury/trace/mercury_trace_internal.c	31 Jul 2002 13:37:31 -0000
@@ -29,9 +29,9 @@
 #include "mercury_trace_readline.h"
 #include "mercury_trace_source.h"
 
-#include "mdb.browse.h"
-#include "mdb.browser_info.h"
-#include "mdb.program_representation.h"
+#include "mdb.browse.mh"
+#include "mdb.browser_info.mh"
+#include "mdb.program_representation.mh"
 
 #include <stdio.h>
 #include <stdlib.h>
Index: tests/hard_coded/foreign_type.m
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/foreign_type.m,v
retrieving revision 1.3
diff -u -r1.3 foreign_type.m
--- tests/hard_coded/foreign_type.m	25 Jul 2002 16:20:55 -0000	1.3
+++ tests/hard_coded/foreign_type.m	1 Aug 2002 10:18:47 -0000
@@ -11,7 +11,7 @@
 :- type coord.
 
 :- func new(int, int) = coord.
-% :- pragma export(new(in, in) = out, "exported_new").
+:- pragma export(new(in, in) = out, "exported_new").
 
 :- func x(coord) = int.
 :- func y(coord) = int.
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/invalid/Mmakefile,v
retrieving revision 1.118
diff -u -r1.118 Mmakefile
--- tests/invalid/Mmakefile	1 Aug 2002 00:41:39 -0000	1.118
+++ tests/invalid/Mmakefile	1 Aug 2002 14:21:07 -0000
@@ -52,6 +52,7 @@
 	ext_type_bug.m \
 	exported_mode.m \
 	field_syntax_error.m \
+	foreign_decl_line_number.m \
 	foreign_singleton.m \
 	foreign_type_2.m \
 	foreign_type_visibility.m \
@@ -179,6 +180,7 @@
 MCFLAGS-children =		--no-intermodule-optimization
 MCFLAGS-duplicate_modes	=	--verbose-error-messages
 MCFLAGS-exported_mode =		--infer-all --no-intermodule-optimization
+MCFLAGS-foreign_decl_line_number = --no-errorcheck-only --line-numbers --compile-only
 MCFLAGS-foreign_type =		--compile-only
 MCFLAGS-foreign_singleton =	--halt-at-warn
 MCFLAGS-foreign_type_2 =	--no-intermodule-optimization
@@ -215,7 +217,7 @@
 ERR_RESS=	$(SOURCES:%.m=%.err_res)
 
 %.err: %.m
-	if $(MC) $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) --errorcheck-only $* \
+	if $(MC) --errorcheck-only $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) $* \
 		> $*.err 2>&1; \
 	then false; else true; fi
 
Index: tests/invalid/foreign_decl_line_number.err_exp
===================================================================
RCS file: tests/invalid/foreign_decl_line_number.err_exp
diff -N tests/invalid/foreign_decl_line_number.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/foreign_decl_line_number.err_exp	1 Aug 2002 14:18:36 -0000
@@ -0,0 +1,5 @@
+foreign_decl_line_number.m:18: warning: no semicolon at end of struct or union
+foreign_decl_line_number.m:18: parse error before `int'
+foreign_decl_line_number.m:19: warning: type defaults to `int' in declaration of `bug'
+foreign_decl_line_number.m:19: warning: data definition has no type or storage class
+For more information, try recompiling with `-E'.
Index: tests/invalid/foreign_decl_line_number.err_exp2
===================================================================
RCS file: tests/invalid/foreign_decl_line_number.err_exp2
diff -N tests/invalid/foreign_decl_line_number.err_exp2
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/foreign_decl_line_number.err_exp2	1 Aug 2002 14:18:14 -0000
@@ -0,0 +1,6 @@
+In file included from foreign_decl_line_number.c:21:
+foreign_decl_line_number.m:18: warning: no semicolon at end of struct or union
+foreign_decl_line_number.m:18: parse error before `int'
+foreign_decl_line_number.m:19: warning: type defaults to `int' in declaration of `bug'
+foreign_decl_line_number.m:19: warning: data definition has no type or storage class
+For more information, try recompiling with `-E'.
Index: tests/invalid/foreign_decl_line_number.m
===================================================================
RCS file: tests/invalid/foreign_decl_line_number.m
diff -N tests/invalid/foreign_decl_line_number.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/foreign_decl_line_number.m	1 Aug 2002 13:44:20 -0000
@@ -0,0 +1,21 @@
+% Check that we report the correct line number for the error in
+% foreign_decl.
+:- module foreign_decl_line_number.
+:- interface.
+
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main -->
+	io__write_string("Hello\n").
+
+:- pragma foreign_decl("C", "
+	/* Missing ; in struct def */
+typedef struct {
+	int	missing_semicolon_here
+	int	x;
+} bug;
+").
+	

--------------------------------------------------------------------------
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