[m-dev.] for review: pragma foreign_code for MC++ (part 2/2)

Tyson Dowd trd at cs.mu.OZ.AU
Fri Nov 10 19:49:44 AEDT 2000


Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.181
diff -u -r1.181 mercury_compile.m
--- compiler/mercury_compile.m	2000/10/14 04:00:12	1.181
+++ compiler/mercury_compile.m	2000/11/10 04:08:01
@@ -43,7 +43,7 @@
 	% the LLDS back-end
 :- import_module saved_vars, liveness.
 :- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
-:- import_module code_gen, optimize, export.
+:- import_module code_gen, optimize, foreign, export.
 :- import_module base_typeclass_info.
 :- import_module llds_common, transform_llds, llds_out.
 :- import_module continuation_info, stack_layout.
@@ -2180,25 +2180,32 @@
 %-----------------------------------------------------------------------------%
 
 %
-% Gather together the information from the HLDS that is
-% used for the C interface.  This stuff mostly just gets
-% passed directly to the LLDS unchanged, but we do do
-% a bit of code generation -- for example, we call
-% export__get_c_export_{decls,defns} here, which do the
-% generation of C code for `pragma export' declarations.
+% Gather together the information from the HLDS, given the foreign
+% language we are going to use, that is used for the foreign language
+% interface.  
+% This stuff mostly just gets passed directly to the LLDS unchanged, but
+% we do do a bit of code generation -- for example, we call
+% export__get_foreign_export_{decls,defns} here, which do the generation
+% of C code for `pragma export' declarations.
 %
 
-:- pred get_c_interface_info(module_info, foreign_interface_info).
-:- mode get_c_interface_info(in, out) is det.
+:- pred get_c_interface_info(module_info, foreign_language, 
+		foreign_interface_info).
+:- mode get_c_interface_info(in, in, out) is det.
 
-get_c_interface_info(HLDS, C_InterfaceInfo) :-
+get_c_interface_info(HLDS, UseForeignLanguage, Foreign_InterfaceInfo) :-
 	module_info_name(HLDS, ModuleName),
-	module_info_get_foreign_header(HLDS, C_HeaderCode),
-	module_info_get_foreign_body_code(HLDS, C_BodyCode),
-	export__get_c_export_decls(HLDS, C_ExportDecls),
-	export__get_c_export_defns(HLDS, C_ExportDefns),
-	C_InterfaceInfo = foreign_interface_info(ModuleName,
-		C_HeaderCode, C_BodyCode, C_ExportDecls, C_ExportDefns).
+	module_info_get_foreign_decl(HLDS, ForeignDecls),
+	module_info_get_foreign_body_code(HLDS, ForeignBodyCode),
+	foreign__filter_decls(UseForeignLanguage, ForeignDecls, 
+		WantedForeignDecls, _OtherDecls),
+	foreign__filter_bodys(UseForeignLanguage, ForeignBodyCode,
+		WantedForeignBodys, _OtherBodys),
+	export__get_foreign_export_decls(HLDS, Foreign_ExportDecls),
+	export__get_foreign_export_defns(HLDS, Foreign_ExportDefns),
+	Foreign_InterfaceInfo = foreign_interface_info(ModuleName,
+		WantedForeignDecls, WantedForeignBodys,
+		Foreign_ExportDecls, Foreign_ExportDefns).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -2234,7 +2241,9 @@
 	% XXX this should perhaps be part of backend_pass
 	% rather than output_pass.
 	%
-	{ get_c_interface_info(HLDS, C_InterfaceInfo) },
+	globals__io_lookup_foreign_language_option(use_foreign_language,
+		UseForeignLanguage),
+	{ get_c_interface_info(HLDS, UseForeignLanguage, C_InterfaceInfo) },
 	{ global_data_get_all_proc_vars(GlobalData, GlobalVars) },
 	{ global_data_get_all_non_common_static_data(GlobalData,
 		NonCommonStaticData) },
@@ -2311,7 +2320,7 @@
 		+ CompGenVarCount + CompGenDataCount + CompGenCodeCount }.
 
 :- pred maybe_add_header_file_include(foreign_export_decls, module_name,
-	foreign_header_info, foreign_header_info, io__state, io__state).
+	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, 
@@ -2327,16 +2336,16 @@
 			SplitFiles = yes,
                         string__append_list(
                                 ["#include ""../", HeaderFileName, """\n"],
-				Include0)
+				IncludeString)
                 ;
 			SplitFiles = no,
                         string__append_list(
 				["#include """, HeaderFileName, """\n"],
-				Include0)
+				IncludeString)
                 },
 
 		{ term__context_init(Context) },
-		{ Include = Include0 - 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
@@ -2348,8 +2357,8 @@
 :- mode get_c_body_code(in, out) is det.
 
 get_c_body_code([], []).
-get_c_body_code([Code - Context | CodesAndContexts],
-		[user_foreign_code(c, Code, Context) | C_Modules]) :-
+get_c_body_code([foreign_body_code(Lang, Code, Context) | CodesAndContexts],
+		[user_foreign_code(Lang, Code, Context) | C_Modules]) :-
 	get_c_body_code(CodesAndContexts, C_Modules).
 
 :- pred mercury_compile__combine_chunks(list(list(c_procedure)), string,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.179
diff -u -r1.179 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	2000/11/01 05:12:02	1.179
+++ compiler/mercury_to_mercury.m	2000/11/10 05:51:37
@@ -80,10 +80,12 @@
 		io__state, io__state).
 :- mode mercury_output_pragma_decl(in, in, in, in, di, uo) is det.
 
-:- pred mercury_output_pragma_c_code(pragma_foreign_code_attributes, sym_name,
+:- pred mercury_output_pragma_foreign_code(
+		pragma_foreign_code_attributes, sym_name,
 		pred_or_func, list(pragma_var), prog_varset,
 		pragma_foreign_code_impl, io__state, io__state).
-:- mode mercury_output_pragma_c_code(in, in, in, in, in, in, di, uo) is det.
+:- mode mercury_output_pragma_foreign_code(
+		in, in, in, in, in, in, di, uo) is det.
 
 :- inst type_spec == bound(type_spec(ground, ground, ground, ground,
 			ground, ground, ground)).
@@ -101,9 +103,9 @@
 :- pred mercury_output_index_spec(index_spec, io__state, io__state). 
 :- mode mercury_output_index_spec(in, di, uo) is det.
 
-	% Output the given c_header_code declaration
-:- pred mercury_output_pragma_c_header(string, io__state, io__state).
-:- mode mercury_output_pragma_c_header(in, di, uo) is det.
+	% Output the given foreign_decl declaration
+:- pred mercury_output_pragma_foreign_decl(foreign_language, string,				io__state, io__state).
+:- mode mercury_output_pragma_foreign_decl(in, in, di, uo) is det.
 
 :- pred mercury_output_type_defn(tvarset, type_defn, prog_context,
 		io__state, io__state).
@@ -343,18 +345,16 @@
 		{ Pragma = source_file(SourceFile) },
 		mercury_output_pragma_source_file(SourceFile)
 	;
-		{ Pragma = c_header_code(C_HeaderString) },
-		mercury_output_pragma_c_header(C_HeaderString)
+		{ Pragma = foreign_decl(Lang, ForeignHeaderString) },
+		mercury_output_pragma_foreign_decl(Lang, ForeignHeaderString)
 	;
-		{ Pragma = foreign(_Lang, Code) }, 
-		% XXX if it is C code only
-		mercury_output_pragma_c_body_code(Code)
+		{ Pragma = foreign(Lang, Code) }, 
+		mercury_output_pragma_foreign_body_code(Lang, Code)
 	;
-		{ Pragma = foreign(_Lang, Attributes, Pred, PredOrFunc, Vars,
+		{ Pragma = foreign(Attributes, Pred, PredOrFunc, Vars,
 			VarSet, PragmaCode) }, 
-		% XXX if it is C code only
-		mercury_output_pragma_c_code(Attributes, Pred, PredOrFunc, 
-			Vars, VarSet, PragmaCode)
+		mercury_output_pragma_foreign_code(Attributes, Pred,
+			PredOrFunc, Vars, VarSet, PragmaCode)
 	;
 		{ Pragma = import(Pred, PredOrFunc, ModeList, Attributes,
 			C_Function) },
@@ -2061,20 +2061,29 @@
 
 %-----------------------------------------------------------------------------%
 
-mercury_output_pragma_c_header(C_HeaderString) -->
-	io__write_string(":- pragma c_header_code("),
-	mercury_output_c_code_string(C_HeaderString),
+mercury_output_pragma_foreign_decl(Lang, ForeignDeclString) -->
+	io__write_string(":- pragma foreign_decl("),
+	mercury_output_foreign_language_string(Lang),
+	io__write_string(", "),
+	mercury_output_foreign_code_string(ForeignDeclString),
 	io__write_string(").\n").
 
+:- pred mercury_output_foreign_language_string(foreign_language::in,
+		io__state::di, io__state::uo) is det.
+mercury_output_foreign_language_string(c) -->
+	io__write_string("""C""").
+mercury_output_foreign_language_string(managedcplusplus) -->
+	io__write_string("""MC++""").
+
 %-----------------------------------------------------------------------------%
 
 % The code here is similar to the code for term_io__quote_string,
 % but \n and \t are output directly, rather than escaped.
 % Any changes here may require corresponding changes to term_io and vice versa.
 
-:- pred mercury_output_c_code_string(string::in, io__state::di, io__state::uo)
-	is det.
-mercury_output_c_code_string(S) -->
+:- pred mercury_output_foreign_code_string(string::in, 
+		io__state::di, io__state::uo) is det.
+mercury_output_foreign_code_string(S) -->
 	io__write_char('"'),
 	mercury_write_escaped_string(S),
 	io__write_char('"').
@@ -2173,7 +2182,8 @@
 	% escape_special_char(Char, EscapeChar)
 	% is true iff Char is character for which there is a special
 	% backslash-escape character EscapeChar that can be used
-	% after a backslash in Mercury c_code string literals represent Char.
+	% after a backslash in Mercury foreign_code string literals 
+	% represent Char.
 
 :- pred escape_special_char(char, char).
 :- mode escape_special_char(in, out) is semidet.
@@ -2195,27 +2205,32 @@
 	io__write_string(").\n").
 
 %-----------------------------------------------------------------------------%
+
+	% Output the given foreign_body_code declaration
+:- pred mercury_output_pragma_foreign_body_code(foreign_language, 
+		string, io__state, io__state).
+:- mode mercury_output_pragma_foreign_body_code(in, in, di, uo) is det.
 
-	% Output the given c_body_code declaration
-:- pred mercury_output_pragma_c_body_code(string, io__state, io__state).
-:- mode mercury_output_pragma_c_body_code(in, di, uo) is det.
-
-mercury_output_pragma_c_body_code(C_CodeString) -->
-	io__write_string(":- pragma c_code("),
-	mercury_output_c_code_string(C_CodeString),
+mercury_output_pragma_foreign_body_code(Lang, ForeignCodeString) -->
+	io__write_string(":- pragma foreign_code("),
+	mercury_output_foreign_language_string(Lang),
+	mercury_output_foreign_code_string(ForeignCodeString),
 	io__write_string(").\n").
 
 %-----------------------------------------------------------------------------%
 
-	% Output the given pragma c_code declaration
-mercury_output_pragma_c_code(Attributes, PredName, PredOrFunc, Vars0,
+	% Output the given pragma foreign_code declaration
+mercury_output_pragma_foreign_code(Attributes, PredName, PredOrFunc, Vars0,
 		VarSet, PragmaCode) -->
 	(
 		{ PragmaCode = import(_, _, _, _) }
 	->
 		io__write_string(":- pragma import(")
 	;
-		io__write_string(":- pragma c_code(")
+		io__write_string(":- pragma foreign_code("),
+		{ foreign_language(Attributes, Lang) },
+		mercury_output_foreign_language_string(Lang),
+		io__write_string(", ")
 	),
 	mercury_output_sym_name(PredName),
 	{
@@ -2231,7 +2246,7 @@
 		[]
 	;
 		io__write_string("("),
-		mercury_output_pragma_c_code_vars(Vars, VarSet),
+		mercury_output_pragma_foreign_code_vars(Vars, VarSet),
 		io__write_string(")")
 	),
 	(
@@ -2239,26 +2254,26 @@
 	;
 		{ PredOrFunc = function },
 		io__write_string(" = ("),
-		mercury_output_pragma_c_code_vars(ResultVars, VarSet),
+		mercury_output_pragma_foreign_code_vars(ResultVars, VarSet),
 		io__write_string(")")
 	),
 	io__write_string(", "),
-	mercury_output_pragma_c_attributes(Attributes),
+	mercury_output_pragma_foreign_attributes(Attributes),
 	io__write_string(", "),
 	(
 		{ PragmaCode = ordinary(C_Code, _) },
-		mercury_output_c_code_string(C_Code)
+		mercury_output_foreign_code_string(C_Code)
 	;
 		{ PragmaCode = nondet(Fields, _, First, _,
 			Later, _, Treat, Shared, _) },
 		io__write_string("local_vars("),
-		mercury_output_c_code_string(Fields),
+		mercury_output_foreign_code_string(Fields),
 		io__write_string("), "),
 		io__write_string("first_code("),
-		mercury_output_c_code_string(First),
+		mercury_output_foreign_code_string(First),
 		io__write_string("), "),
 		io__write_string("retry_code("),
-		mercury_output_c_code_string(Later),
+		mercury_output_foreign_code_string(Later),
 		io__write_string("), "),
 		(
 			{ Treat = share },
@@ -2270,7 +2285,7 @@
 			{ Treat = automatic },
 			io__write_string("common_code(")
 		),
-		mercury_output_c_code_string(Shared),
+		mercury_output_foreign_code_string(Shared),
 		io__write_string(")")
 	;
 		{ PragmaCode = import(Name, _, _, _) },
@@ -2280,35 +2295,15 @@
 	),
 	io__write_string(").\n").
 
-:- pred mercury_output_c_ident_list(list(string), io__state, io__state).
-:- mode mercury_output_c_ident_list(in, di, uo) is det.
-
-mercury_output_c_ident_list([]) -->
-	io__write_string("[]").
-mercury_output_c_ident_list([First | Rest]) -->
-	io__write_string("["),
-	io__write_string(First),
-	mercury_output_c_ident_list_2(Rest),
-	io__write_string("]").
-
-:- pred mercury_output_c_ident_list_2(list(string), io__state, io__state).
-:- mode mercury_output_c_ident_list_2(in, di, uo) is det.
-
-mercury_output_c_ident_list_2([]) --> [].
-mercury_output_c_ident_list_2([First | Rest]) -->
-	io__write_string(", "),
-	io__write_string(First),
-	mercury_output_c_ident_list_2(Rest).
-
 %-----------------------------------------------------------------------------%
 
 	% Output the varnames of the pragma vars
-:- pred mercury_output_pragma_c_code_vars(list(pragma_var), prog_varset,
+:- pred mercury_output_pragma_foreign_code_vars(list(pragma_var), prog_varset,
 		io__state, io__state).
-:- mode mercury_output_pragma_c_code_vars(in, in, di, uo) is det.
+:- mode mercury_output_pragma_foreign_code_vars(in, in, di, uo) is det.
 
-mercury_output_pragma_c_code_vars([], _) --> [].
-mercury_output_pragma_c_code_vars([V|Vars], VarSet) -->
+mercury_output_pragma_foreign_code_vars([], _) --> [].
+mercury_output_pragma_foreign_code_vars([V|Vars], VarSet) -->
 	{ V = pragma_var(_Var, VarName, Mode) },
 	io__write_string(VarName),
 	io__write_string(" :: "),
@@ -2321,7 +2316,7 @@
 	;
 		io__write_string(", ")
 	),
-	mercury_output_pragma_c_code_vars(Vars, VarSet).
+	mercury_output_pragma_foreign_code_vars(Vars, VarSet).
 
 %-----------------------------------------------------------------------------%
 
@@ -2449,7 +2444,7 @@
 		io__write_string(")")
 	),
 	io__write_string(", "),
-	mercury_output_pragma_c_attributes(Attributes),
+	mercury_output_pragma_foreign_attributes(Attributes),
 	io__write_string(", "),
 	io__write_string(C_Function),
 	io__write_string(").\n").
@@ -2551,29 +2546,18 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred mercury_output_pragma_c_attributes(pragma_foreign_code_attributes,
-		io__state, io__state).
-:- mode mercury_output_pragma_c_attributes(in, di, uo) is det.
-
-mercury_output_pragma_c_attributes(Attributes) -->
+:- pred mercury_output_pragma_foreign_attributes(
+		pragma_foreign_code_attributes, io__state, io__state).
+:- mode mercury_output_pragma_foreign_attributes(in, di, uo) is det.
+
+mercury_output_pragma_foreign_attributes(Attributes) -->
+	% This is one case where it is a bad idea to use field
+	% accessors.  
+	{ attributes_to_strings(Attributes, AttrStrings) },
 	io__write_string("["),
-	{ may_call_mercury(Attributes, MayCallMercury) },
-	(
-		{ MayCallMercury = may_call_mercury },
-		io__write_string("may_call_mercury, ")
-	;
-		{ MayCallMercury = will_not_call_mercury },
-		io__write_string("will_not_call_mercury, ")
-	),
-	{ thread_safe(Attributes, ThreadSafe) },
-	(
-		{ ThreadSafe = not_thread_safe },
-		io__write_string("not_thread_safe")
-	;
-		{ ThreadSafe = thread_safe },
-		io__write_string("thread_safe")
-	),
+	io__write_list(AttrStrings, ", ", io__write_string),
 	io__write_string("]").
+
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.64
diff -u -r1.64 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/11/08 07:23:06	1.64
+++ compiler/ml_code_gen.m	2000/11/08 11:25:30
@@ -720,7 +720,8 @@
 
 :- import_module ml_type_gen, ml_call_gen, ml_unify_gen, ml_switch_gen.
 :- import_module ml_code_util.
-:- import_module arg_info, export, llds_out. % XXX needed for pragma C code
+:- import_module llds_out. % XXX needed for pragma C code
+:- import_module arg_info, export, foreign.
 :- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
 :- import_module goal_util, type_util, mode_util, builtin_ops.
 :- import_module passes_aux, modules.
@@ -746,14 +747,20 @@
 :- mode ml_gen_foreign_code(in, out, di, uo) is det.
 
 ml_gen_foreign_code(ModuleInfo, MLDS_ForeignCode) -->
-	{ module_info_get_foreign_header(ModuleInfo, C_Header_Info) },
-	{ module_info_get_foreign_body_code(ModuleInfo, C_Body_Info) },
-		% XXX This assumes the language is C.
-	{ ConvBody = (func(S - C) = user_foreign_code(c, S, C)) },
-	{ User_C_Code = list__map(ConvBody, C_Body_Info) },
+	{ module_info_get_foreign_decl(ModuleInfo, ForeignDecls) },
+	{ module_info_get_foreign_body_code(ModuleInfo, ForeignBodys) },
+	globals__io_lookup_foreign_language_option(use_foreign_language,
+		UseForeignLanguage),
+	{ foreign__filter_decls(UseForeignLanguage, ForeignDecls,
+		WantedForeignDecls, _OtherForeignDecls) },
+	{ foreign__filter_bodys(UseForeignLanguage, ForeignBodys,
+		WantedForeignBodys, _OtherForeignBodys) },
+	{ ConvBody = (func(foreign_body_code(L, S, C)) = 
+		user_foreign_code(L, S, C)) },
+	{ MLDSWantedForeignBodys = list__map(ConvBody, WantedForeignBodys) },
 	{ ml_gen_pragma_export(ModuleInfo, MLDS_PragmaExports) },
-	{ MLDS_ForeignCode = mlds__foreign_code(C_Header_Info, User_C_Code,
-			MLDS_PragmaExports) }.
+	{ MLDS_ForeignCode = mlds__foreign_code(WantedForeignDecls,
+			MLDSWantedForeignBodys, MLDS_PragmaExports) }.
 
 :- pred ml_gen_imports(module_info, mlds__imports).
 :- mode ml_gen_imports(in, out) is det.
@@ -1779,7 +1786,7 @@
 	ml_gen_unification(Unification, CodeModel, Context,
 		MLDS_Decls, MLDS_Statements).
 
-ml_gen_goal_expr(pragma_foreign_code(_Lang, Attributes,
+ml_gen_goal_expr(pragma_foreign_code(Attributes,
                 PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
 		CodeModel, OuterContext, MLDS_Decls, MLDS_Statements) -->
         (
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.39
diff -u -r1.39 mlds.m
--- compiler/mlds.m	2000/11/08 07:23:08	1.39
+++ compiler/mlds.m	2000/11/08 08:59:23
@@ -620,7 +620,7 @@
 	%
 :- type mlds__foreign_code
 	---> mlds__foreign_code(
-		foreign_header_info,
+		foreign_decl_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.65
diff -u -r1.65 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/11/08 07:23:08	1.65
+++ compiler/mlds_to_c.m	2000/11/10 06:51:02
@@ -45,7 +45,7 @@
 :- import_module export.	% for export__type_to_type_string
 :- import_module globals, options, passes_aux.
 :- import_module builtin_ops, c_util, modules.
-:- import_module prog_data, prog_out, type_util.
+:- import_module prog_data, prog_out, type_util, error_util.
 
 :- import_module bool, int, string, library, list.
 :- import_module assoc_list, term, std_util, require.
@@ -448,12 +448,17 @@
 			mlds_output_pragma_export_decl(ModuleName, Indent)).
 
 :- pred mlds_output_c_hdr_decl(indent,
-	foreign_header_code, io__state, io__state).
+	foreign_decl_code, io__state, io__state).
 :- mode mlds_output_c_hdr_decl(in, in, di, uo) is det.
 
-mlds_output_c_hdr_decl(_Indent, Code - Context) -->
-	mlds_output_context(mlds__make_context(Context)),
-	io__write_string(Code).
+mlds_output_c_hdr_decl(_Indent, foreign_decl_code(Lang, Code, Context)) -->
+		% only output C code in the C header file.
+	( { Lang = c } ->
+		mlds_output_context(mlds__make_context(Context)),
+		io__write_string(Code)
+	;
+		{ sorry(this_file, "foreign code other than C") }
+	).
 
 :- pred mlds_output_c_decls(indent, mlds__foreign_code,
 	io__state, io__state).
@@ -482,6 +487,8 @@
 mlds_output_c_defn(_Indent, user_foreign_code(c, Code, Context)) -->
 	mlds_output_context(mlds__make_context(Context)),
 	io__write_string(Code).
+mlds_output_c_defn(_Indent, user_foreign_code(managedcplusplus, _, _)) -->
+	{ sorry(this_file, "foreign code other than C") }.
 
 :- pred mlds_output_pragma_export_decl(mlds_module_name, indent,
 		mlds__pragma_export, io__state, io__state).
@@ -2934,5 +2941,8 @@
 		io__write_string("  "),
 		mlds_indent(N - 1)
 	).
+
+:- func this_file = string.
+this_file = "mlds_to_c.m".
 
 %-----------------------------------------------------------------------------%
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.3
diff -u -r1.3 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m	2000/11/09 07:47:04	1.3
+++ compiler/mlds_to_ilasm.m	2000/11/10 07:15:00
@@ -201,7 +201,7 @@
 		ForeignCode),
 
 	io__write_strings([
-		"__gc public class ", ModuleNameStr, "__c_code\n",
+		"\n__gc public class ", ModuleNameStr, "__c_code\n",
 		"{\n",
 		"public:\n"]),
 
@@ -237,10 +237,15 @@
 			_ExportDefns)) -->
 	{ BodyCode = list__reverse(RevBodyCode) },
 	io__write_list(BodyCode, "\n", 
-		(pred(llds__user_foreign_code(c, Code, _Context)::in,
+		(pred(llds__user_foreign_code(Lang, Code, _Context)::in,
 				di, uo) is det -->
-			io__write_string(Code))
-			).
+			( { Lang = managedcplusplus } ->
+				io__write_string(Code)
+			;
+				{ sorry(this_file, 
+					"foreign code other than MC++") }
+			)					
+	)).
 
 	% XXX we don't handle export decls.
 :- pred generate_foreign_header_code(mlds_module_name, mlds__foreign_code,
@@ -251,10 +256,15 @@
 			_ExportDefns)) -->
 	{ HeaderCode = list__reverse(RevHeaderCode) },
 	io__write_list(HeaderCode, "\n", 
-		(pred(Code - _Context::in, di, uo) is det -->
-			io__write_string(Code))
-			).
-
+		(pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
+			di, uo) is det -->
+			( { Lang = managedcplusplus } ->
+				io__write_string(Code)
+			;
+				{ sorry(this_file, 
+					"foreign code other than MC++") }
+			)					
+	)).
 
 :- pred generate_method_c_code(mlds_module_name, mlds__defn,
 		io__state, io__state).
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.133
diff -u -r1.133 mode_util.m
--- compiler/mode_util.m	2000/10/24 05:58:44	1.133
+++ compiler/mode_util.m	2000/10/30 12:41:11
@@ -1393,8 +1393,8 @@
 	).
 
 recompute_instmap_delta_2(_, 
-		pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H), _,
-		pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H), 
+		pragma_foreign_code(A, PredId, ProcId, Args, E, F, G), _,
+		pragma_foreign_code(A, PredId, ProcId, Args, E, F, G), 
 		VarTypes, InstMap, InstMapDelta) -->
 	recompute_instmap_delta_call(PredId, ProcId,
 		Args, VarTypes, InstMap, InstMapDelta).
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.249
diff -u -r1.249 modes.m
--- compiler/modes.m	2000/10/14 13:41:26	1.249
+++ compiler/modes.m	2000/10/22 11:54:41
@@ -1231,7 +1231,7 @@
 
 	% to modecheck a pragma_c_code, we just modecheck the proc for 
 	% which it is the goal.
-modecheck_goal_expr(pragma_foreign_code(Language, Attributes, PredId, ProcId0,
+modecheck_goal_expr(pragma_foreign_code(Attributes, PredId, ProcId0,
 		Args0, ArgNameMap, OrigArgTypes, PragmaCode),
 		GoalInfo, Goal) -->
 	mode_checkpoint(enter, "pragma_foreign_code"),
@@ -1245,7 +1245,7 @@
 	modecheck_call_pred(PredId, ProcId0, Args0, DeterminismKnown,
 				ProcId, Args, ExtraGoals),
 
-	{ Pragma = pragma_foreign_code(Language, Attributes, PredId, ProcId,
+	{ Pragma = pragma_foreign_code(Attributes, PredId, ProcId,
 			Args0, ArgNameMap, OrigArgTypes, PragmaCode) },
 	handle_extra_goals(Pragma, ExtraGoals, GoalInfo, Args0, Args,
 			InstMap0, Goal),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.61
diff -u -r1.61 module_qual.m
--- compiler/module_qual.m	2000/11/01 05:12:04	1.61
+++ compiler/module_qual.m	2000/11/01 07:59:43
@@ -887,11 +887,11 @@
 		mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
 
 qualify_pragma(source_file(File), source_file(File), Info, Info) --> [].
-qualify_pragma(c_header_code(Code), c_header_code(Code), Info, Info) --> [].
+qualify_pragma(foreign_decl(L, Code), foreign_decl(L, Code), Info, Info) --> [].
 qualify_pragma(foreign(L, C), foreign(L, C), Info, Info) --> [].
 qualify_pragma(
-	    foreign(Lang, Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
-	    foreign(Lang, Rec, SymName, PredOrFunc, PragmaVars, Varset, Code), 
+	    foreign(Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
+	    foreign(Rec, SymName, PredOrFunc, PragmaVars, Varset, Code), 
 		Info0, Info) -->
 	qualify_pragma_vars(PragmaVars0, PragmaVars, Info0, Info).
 qualify_pragma(tabled(A, B, C, D, MModes0), tabled(A, B, C, D, MModes), 
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.136
diff -u -r1.136 modules.m
--- compiler/modules.m	2000/11/01 05:12:05	1.136
+++ compiler/modules.m	2000/11/01 07:59:43
@@ -1001,9 +1001,9 @@
 % but if we do allow it, we should put it in the generated
 % header file, which currently we don't.
 
-pragma_allowed_in_interface(c_header_code(_), no).
+pragma_allowed_in_interface(foreign_decl(_, _), no).
 pragma_allowed_in_interface(foreign(_, _), no).
-pragma_allowed_in_interface(foreign(_, _, _, _, _, _, _), no).
+pragma_allowed_in_interface(foreign(_, _, _, _, _, _), no).
 pragma_allowed_in_interface(inline(_, _), no).
 pragma_allowed_in_interface(no_inline(_, _), no).
 pragma_allowed_in_interface(obsolete(_, _), yes).
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.299
diff -u -r1.299 options.m
--- compiler/options.m	2000/11/08 08:20:45	1.299
+++ compiler/options.m	2000/11/08 08:59:24
@@ -177,9 +177,19 @@
 		;       unboxed_no_tag_types
 		;	sync_term_size % in words
 		;	type_layout
+	% Foreign language interface options
+				% The foreign language that the user has
+				% selected for use in this module
+				% (defaults to the value of backend
+				% foreign target).
+		;	use_foreign_language
 	% Options for internal use only
 	% (the values of these options are implied by the
 	% settings of other options)
+				% The language that this backend can
+				% interface to most easily (probably the
+				% target language of the backend).
+		; 	backend_foreign_language 
 				% Stack layout information required to do
 				% a stack trace.
 		;       basic_stack_layout
@@ -566,6 +576,11 @@
 					% of writing) - will usually be over-
 					% ridden by a value from configure.
 	type_layout		-	bool(yes),
+	use_foreign_language	-	string(""),
+	backend_foreign_language-	string(""),
+					% The previous two options
+					% depend on the target and are
+					% set in handle_options.
 	basic_stack_layout	-	bool(no),
 	agc_stack_layout	-	bool(no),
 	procid_stack_layout	-	bool(no),
@@ -948,6 +963,7 @@
 long_option("bytes-per-word",		bytes_per_word).
 long_option("conf-low-tag-bits",	conf_low_tag_bits).
 long_option("type-layout",		type_layout).
+long_option("use-foreign-language",	use_foreign_language).
 long_option("agc-stack-layout",		agc_stack_layout).
 long_option("basic-stack-layout",	basic_stack_layout).
 long_option("procid-stack-layout",	procid_stack_layout).
@@ -1972,6 +1988,15 @@
 
 		% The --bytes-per-word option is intended for use
 		% by the `mmc' script; it is deliberately not documented.
+		%
+		"--use-foreign-language <foreign language>",
+		"\tUse the given foreign language to implement predicates",
+		"\twritten in foreign languages.  Any name that can be used",
+		"\tto specify foreign languages in pragma foreign declarations",
+		"\tis valid, but not all foreign languages are implemented",
+		"\tin all backends.",
+		"\tDefault value is C for the LLDS and MLDS->C backends,",
+		"\tor ManagedC++ for the .NET backend.",
 
 		"--no-type-layout",
 		"(This option is not for general use.)",
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.9
diff -u -r1.9 pd_cost.m
--- compiler/pd_cost.m	2000/10/06 10:18:31	1.9
+++ compiler/pd_cost.m	2000/10/16 01:17:34
@@ -91,7 +91,7 @@
 	goal_info_get_nonlocals(GoalInfo, NonLocals),
 	pd_cost__unify(NonLocals, Unification, Cost).
 
-pd_cost__goal(pragma_foreign_code(_, Attributes, _, _, Args, _, _, _) - _,
+pd_cost__goal(pragma_foreign_code(Attributes, _, _, Args, _, _, _) - _,
 		Cost) :-
 	( may_call_mercury(Attributes, will_not_call_mercury) ->
 		Cost1 = 0
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.203
diff -u -r1.203 polymorphism.m
--- compiler/polymorphism.m	2000/11/06 04:09:02	1.203
+++ compiler/polymorphism.m	2000/11/07 11:34:57
@@ -952,7 +952,7 @@
 	{ conj_list_to_goal(GoalList, GoalInfo, Goal) }.
 
 polymorphism__process_goal_expr(Goal0, GoalInfo, Goal) -->
-	{ Goal0 = pragma_foreign_code(Lang, IsRecursive, PredId, ProcId,
+	{ Goal0 = pragma_foreign_code(Attributes, PredId, ProcId,
 		ArgVars0, ArgInfo0, OrigArgTypes0, PragmaCode0) },
 	polymorphism__process_call(PredId, ArgVars0, GoalInfo,
 		ArgVars, ExtraVars, CallGoalInfo, ExtraGoals),
@@ -1004,7 +1004,7 @@
 		%
 		% plug it all back together
 		%
-		{ Call = pragma_foreign_code(Lang, IsRecursive, PredId, 
+		{ Call = pragma_foreign_code(Attributes, PredId, 
 			ProcId, ArgVars, ArgInfo, OrigArgTypes, PragmaCode) - 
 			CallGoalInfo },
 		{ list__append(ExtraGoals, [Call], GoalList) },
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.61
diff -u -r1.61 prog_data.m
--- compiler/prog_data.m	2000/11/01 05:12:10	1.61
+++ compiler/prog_data.m	2000/11/10 06:20:33
@@ -104,12 +104,11 @@
 	--->	type_only(type)
 	;	type_and_mode(type, mode).
 
-	% We only support C right now.
 :- type foreign_language
 	--->	c
 % 	;	cplusplus
 % 	;	csharp
-% 	;	managedcplusplus
+ 	;	managedcplusplus
 % 	;	java
 % 	;	il
 	.
@@ -144,18 +143,21 @@
 %
 
 :- type pragma_type 
-	--->	c_header_code(string)
+			% a foreign language declaration, such as C
+			% header code.
+	--->	foreign_decl(foreign_language, string)
 
 	;	foreign(foreign_language, string)
 
-	;	foreign(foreign_language, pragma_foreign_code_attributes,
+	;	foreign(pragma_foreign_code_attributes,
 			sym_name, pred_or_func, list(pragma_var),
 			prog_varset, pragma_foreign_code_impl)
-			% Set of C code attributes, eg.:
+			% Set of foreign code attributes, eg.:
+			%	what language this code is in
 			%	whether or not the code may call Mercury,
 			%	whether or not the code is thread-safe
 			% PredName, Predicate or Function, Vars/Mode, 
-			% VarNames, C Code Implementation Info
+			% VarNames, Foreign Code Implementation Info
 	
 	;	type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
 			maybe(list(mode)), type_subst, tvarset)
@@ -518,8 +520,8 @@
 		% `pragma_c_code_attribute's.
 :- type pragma_foreign_code_attributes.
 
-:- pred default_attributes(pragma_foreign_code_attributes).
-:- mode default_attributes(out) is det.
+:- pred default_attributes(foreign_language, pragma_foreign_code_attributes).
+:- mode default_attributes(in, out) is det.
 
 :- pred may_call_mercury(pragma_foreign_code_attributes, may_call_mercury).
 :- mode may_call_mercury(in, out) is det.
@@ -535,6 +537,13 @@
 		pragma_foreign_code_attributes).
 :- mode set_thread_safe(in, in, out) is det.
 
+:- pred foreign_language(pragma_foreign_code_attributes, foreign_language).
+:- mode foreign_language(in, out) is det.
+
+:- pred set_foreign_language(pragma_foreign_code_attributes, foreign_language,
+		pragma_foreign_code_attributes).
+:- mode set_foreign_language(in, in, out) is det.
+
 :- pred tabled_for_io(pragma_foreign_code_attributes, tabled_for_io).
 :- mode tabled_for_io(in, out) is det.
 
@@ -928,6 +937,11 @@
 	--->	must_be_qualified
 	;	may_be_unqualified.
 
+	% Convert the attributes to their source code representations.
+	% Useful if you need to write a pragma out to a file.
+:- pred attributes_to_strings(pragma_foreign_code_attributes::in,
+		list(string)::out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -935,22 +949,23 @@
 
 :- type pragma_foreign_code_attributes
 	--->	attributes(
+			foreign_language 	:: foreign_language,
 			may_call_mercury	:: may_call_mercury,
 			thread_safe		:: thread_safe,
 			tabled_for_io		:: tabled_for_io
 		).
+
+default_attributes(Language, 
+	attributes(Language, may_call_mercury, not_thread_safe, 
+		not_tabled_for_io)).
 
-default_attributes(attributes(may_call_mercury, not_thread_safe,
-	not_tabled_for_io)).
+may_call_mercury(Attrs, Attrs ^ may_call_mercury).
 
-may_call_mercury(Attrs, MayCallMercury) :-
-	MayCallMercury = Attrs ^ may_call_mercury.
+thread_safe(Attrs, Attrs ^ thread_safe).
 
-thread_safe(Attrs, ThreadSafe) :-
-	ThreadSafe = Attrs ^ thread_safe.
+foreign_language(Attrs, Attrs ^ foreign_language).
 
-tabled_for_io(Attrs, TabledForIo) :-
-	TabledForIo = Attrs ^ tabled_for_io.
+tabled_for_io(Attrs, Attrs ^ tabled_for_io).
 
 set_may_call_mercury(Attrs0, MayCallMercury, Attrs) :-
 	Attrs = Attrs0 ^ may_call_mercury := MayCallMercury.
@@ -958,7 +973,35 @@
 set_thread_safe(Attrs0, ThreadSafe, Attrs) :-
 	Attrs = Attrs0 ^ thread_safe := ThreadSafe.
 
+set_foreign_language(Attrs0, ForeignLanguage, Attrs) :-
+	Attrs = Attrs0 ^ foreign_language := ForeignLanguage.
+
 set_tabled_for_io(Attrs0, TabledForIo, Attrs) :-
 	Attrs = Attrs0 ^ tabled_for_io := TabledForIo.
+
+attributes_to_strings(Attrs, StringList) :-
+	Attrs = attributes(_Lang, MayCallMercury, ThreadSafe, TabledForIO),
+	(
+		MayCallMercury = may_call_mercury,
+		MayCallMercuryStr = "may_call_mercury"
+	;
+		MayCallMercury = will_not_call_mercury,
+		MayCallMercuryStr = "will_not_call_mercury"
+	),
+	(
+		ThreadSafe = not_thread_safe,
+		ThreadSafeStr = "not_thread_safe"
+	;
+		ThreadSafe = thread_safe,
+		ThreadSafeStr = "thread_safe"
+	),
+	(
+		TabledForIO = tabled_for_io,
+		TabledForIOStr = "tabled_for_io"
+	;
+		TabledForIO = not_tabled_for_io,
+		TabledForIOStr = "not_tabled_for_io"
+	),
+	StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr].
 
 %-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.24
diff -u -r1.24 prog_io_pragma.m
--- compiler/prog_io_pragma.m	2000/10/27 03:12:32	1.24
+++ compiler/prog_io_pragma.m	2000/11/10 07:10:12
@@ -22,7 +22,7 @@
 
 :- implementation.
 
-:- import_module prog_io, prog_io_goal, prog_util.
+:- import_module globals, prog_io, prog_io_goal, prog_util.
 :- import_module term_util, term_errors.
 :- import_module int, map, string, std_util, bool, require.
 
@@ -70,23 +70,23 @@
 			ErrorTerm)
 	).
 
-parse_pragma_type(_, "c_header_code", PragmaTerms,
-			ErrorTerm, _VarSet, Result) :-
-    	(
-       	    PragmaTerms = [HeaderTerm]
-        ->
-	    (
-    	        HeaderTerm = term__functor(term__string(HeaderCode), [], _)
-	    ->
-	        Result = ok(pragma(c_header_code(HeaderCode)))
-	    ;
-		Result = error("expected string for C header code", HeaderTerm)
-	    )
+parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms,
+			ErrorTerm, VarSet, Result) :-
+	parse_pragma_foreign_decl_pragma(ModuleName, "foreign_decl",
+		PragmaTerms, ErrorTerm, VarSet, Result).
+		
+parse_pragma_type(ModuleName, "c_header_code", PragmaTerms,
+			ErrorTerm, VarSet, Result) :-
+	(
+	    PragmaTerms = [term__functor(_, _, Context) | _]
+	->
+	    LangC = term__functor(term__string("C"), [], Context),
+	    parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code",
+		[LangC | PragmaTerms], ErrorTerm, VarSet, Result)
 	;
-	    Result = error(
-"wrong number of arguments in `:- pragma c_header_code' declaration", 
-			    ErrorTerm)
-        ).
+	    Result = error("wrong number of arguments or unexpected variable in `:- pragma c_header_code' declaration", 
+		    ErrorTerm)
+	).
 
 parse_pragma_type(ModuleName, "foreign_code", PragmaTerms,
 			ErrorTerm, VarSet, Result) :-
@@ -111,17 +111,47 @@
 		    ErrorTerm)
 	).
 
-
-	% XXX this should use the same language specification
-	% strings as globals__convert_target.
 :- pred parse_foreign_language(term, foreign_language).
 :- mode parse_foreign_language(in, out) is semidet.
 
-parse_foreign_language(term__functor(term__string("C"), _, _), c).
-parse_foreign_language(term__functor(term__string("c"), _, _), c).
-%parse_foreign_language(term__functor(term__string("C++"), _, _), cplusplus).
-%parse_foreign_language(term__functor(term__string("c++"), _, _), cplusplus).
+parse_foreign_language(term__functor(term__string(String), _, _), Lang) :-
+	globals__convert_foreign_language(String, Lang).
 
+	% This predicate parses both c_code and foreign_code pragmas.
+:- pred parse_pragma_foreign_decl_pragma(module_name, string,
+		list(term), term, varset, maybe1(item)).
+:- mode parse_pragma_foreign_decl_pragma(in, in, in, in, in, out) is det.
+parse_pragma_foreign_decl_pragma(_ModuleName, Pragma, PragmaTerms,
+			ErrorTerm, _VarSet, Result) :-
+	string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+		InvalidDeclStr),
+	( 
+		PragmaTerms = [Lang, HeaderTerm]
+	->
+		( 
+			parse_foreign_language(Lang, ForeignLanguage)
+		->
+			(
+				HeaderTerm = term__functor(term__string(
+					HeaderCode), [], _)
+			->
+				Result = ok(pragma(foreign_decl(
+					ForeignLanguage, HeaderCode)))
+			;
+				ErrMsg = "-- expected string for foreign declaration code",
+				Result = error(string__append(InvalidDeclStr,
+					ErrMsg), HeaderTerm)
+			)
+		;
+			ErrMsg = "-- invalid language parameter",
+			Result = error(string__append(InvalidDeclStr, ErrMsg), 
+				Lang)
+		)
+	;
+	    string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+		ErrorStr),
+	    Result = error(ErrorStr, ErrorTerm)
+        ).
 
 	% This predicate parses both c_code and foreign_code pragmas.
 :- pred parse_pragma_foreign_code_pragma(module_name, string,
@@ -136,7 +166,8 @@
 	Check6 = (func(PTerms6, ForeignLanguage) = Res is semidet :- 
             PTerms6 = [PredAndVarsTerm, FlagsTerm,
 		    FieldsTerm, FirstTerm, LaterTerm, SharedTerm],
-	    ( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
+	    ( parse_pragma_foreign_code_attributes_term(
+	    		ForeignLanguage, FlagsTerm, Flags) ->
 	        ( parse_pragma_keyword("local_vars", FieldsTerm, Fields,
 			FieldsContext) ->
 	            ( parse_pragma_keyword("first_code", FirstTerm, First,
@@ -146,7 +177,7 @@
 	                    ( parse_pragma_keyword("shared_code", SharedTerm,
 			    		Shared, SharedContext) ->
 	        	        parse_pragma_foreign_code(ModuleName,
-				    ForeignLanguage, Flags, PredAndVarsTerm,
+				    Flags, PredAndVarsTerm,
 				    nondet(Fields, yes(FieldsContext),
 				    	First, yes(FirstContext),
 					Later, yes(LaterContext),
@@ -155,7 +186,7 @@
 		            ; parse_pragma_keyword("duplicated_code",
 			    		SharedTerm, Shared, SharedContext) ->
 	        	        parse_pragma_foreign_code(ModuleName,
-				    ForeignLanguage, Flags, PredAndVarsTerm,
+				    Flags, PredAndVarsTerm,
 				    nondet(Fields, yes(FieldsContext),
 				    	First, yes(FirstContext),
 					Later, yes(LaterContext),
@@ -164,7 +195,7 @@
 		            ; parse_pragma_keyword("common_code", SharedTerm,
 			    		Shared, SharedContext) ->
 	        	        parse_pragma_foreign_code(ModuleName, 
-				    ForeignLanguage, Flags, PredAndVarsTerm,
+				    Flags, PredAndVarsTerm,
 				    nondet(Fields, yes(FieldsContext),
 				    	First, yes(FirstContext),
 					Later, yes(LaterContext),
@@ -212,16 +243,18 @@
 	    (
 		CodeTerm = term__functor(term__string(Code), [], Context)
 	    ->
-		( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
-	            parse_pragma_foreign_code(ModuleName, ForeignLanguage,
-		    	Flags, PredAndVarsTerm,
-			ordinary(Code, yes(Context)), VarSet, Res)
-	        ; parse_pragma_c_code_attributes_term(PredAndVarsTerm, Flags) ->
+		( parse_pragma_foreign_code_attributes_term(ForeignLanguage, 
+			FlagsTerm, Flags) ->
+		    parse_pragma_foreign_code(ModuleName, Flags,
+			PredAndVarsTerm, ordinary(Code, yes(Context)),
+			VarSet, Res)
+	        ; parse_pragma_foreign_code_attributes_term(ForeignLanguage,
+			PredAndVarsTerm, Flags) ->
 		    % XXX we should issue a warning; this syntax is deprecated
 		    % We will continue to accept this if c_code is used, but
 		    % not with foreign_code
 		    ( Pragma = "c_code" ->
-	                parse_pragma_foreign_code(ModuleName, ForeignLanguage, 
+	                parse_pragma_foreign_code(ModuleName,
 			    Flags, FlagsTerm, ordinary(Code, yes(Context)),
 			    VarSet, Res)
 		    ;
@@ -251,14 +284,13 @@
 			Pragma = "c_code"
 		->
 			% may_call_mercury is a conservative default.
-			default_attributes(Attributes),
+			default_attributes(ForeignLanguage, Attributes),
 			(
 			    CodeTerm = term__functor(term__string(Code), [],
 				Context)
 			->
 			    parse_pragma_foreign_code(ModuleName, 
-			        ForeignLanguage, Attributes,
-			    	PredAndVarsTerm, ordinary(Code,
+			        Attributes, PredAndVarsTerm, ordinary(Code,
 				yes(Context)), VarSet, Res)
 			;
 			    ErrMsg = "-- expecting either `may_call_mercury' or `will_not_call_mercury', and a string for C code",
@@ -340,12 +372,16 @@
 	).
 
 
+
+
 parse_pragma_type(ModuleName, "import", PragmaTerms,
 			ErrorTerm, _VarSet, Result) :-
 	(
 	    (
 		PragmaTerms = [PredAndModesTerm, FlagsTerm, C_FunctionTerm],
-		( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
+			% XXX we assume all imports are C
+		( parse_pragma_foreign_code_attributes_term(c,
+				FlagsTerm, Flags) ->
 			FlagsResult = ok(Flags)
 		;
 			FlagsResult = error("invalid second argument in `:- pragma import/3' declaration -- expecting C code attribute or list of attributes'",
@@ -353,7 +389,7 @@
 	        )
 	    ;
 		PragmaTerms = [PredAndModesTerm, C_FunctionTerm],
-		default_attributes(Flags),
+		default_attributes(c, Flags),
 		FlagsResult = ok(Flags)
 	    )	
  	-> 
@@ -817,18 +853,18 @@
 
 %-----------------------------------------------------------------------------%
 
-:- type collected_pragma_c_code_attribute
+:- type collected_pragma_foreign_code_attribute
 	--->	may_call_mercury(may_call_mercury)
 	;	thread_safe(thread_safe)
 	;	tabled_for_io(tabled_for_io).
 
-:- pred parse_pragma_c_code_attributes_term(term, 
+:- pred parse_pragma_foreign_code_attributes_term(foreign_language, term, 
 		pragma_foreign_code_attributes).
-:- mode parse_pragma_c_code_attributes_term(in, out) is semidet.
+:- mode parse_pragma_foreign_code_attributes_term(in, in, out) is semidet.
 
-parse_pragma_c_code_attributes_term(Term, Attributes) :-
-	default_attributes(Attributes0),
-	parse_pragma_c_code_attributes_term0(Term, AttrList),
+parse_pragma_foreign_code_attributes_term(ForeignLanguage, Term, Attributes) :-
+	default_attributes(ForeignLanguage, Attributes0),
+	parse_pragma_foreign_code_attributes_term0(Term, AttrList),
 	( list__member(may_call_mercury(will_not_call_mercury), AttrList) ->
 		( list__member(may_call_mercury(may_call_mercury), AttrList) ->
 			% XXX an error message would be nice
@@ -862,13 +898,13 @@
 		Attributes = Attributes2
 	).
 
-:- pred parse_pragma_c_code_attributes_term0(term,
-		list(collected_pragma_c_code_attribute)).
-:- mode parse_pragma_c_code_attributes_term0(in, out) is semidet.
+:- pred parse_pragma_foreign_code_attributes_term0(term,
+		list(collected_pragma_foreign_code_attribute)).
+:- mode parse_pragma_foreign_code_attributes_term0(in, out) is semidet.
 
-parse_pragma_c_code_attributes_term0(Term, Flags) :-
+parse_pragma_foreign_code_attributes_term0(Term, Flags) :-
 	(
-		parse_single_pragma_c_code_attribute(Term, Flag)
+		parse_single_pragma_foreign_code_attribute(Term, Flag)
 	->
 		Flags = [Flag]
 	;
@@ -878,16 +914,16 @@
 		;
 			Term = term__functor(term__atom("."), [Hd, Tl], _),
 			Flags = [Flag|Flags0],
-			parse_single_pragma_c_code_attribute(Hd, Flag),
-			parse_pragma_c_code_attributes_term0(Tl, Flags0)
+			parse_single_pragma_foreign_code_attribute(Hd, Flag),
+			parse_pragma_foreign_code_attributes_term0(Tl, Flags0)
 		)
 	).
 
-:- pred parse_single_pragma_c_code_attribute(term,
-		collected_pragma_c_code_attribute).
-:- mode parse_single_pragma_c_code_attribute(in, out) is semidet.
+:- pred parse_single_pragma_foreign_code_attribute(term,
+		collected_pragma_foreign_code_attribute).
+:- mode parse_single_pragma_foreign_code_attribute(in, out) is semidet.
 
-parse_single_pragma_c_code_attribute(Term, Flag) :-
+parse_single_pragma_foreign_code_attribute(Term, Flag) :-
 	( parse_may_call_mercury(Term, MayCallMercury) ->
 		Flag = may_call_mercury(MayCallMercury)
 	; parse_threadsafe(Term, ThreadSafe) ->
@@ -926,14 +962,13 @@
 parse_tabled_for_io(term__functor(term__atom("not_tabled_for_io"), [], _),
 	not_tabled_for_io).
 
-% parse a pragma c_code declaration
+% parse a pragma foreign_code declaration
 
-:- pred parse_pragma_foreign_code(module_name, foreign_language,
-	pragma_foreign_code_attributes, term, pragma_foreign_code_impl,
-	varset, maybe1(item)).
-:- mode parse_pragma_foreign_code(in, in, in, in, in, in, out) is det.
+:- pred parse_pragma_foreign_code(module_name, pragma_foreign_code_attributes,
+	term, pragma_foreign_code_impl, varset, maybe1(item)).
+:- mode parse_pragma_foreign_code(in, in, in, in, in, out) is det.
 
-parse_pragma_foreign_code(ModuleName, ForeignLanguage, Flags, PredAndVarsTerm0,
+parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm0,
 	PragmaImpl, VarSet0, Result) :-
     parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0,
     	PredAndVarsTerm0, "`:- pragma c_code' declaration", PredAndArgsResult),
@@ -955,7 +990,7 @@
 	(
 	    Error = no,
 	    varset__coerce(VarSet0, VarSet),
-	    Result = ok(pragma(foreign(ForeignLanguage, Flags, PredName,
+	    Result = ok(pragma(foreign(Flags, PredName,
 		    PredOrFunc, PragmaVars, VarSet, PragmaImpl)))
 	;
 	    Error = yes(ErrorMessage),
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.3
diff -u -r1.3 prog_rep.m
--- compiler/prog_rep.m	2000/10/13 13:55:55	1.3
+++ compiler/prog_rep.m	2000/10/22 11:54:44
@@ -202,7 +202,7 @@
 		DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
 	Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
 		ChangedVarsRep, AtomicGoalRep).
-prog_rep__represent_goal_expr(pragma_foreign_code(_, _,
+prog_rep__represent_goal_expr(pragma_foreign_code(_,
 		_PredId, _, Args, _, _, _),
 		GoalInfo, InstMap0, Info, Rep) :-
 	list__map(term__var_to_int, Args, ArgsRep),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.27
diff -u -r1.27 purity.m
--- compiler/purity.m	2000/08/09 07:47:43	1.27
+++ compiler/purity.m	2000/10/16 01:16:02
@@ -664,7 +664,7 @@
 	{ worst_purity(Purity12, Purity3, Purity) }.
 compute_expr_purity(Ccode, Ccode, _, PredInfo, PredInfo, ModuleInfo, _, Purity,
 		NumErrors, NumErrors) -->
-	{ Ccode = pragma_foreign_code(_,_,PredId,_,_,_,_,_) },
+	{ Ccode = pragma_foreign_code(_,PredId,_,_,_,_,_) },
 	{ module_info_preds(ModuleInfo, Preds) },
 	{ map__lookup(Preds, PredId, CalledPredInfo) },
 	{ pred_info_get_purity(CalledPredInfo, Purity) }.
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.76
diff -u -r1.76 quantification.m
--- compiler/quantification.m	2000/09/07 01:46:49	1.76
+++ compiler/quantification.m	2000/10/16 01:35:24
@@ -461,8 +461,8 @@
 	{ set__union(NonLocalVars1, NonLocalVars2, NonLocalVars) },
 	quantification__set_nonlocals(NonLocalVars).
 
-implicitly_quantify_goal_2(pragma_foreign_code(A,B,C,D,Vars,E,F,G), _,
-		pragma_foreign_code(A,B,C,D,Vars,E,F,G)) --> 
+implicitly_quantify_goal_2(pragma_foreign_code(A,B,C,Vars,E,F,G), _,
+		pragma_foreign_code(A,B,C,Vars,E,F,G)) --> 
 	implicitly_quantify_atomic_goal(Vars).
 
 implicitly_quantify_goal_2(bi_implication(LHS0, RHS0), Context, Goal) -->
@@ -965,7 +965,7 @@
 	set__union(Set5, Set6, Set),
 	set__union(LambdaSet5, LambdaSet6, LambdaSet).
 
-quantification__goal_vars_2(_, pragma_foreign_code(_,_,_,_, ArgVars, _, _, _),
+quantification__goal_vars_2(_, pragma_foreign_code(_,_,_, ArgVars, _, _, _),
 		Set0, LambdaSet, Set, LambdaSet) :-
 	set__insert_list(Set0, ArgVars, Set).
 
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.17
diff -u -r1.17 rl_exprn.m
--- compiler/rl_exprn.m	2000/10/06 10:18:33	1.17
+++ compiler/rl_exprn.m	2000/10/16 01:13:56
@@ -853,7 +853,7 @@
 	{ Code = tree(SwitchCode, node([rl_PROC_label(EndSwitch)])) }.
 rl_exprn__goal(generic_call(_, _, _, _) - _, _, _) -->
 	{ error("rl_exprn__goal: higher-order and class-method calls not yet implemented") }.
-rl_exprn__goal(pragma_foreign_code(_, _, _, _, _, _, _, _) - _, _, _) -->
+rl_exprn__goal(pragma_foreign_code(_, _, _, _, _, _, _) - _, _, _) -->
 	{ error("rl_exprn__goal: pragma_c_code not yet implemented") }.
 rl_exprn__goal(some(_, _, Goal) - _, Fail, Code) -->
 	rl_exprn__goal(Goal, Fail, Code).
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.28
diff -u -r1.28 saved_vars.m
--- compiler/saved_vars.m	2000/10/13 13:55:55	1.28
+++ compiler/saved_vars.m	2000/10/22 11:54:46
@@ -133,7 +133,7 @@
 		Goal = GoalExpr0 - GoalInfo0,
 		SlotInfo = SlotInfo0
 	;
-		GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
+		GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _),
 		Goal = GoalExpr0 - GoalInfo0,
 		SlotInfo = SlotInfo0
 	;
@@ -292,7 +292,7 @@
 				IsNonLocal, SlotInfo1, Goals1, SlotInfo),
 			Goals = [NewConstruct, Goal1 | Goals1]
 		;
-			Goal0Expr = pragma_foreign_code(_, _, _, _, _, _, _, _),
+			Goal0Expr = pragma_foreign_code(_, _, _, _, _, _, _),
 			rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
 			goal_util__rename_vars_in_goal(Construct, Subst,
 				NewConstruct),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.89
diff -u -r1.89 simplify.m
--- compiler/simplify.m	2000/10/26 05:30:55	1.89
+++ compiler/simplify.m	2000/10/30 12:41:14
@@ -1130,7 +1130,7 @@
 	).
 
 simplify__goal_2(Goal0, GoalInfo, Goal, GoalInfo, Info0, Info) :-
-	Goal0 = pragma_foreign_code(_, _, PredId, ProcId, Args, _, _, _),
+	Goal0 = pragma_foreign_code(_, PredId, ProcId, Args, _, _, _),
 	(
 		simplify_do_calls(Info0),
 		goal_info_is_pure(GoalInfo)
@@ -2281,7 +2281,7 @@
 			Goal = GoalExpr - _,
 			GoalExpr \= call(_, _, _, _, _, _),
 			GoalExpr \= generic_call(_, _, _, _),
-			GoalExpr \= pragma_foreign_code(_, _, _, _, _, _, _, _)
+			GoalExpr \= pragma_foreign_code(_, _, _, _, _, _, _)
 		)
 	->
 		simplify_info_get_common_info(Info0, CommonInfo0),
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.74
diff -u -r1.74 store_alloc.m
--- compiler/store_alloc.m	2000/10/03 00:34:29	1.74
+++ compiler/store_alloc.m	2000/10/16 01:13:29
@@ -207,8 +207,8 @@
 store_alloc_in_goal_2(unify(A,B,C,D,E), Liveness, _, _,
 		_, unify(A,B,C,D,E), Liveness).
 
-store_alloc_in_goal_2(pragma_foreign_code(A, B, C, D, E, F, G, H), Liveness,
-		_, _, _, pragma_foreign_code(A, B, C, D, E, F, G, H), Liveness).
+store_alloc_in_goal_2(pragma_foreign_code(A, B, C, D, E, F, G), Liveness,
+		_, _, _, pragma_foreign_code(A, B, C, D, E, F, G), Liveness).
 
 store_alloc_in_goal_2(bi_implication(_, _), _, _, _, _, _, _) :-
 	% these should have been expanded out by now
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.22
diff -u -r1.22 stratify.m
--- compiler/stratify.m	2000/08/09 07:47:52	1.22
+++ compiler/stratify.m	2000/10/16 01:13:19
@@ -178,7 +178,7 @@
 		WholeScc, ThisPredProcId, Error, Module0, Module) -->
 	first_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
 		Error, Module0, Module).
-first_order_check_goal(pragma_foreign_code(_Language, _Attributes, CPred,
+first_order_check_goal(pragma_foreign_code(_Attributes, CPred,
 			CProc, _, _, _, _), 
 		GoalInfo, Negated, WholeScc, ThisPredProcId, 
 		Error, Module0, Module) -->
@@ -335,7 +335,7 @@
 		ThisPredProcId, HighOrderLoops, Error, Module0, Module) -->
 	higher_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
 		HighOrderLoops, Error, Module0, Module).
-higher_order_check_goal(pragma_foreign_code(_, _IsRec, _, _, _, _, _, _),
+higher_order_check_goal(pragma_foreign_code(_IsRec, _, _, _, _, _, _),
 	_GoalInfo, _Negated, _WholeScc, _ThisPredProcId, _HighOrderLoops, 
 	_, Module, Module) --> [].
 higher_order_check_goal(unify(_Var, _RHS, _Mode, _Uni, _Context), _GoalInfo,
@@ -822,7 +822,7 @@
 		CallsHO) :- 
 	check_goal1(Goal, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
 
-check_goal1(pragma_foreign_code(_Lang, _Attrib, _CPred, _CProc, _, _, _, _),
+check_goal1(pragma_foreign_code(_Attrib, _CPred, _CProc, _, _, _, _),
 		Calls, Calls, HasAT, HasAT, CallsHO, CallsHO).
 
 check_goal1(bi_implication(_, _), _, _, _, _, _, _) :-
@@ -913,7 +913,7 @@
 	get_called_procs(Goal, Calls0, Calls).
 get_called_procs(not(Goal - _GoalInfo), Calls0, Calls) :-
 	get_called_procs(Goal, Calls0, Calls).
-get_called_procs(pragma_foreign_code(_Lang, _Attrib, _CPred, _CProc,
+get_called_procs(pragma_foreign_code(_Attrib, _CPred, _CProc,
 		_, _, _, _), Calls, Calls).
 get_called_procs(bi_implication(_, _), _, _) :-
 	% these should have been expanded out by now
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.91
diff -u -r1.91 switch_detection.m
--- compiler/switch_detection.m	2000/10/06 10:18:35	1.91
+++ compiler/switch_detection.m	2000/10/16 01:12:58
@@ -216,8 +216,8 @@
 		VarTypes, ModuleInfo, switch(Var, CanFail, Cases, SM)) :-
 	detect_switches_in_cases(Cases0, InstMap, VarTypes, ModuleInfo, Cases).
 
-detect_switches_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H), _, _, _, _,
-		pragma_foreign_code(A,B,C,D,E,F,G,H)).
+detect_switches_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G), _, _, _, _,
+		pragma_foreign_code(A,B,C,D,E,F,G)).
 detect_switches_in_goal_2(bi_implication(_, _), _, _, _, _, _) :-
 	% these should have been expanded out by now
 	error("detect_switches_in_goal_2: unexpected bi_implication").
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.14
diff -u -r1.14 term_traversal.m
--- compiler/term_traversal.m	2000/10/06 10:18:36	1.14
+++ compiler/term_traversal.m	2000/10/16 01:11:11
@@ -183,7 +183,7 @@
 	traverse_goal(Else, Params, Info0, Info2),
 	combine_paths(Info1, Info2, Params, Info).
 
-traverse_goal_2(pragma_foreign_code(_,_, CallPredId, CallProcId, Args, _,_,_),
+traverse_goal_2(pragma_foreign_code(_, CallPredId, CallProcId, Args, _,_,_),
 		GoalInfo, Params, Info0, Info) :-
 	params_get_module_info(Params, Module),
 	module_info_pred_proc_info(Module, CallPredId, CallProcId, _,
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.292
diff -u -r1.292 typecheck.m
--- compiler/typecheck.m	2000/11/06 04:09:06	1.292
+++ compiler/typecheck.m	2000/11/07 11:35:02
@@ -1039,8 +1039,8 @@
 	typecheck_unification(A, B0, B).
 typecheck_goal_2(switch(_, _, _, _), _) -->
 	{ error("unexpected switch") }.
-typecheck_goal_2(pragma_foreign_code(A, B, PredId, D, Args, F, G, H), 
-		pragma_foreign_code(A, B, PredId, D, Args, F, G, H)) -->
+typecheck_goal_2(pragma_foreign_code(A, PredId, C, Args, E, F, G), 
+		pragma_foreign_code(A, PredId, C, Args, E, F, G)) -->
 	% pragma_foreign_codes are automatically generated, so they
 	% will always be type-correct, but we need to do
 	% the type analysis in order to correctly compute the
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.67
diff -u -r1.67 unique_modes.m
--- compiler/unique_modes.m	2000/10/14 13:41:29	1.67
+++ compiler/unique_modes.m	2000/10/22 11:54:49
@@ -509,7 +509,7 @@
 
 	% to modecheck a pragma_c_code, we just modecheck the proc for 
 	% which it is the goal.
-unique_modes__check_goal_2(pragma_foreign_code(Language, Attributes,
+unique_modes__check_goal_2(pragma_foreign_code(Attributes,
 		PredId, ProcId0, Args, ArgNameMap, OrigArgTypes, PragmaCode),
 		_GoalInfo, Goal) -->
 	mode_checkpoint(enter, "pragma_c_code"),
@@ -517,7 +517,7 @@
 	{ mode_info_get_call_id(ModeInfo, PredId, CallId) },
 	mode_info_set_call_context(call(call(CallId))),
 	unique_modes__check_call(PredId, ProcId0, Args, ProcId),
-	{ Goal = pragma_foreign_code(Language, Attributes, PredId, ProcId, Args,
+	{ Goal = pragma_foreign_code(Attributes, PredId, ProcId, Args,
 			ArgNameMap, OrigArgTypes, PragmaCode) },
 	mode_info_unset_call_context,
 	mode_checkpoint(exit, "pragma_c_code").
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.6
diff -u -r1.6 unneeded_code.m
--- compiler/unneeded_code.m	2000/10/13 13:56:03	1.6
+++ compiler/unneeded_code.m	2000/10/22 11:54:50
@@ -616,7 +616,7 @@
 		RefinedGoals = RefinedGoals0,
 		Changed = Changed0
 	;
-		GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
+		GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _),
 		Goal = Goal0,
 		unneeded_code__demand_inputs(Goal, ModuleInfo, InstMap0,
 			everywhere, WhereNeededMap0, WhereNeededMap),
@@ -963,7 +963,7 @@
 		Goal = Goal0,
 		RefinedGoals = RefinedGoals0
 	;
-		GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
+		GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _),
 		Goal = Goal0,
 		RefinedGoals = RefinedGoals0
 	;
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.69
diff -u -r1.69 unused_args.m
--- compiler/unused_args.m	2000/10/13 13:56:03	1.69
+++ compiler/unused_args.m	2000/11/10 07:12:22
@@ -437,8 +437,8 @@
 	set_list_vars_used(UseInf1, Args, UseInf).
 
 % handle pragma foreign(...) -
-% only those arguments which have C names can be used in the C code.
-traverse_goal(_, pragma_foreign_code(_, _, _, _, Args, Names, _, _),
+% only those arguments which have names can be used in the foreign code.
+traverse_goal(_, pragma_foreign_code(_, _, _, Args, Names, _, _),
 		UseInf0, UseInf) :-
 	assoc_list__from_corresponding_lists(Args, Names, ArgsAndNames),
 	ArgIsUsed = lambda([ArgAndName::in, Arg::out] is semidet, (
@@ -1275,7 +1275,7 @@
 
 fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
 			GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
-	GoalExpr = pragma_foreign_code(_, _, _, _, _, _, _, _).
+	GoalExpr = pragma_foreign_code(_, _, _, _, _, _, _).
 
 fixup_goal_expr(_, _, _, _, bi_implication(_, _) - _, _) :-
 	% these should have been expanded out by now
Index: tests/invalid/pragma_c_code_and_clauses1.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/pragma_c_code_and_clauses1.err_exp,v
retrieving revision 1.3
diff -u -r1.3 pragma_c_code_and_clauses1.err_exp
--- tests/invalid/pragma_c_code_and_clauses1.err_exp	1998/02/02 03:01:11	1.3
+++ tests/invalid/pragma_c_code_and_clauses1.err_exp	2000/11/09 00:58:23
@@ -1,6 +1,6 @@
 pragma_c_code_and_clauses1.m:009: Warning: `pragma' declaration in module interface.
 pragma_c_code_and_clauses1.m:007: Warning: clause in module interface.
-pragma_c_code_and_clauses1.m:009: Error: `:- pragma c_code' declaration for predicate `pragma_c_code_and_clauses1:foo/1'
+pragma_c_code_and_clauses1.m:009: Error: `:- pragma foreign_code' declaration for predicate `pragma_c_code_and_clauses1:foo/1'
 pragma_c_code_and_clauses1.m:009:   with preceding clauses.
 pragma_c_code_and_clauses1.m:005: In `foo(in)':
 pragma_c_code_and_clauses1.m:005:   error: determinism declaration not satisfied.
Index: tests/invalid/pragma_c_code_dup_var.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/pragma_c_code_dup_var.err_exp,v
retrieving revision 1.2
diff -u -r1.2 pragma_c_code_dup_var.err_exp
--- tests/invalid/pragma_c_code_dup_var.err_exp	2000/02/15 00:36:03	1.2
+++ tests/invalid/pragma_c_code_dup_var.err_exp	2000/11/09 00:59:00
@@ -1,4 +1,4 @@
-pragma_c_code_dup_var.m:019: In `:- pragma c_code' declaration for function `pragma_c_code_dup_var:bread_impl/6':
+pragma_c_code_dup_var.m:019: In `:- pragma foreign_code' declaration for function `pragma_c_code_dup_var:bread_impl/6':
 pragma_c_code_dup_var.m:019:   error: variable `Buf' occurs multiple times
 pragma_c_code_dup_var.m:019:   in the argument list.
 pragma_c_code_dup_var.m:014: Error: no clauses for
Index: tests/warnings/singleton_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/singleton_test.exp,v
retrieving revision 1.5
diff -u -r1.5 singleton_test.exp
--- tests/warnings/singleton_test.exp	1998/01/02 00:11:41	1.5
+++ tests/warnings/singleton_test.exp	2000/11/09 01:32:40
@@ -4,12 +4,12 @@
 singleton_test.m:026:   warning: variables `L1, L2' occur only once in this scope.
 singleton_test.m:027: In clause for function `singleton_test:my_append_func/2':
 singleton_test.m:027:   warning: variable `T' occurs only once in this scope.
-singleton_test.m:029: In `:- pragma c_code' for predicate `singleton_test:my_c_pred/3':
-singleton_test.m:029:   warning: variable `Y' does not occur in the C code.
-singleton_test.m:033: In `:- pragma c_code' for function `singleton_test:my_c_func/2':
-singleton_test.m:033:   warning: variable `X' does not occur in the C code.
-singleton_test.m:039: In `:- pragma c_code' for predicate `singleton_test:c_hello_world/3':
-singleton_test.m:039:   warning: variable `Msg' does not occur in the C code.
+singleton_test.m:029: In `:- pragma foreign_code' for predicate `singleton_test:my_c_pred/3':
+singleton_test.m:029:   warning: variable `Y' does not occur in the foreign code.
+singleton_test.m:033: In `:- pragma foreign_code' for function `singleton_test:my_c_func/2':
+singleton_test.m:033:   warning: variable `X' does not occur in the foreign code.
+singleton_test.m:039: In `:- pragma foreign_code' for predicate `singleton_test:c_hello_world/3':
+singleton_test.m:039:   warning: variable `Msg' does not occur in the foreign code.
 singleton_test.m:008: In function `singleton_test:my_append_func/2':
 singleton_test.m:008:   warning: unresolved polymorphism.
 singleton_test.m:008:   The variables with unbound types were:

-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list