[m-dev.] for review: MLDS back-end: clean up `pragma c_code' handling

[Fergus Henderson]

Tyson, could you please review this one?

----------

Estimated hours taken: 2

Clean up the handling of `pragma c_code' in the MLDS back-end.

compiler/mlds.m:
	Change the representation of `target_code' statements,
	so that they can contain mlds__rvals and mlds__lvals.

compiler/ml_code_gen.m:
	Modify the code for compiling `pragma_c' HLDS goals so that
	it generates the new representation of `target_code' statements.
	This change also fixes the problem with handling "complicated"
	pragma c_code, i.e. cases which required boxing or unboxing.

compiler/ml_call_gen.m:
	Export `ml_box_or_unbox_lval', for use by ml_code_gen.m.

compiler/ml_elim_nested.m:
	Change `fixup_atomic_statement' to handle the new representation
	of `target_code' statements.

compiler/mlds_to_c.m:
	Change `mlds_output_statement' to handle the new representation
	of `target_code' statements.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.10
diff -u -d -r1.10 ml_call_gen.m
--- compiler/ml_call_gen.m	2000/05/17 16:01:39	1.10
+++ compiler/ml_call_gen.m	2000/05/25 02:37:57
@@ -61,6 +61,22 @@
 :- pred ml_gen_box_or_unbox_rval(prog_type, prog_type, mlds__rval, mlds__rval).
 :- mode ml_gen_box_or_unbox_rval(in, in, in, out) is det.
 
+	% This is like `ml_gen_box_or_unbox_rval', except that it
+	% works on lvals rather than rvals.
+	% Given a source type and a destination type,
+	% a source lval holding a value of the source type,
+	% and a name to base the name of the local temporary variable on,
+	% this procedure produces an lval of the destination type,
+	% code to assign the destination lval (suitably converted)
+	% to the source lval, and the declaration for the local
+	% temporary used (if any).
+	%
+:- pred ml_gen_box_or_unbox_lval(prog_type, prog_type, mlds__lval, var_name,
+		prog_context, mlds__lval, mlds__defns, mlds__statements,
+		ml_gen_info, ml_gen_info).
+:- mode ml_gen_box_or_unbox_lval(in, in, in, in, in, out, out, out,
+		in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -535,12 +551,6 @@
 		ArgRval = VarRval
 	).
 	
-:- pred ml_gen_box_or_unbox_lval(prog_type, prog_type, mlds__lval, var_name,
-		prog_context, mlds__lval, mlds__defns, mlds__statements,
-		ml_gen_info, ml_gen_info).
-:- mode ml_gen_box_or_unbox_lval(in, in, in, in, in, out, out, out,
-		in, out) is det.
-
 ml_gen_box_or_unbox_lval(CallerType, CalleeType, VarLval, VarName, Context,
 		ArgLval, ConvDecls, ConvStatements) -->
 	%
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.47
diff -u -d -r1.47 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/05/25 01:05:20	1.47
+++ compiler/ml_code_gen.m	2000/05/25 03:09:34
@@ -1570,6 +1570,7 @@
 	% For model_non pragma c_code,
 	% we generate code of the following form:
 	%
+	% 	<declaration of locals needed for boxing/unboxing>
 	%	{
 	% 		<declaration of one local variable for each arg>
 	%		struct {
@@ -1592,6 +1593,7 @@
 	%			<release global lock>
 	%			if (MR_succeeded) {
 	%				<assign output args>
+	% 				<boxing/unboxing of outputs>
 	%				CONT();
 	%			}
 	%			if (MR_done) break;
@@ -1607,8 +1609,8 @@
 	%		
 ml_gen_nondet_pragma_c_code(CodeModel, Attributes,
 		PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes, Context,
-		LocalVarsDecls, _LocalVarsContext, FirstCode, _FirstContext,
-		LaterCode, _LaterContext, SharedCode, _SharedContext,
+		LocalVarsDecls, LocalVarsContext, FirstCode, FirstContext,
+		LaterCode, LaterContext, SharedCode, SharedContext,
 		MLDS_Decls, MLDS_Statements) -->
 	%
 	% Combine all the information about the each arg
@@ -1641,12 +1643,13 @@
 	%
 	% Generate code to set the values of the input variables.
 	%
-	list__map_foldl(ml_gen_pragma_c_input_arg, ArgList, AssignInputsList),
+	ml_gen_pragma_c_input_arg_list(ArgList, AssignInputsList),
 
 	%
 	% Generate code to assign the values of the output variables.
 	%
-	list__map_foldl(ml_gen_pragma_c_output_arg, ArgList, AssignOutputsList),
+	ml_gen_pragma_c_output_arg_list(ArgList, Context,
+		AssignOutputsList, ConvDecls, ConvStatements),
 
 	%
 	% Generate code fragments to obtain and release the global lock
@@ -1658,61 +1661,61 @@
 	%
 	% Put it all together
 	%
-	{ string__append_list(ArgDeclsList, ArgDecls) },
-	{ string__append_list(AssignInputsList, AssignInputsCode) },
-	{ string__append_list(AssignOutputsList, AssignOutputsCode) },
-	{ string__append_list([
-			"{\n",
-			ArgDecls,
-			"\tstruct {\n",
-			LocalVarsDecls, "\n",
-			"\t} MR_locals;\n",
-			"\tbool MR_succeeded = FALSE;\n",
-			"\tbool MR_done = FALSE;\n",
-			"\n",
-			HashDefines,
-			"\n",
-			AssignInputsCode,
-			ObtainLock,
-			"\t{\n",
-			FirstCode,
-			"\n\t;}\n",
-			"\twhile (1) {\n",
-			"\t\t{\n",
-			SharedCode,
-			"\n\t\t;}\n",
-			ReleaseLock,
-			"\t\tif (MR_succeeded) {\n",
-			AssignOutputsCode],
-		Starting_C_Code) },
+	{ Starting_C_Code = list__condense([
+			[raw_target_code("{\n")],
+			ArgDeclsList,
+			[raw_target_code("\tstruct {\n"),
+			user_target_code(LocalVarsDecls, LocalVarsContext),
+			raw_target_code("\n"),
+			raw_target_code("\t} MR_locals;\n"),
+			raw_target_code("\tbool MR_succeeded = FALSE;\n"),
+			raw_target_code("\tbool MR_done = FALSE;\n"),
+			raw_target_code("\n"),
+			raw_target_code(HashDefines),
+			raw_target_code("\n")],
+			AssignInputsList,
+			[raw_target_code(ObtainLock),
+			raw_target_code("\t{\n"),
+			user_target_code(FirstCode, FirstContext),
+			raw_target_code("\n\t;}\n"),
+			raw_target_code("\twhile (1) {\n"),
+			raw_target_code("\t\t{\n"),
+			user_target_code(SharedCode, SharedContext),
+			raw_target_code("\n\t\t;}\n"),
+			raw_target_code(ReleaseLock),
+			raw_target_code("\t\tif (MR_succeeded) {\n")],
+			AssignOutputsList
+	]) },
 	( { CodeModel = model_non } ->
 		ml_gen_call_current_success_cont(Context, CallCont)
 	;
 		{ error("ml_gen_nondet_pragma_c_code: unexpected code model") }
 	),
-	{ string__append_list([
-			"\t\t}\n",
-			"\t\tif (MR_done) break;\n",
-			ObtainLock,
-			"\t\t{\n",
-			LaterCode,
-			"\n\t\t;}\n",
-			"\t}\n",
-			"\n",
-			HashUndefs,
-			"}\n"],
-		Ending_C_Code) },
+	{ Ending_C_Code = [
+			raw_target_code("\t\t}\n"),
+			raw_target_code("\t\tif (MR_done) break;\n"),
+			raw_target_code(ObtainLock),
+			raw_target_code("\t\t{\n"),
+			user_target_code(LaterCode, LaterContext),
+			raw_target_code("\n\t\t;}\n"),
+			raw_target_code("\t}\n"),
+			raw_target_code("\n"),
+			raw_target_code(HashUndefs),
+			raw_target_code("}\n")
+	] },
 	{ Starting_C_Code_Stmt = target_code(lang_C, Starting_C_Code) },
 	{ Starting_C_Code_Statement = mlds__statement(
 		atomic(Starting_C_Code_Stmt), mlds__make_context(Context)) },
 	{ Ending_C_Code_Stmt = target_code(lang_C, Ending_C_Code) },
 	{ Ending_C_Code_Statement = mlds__statement(
 		atomic(Ending_C_Code_Stmt), mlds__make_context(Context)) },
-	{ MLDS_Statements = [
-		Starting_C_Code_Statement,
-		CallCont,
-		Ending_C_Code_Statement] },
-	{ MLDS_Decls = [] }.
+	{ MLDS_Statements = list__condense([
+		[Starting_C_Code_Statement],
+		ConvStatements,
+		[CallCont,
+		Ending_C_Code_Statement]
+	]) },
+	{ MLDS_Decls = ConvDecls }.
 
 :- pred ml_gen_ordinary_pragma_c_code(code_model, pragma_c_code_attributes,
 		pred_id, proc_id, list(prog_var),
@@ -1727,21 +1730,24 @@
 	%
 	% model_det pragma_c_code:
 	%
+	% 	<declaration of locals needed for boxing/unboxing>
 	%	{
 	% 		<declaration of one local variable for each arg>
 	%
 	%		<assign input args>
 	%		<obtain global lock>
 	%		<c code>
+	% 		<boxing/unboxing of outputs>
 	%		<release global lock>
 	%		<assign output args>
 	%	}
 	%		
 	% model_semi pragma_c_code:
 	%
+	% 	<declaration of locals needed for boxing/unboxing>
 	%	{
 	% 		<declaration of one local variable for each arg>
-	%		#define SUCCESS_INDICATOR <succeeded>
+	%		bool SUCCESS_INDICATOR;
 	%
 	%		<assign input args>
 	%		<obtain global lock>
@@ -1749,9 +1755,10 @@
 	%		<release global lock>
 	%		if (SUCCESS_INDICATOR) {
 	%			<assign output args>
+	% 			<boxing/unboxing of outputs>
 	%		}
 	%		
-	%		#undef SUCCESS_INDICATOR
+	%		<succeeded> = SUCCESS_INDICATOR;
 	%	}
 	%		
 	% Note that we generate this code directly as
@@ -1780,12 +1787,13 @@
 	%
 	% Generate code to set the values of the input variables.
 	%
-	list__map_foldl(ml_gen_pragma_c_input_arg, ArgList, AssignInputsList),
+	ml_gen_pragma_c_input_arg_list(ArgList, AssignInputsList),
 
 	%
 	% Generate code to assign the values of the output variables.
 	%
-	list__map_foldl(ml_gen_pragma_c_output_arg, ArgList, AssignOutputsList),
+	ml_gen_pragma_c_output_arg_list(ArgList, Context,
+		AssignOutputsList, ConvDecls, ConvStatements),
 
 	%
 	% Generate code fragments to obtain and release the global lock
@@ -1797,56 +1805,57 @@
 	%
 	% Put it all together
 	%
-	{ string__append_list(ArgDeclsList, ArgDecls) },
-	{ string__append_list(AssignInputsList, AssignInputsCode) },
-	{ string__append_list(AssignOutputsList, AssignOutputsCode) },
 	( { CodeModel = model_det } ->
-		{ string__append_list([
-				"{\n",
-				ArgDecls,
-				"\n",
-				AssignInputsCode,
-				ObtainLock,
-				"\t\t{\n",
-				C_Code,
-				"\n\t\t;}\n",
-				ReleaseLock,
-				AssignOutputsCode,
-				"}\n"],
-			Combined_C_Code) }
+		{ Starting_C_Code = list__condense([
+				[raw_target_code("{\n")],
+				ArgDeclsList,
+				[raw_target_code("\n")],
+				AssignInputsList,
+				[raw_target_code(ObtainLock),
+				raw_target_code("\t\t{\n"),
+				user_target_code(C_Code, yes(Context)),
+				raw_target_code("\n\t\t;}\n"),
+				raw_target_code(ReleaseLock)],
+				AssignOutputsList
+		]) },
+		{ Ending_C_Code = [raw_target_code("}\n")] }
 	; { CodeModel = model_semi } ->
 		ml_success_lval(SucceededLval),
-		{ ml_gen_c_code_for_rval(lval(SucceededLval), SucceededVar) },
-		{ DefineSuccessIndicator = string__format(
-			"\t#define SUCCESS_INDICATOR %s\n",
-			[s(SucceededVar)]) },
-		{ MaybeAssignOutputsCode = string__format(
-			"\tif (SUCCESS_INDICATOR) {\n%s\n\t}\n",
-			[s(AssignOutputsCode)]) },
-		{ UndefSuccessIndicator = "\t#undef SUCCESS_INDICATOR\n" },
-		{ string__append_list([
-				"{\n",
-				ArgDecls,
-				DefineSuccessIndicator,
-				"\n",
-				AssignInputsCode,
-				ObtainLock,
-				"\t\t{\n",
-				C_Code,
-				"\n\t\t;}\n",
-				ReleaseLock,
-				MaybeAssignOutputsCode,
-				UndefSuccessIndicator,
-				"}\n"],
-			Combined_C_Code) }
+		{ Starting_C_Code = list__condense([
+				[raw_target_code("{\n")],
+				ArgDeclsList,
+				[raw_target_code("\tbool SUCCESS_INDICATOR;\n"),
+				raw_target_code("\n")],
+				AssignInputsList,
+				[raw_target_code(ObtainLock),
+				raw_target_code("\t\t{\n"),
+				user_target_code(C_Code, yes(Context)),
+				raw_target_code("\n\t\t;}\n"),
+				raw_target_code(ReleaseLock),
+				raw_target_code("\tif (SUCCESS_INDICATOR) {\n")],
+				AssignOutputsList
+		]) },
+		{ Ending_C_Code = [
+				raw_target_code("\t}\n"),
+				target_code_output(SucceededLval),
+				raw_target_code(" = SUCCESS_INDICATOR;\n"),
+				raw_target_code("}\n")
+		] }
 	;
 		{ error("ml_gen_ordinary_pragma_c_code: unexpected code model") }
 	),
-	{ C_Code_Stmt = target_code(lang_C, Combined_C_Code) },
-	{ C_Code_Statement = mlds__statement(atomic(C_Code_Stmt),
+	{ Starting_C_Code_Stmt = target_code(lang_C, Starting_C_Code) },
+	{ Ending_C_Code_Stmt = target_code(lang_C, Ending_C_Code) },
+	{ Starting_C_Code_Statement = mlds__statement(atomic(Starting_C_Code_Stmt),
 		mlds__make_context(Context)) },
-	{ MLDS_Statements = [C_Code_Statement] },
-	{ MLDS_Decls = [] }.
+	{ Ending_C_Code_Statement = mlds__statement(atomic(Ending_C_Code_Stmt),
+		mlds__make_context(Context)) },
+	{ MLDS_Statements = list__condense([
+		[Starting_C_Code_Statement],
+		ConvStatements,
+		[Ending_C_Code_Statement]
+	]) },
+	{ MLDS_Decls = ConvDecls }.
 
 	% Generate code fragments to obtain and release the global lock
 	% (this is used for ensuring thread safety in a concurrent
@@ -1916,7 +1925,8 @@
 % ml_gen_pragma_c_decls generates C code to declare the arguments
 % for a `pragma c_code' declaration.
 %
-:- pred ml_gen_pragma_c_decls(list(ml_c_arg)::in, list(string)::out) is det.
+:- pred ml_gen_pragma_c_decls(list(ml_c_arg)::in,
+		list(target_code_component)::out) is det.
 
 ml_gen_pragma_c_decls([], []).
 ml_gen_pragma_c_decls([Arg|Args], [Decl|Decls]) :-
@@ -1926,9 +1936,9 @@
 % ml_gen_pragma_c_decl generates C code to declare an argument
 % of a `pragma c_code' declaration.
 %
-:- pred ml_gen_pragma_c_decl(ml_c_arg::in, string::out) is det.
+:- pred ml_gen_pragma_c_decl(ml_c_arg::in, target_code_component::out) is det.
 
-ml_gen_pragma_c_decl(ml_c_arg(_Var, MaybeNameAndMode, Type), DeclString) :-
+ml_gen_pragma_c_decl(ml_c_arg(_Var, MaybeNameAndMode, Type), Decl) :-
 	(
 		MaybeNameAndMode = yes(ArgName - _Mode),
 		\+ var_is_singleton(ArgName)
@@ -1940,7 +1950,8 @@
 		% if the variable doesn't occur in the ArgNames list,
 		% it can't be used, so we just ignore it
 		DeclString = ""
-	).
+	),
+	Decl = raw_target_code(DeclString).
 
 %-----------------------------------------------------------------------------%
 
@@ -1961,14 +1972,23 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pred ml_gen_pragma_c_input_arg_list(list(ml_c_arg)::in,
+		list(target_code_component)::out,
+		ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_pragma_c_input_arg_list(ArgList, AssignInputs) -->
+	list__map_foldl(ml_gen_pragma_c_input_arg, ArgList, AssignInputsList),
+	{ list__condense(AssignInputsList, AssignInputs) }.
+
 % ml_gen_pragma_c_input_arg generates C code to assign the value of an input
 % arg for a `pragma c_code' declaration.
 %
-:- pred ml_gen_pragma_c_input_arg(ml_c_arg::in, string::out,
+:- pred ml_gen_pragma_c_input_arg(ml_c_arg::in,
+		list(target_code_component)::out,
 		ml_gen_info::in, ml_gen_info::out) is det.
 
 ml_gen_pragma_c_input_arg(ml_c_arg(Var, MaybeNameAndMode, OrigType),
-		AssignInputString) -->
+		AssignInput) -->
 	=(MLDSGenInfo),
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
 	(
@@ -1985,33 +2005,55 @@
 			% using private_builtin__dummy_var, which is
 			% what ml_gen_var will have generated for this
 			% variable.
-			Var_ArgName = "0"
+			ArgRval = const(int_const(0))
 		;
 			ml_gen_box_or_unbox_rval(VarType, OrigType, lval(VarLval),
-				ArgRval),
-			ml_gen_c_code_for_rval(ArgRval, Var_ArgName)
+				ArgRval)
 		},
 		{ type_util__var(VarType, _) ->
 			Cast = "(MR_Word) "
 		;
 			Cast = ""
 		},
-		{ string__format("\t%s = %s%s;\n", [s(ArgName), s(Cast),
-			s(Var_ArgName)], AssignInputString) }
+		{ string__format("\t%s = %s", [s(ArgName), s(Cast)],
+			AssignToArgName) },
+		{ AssignInput = [
+			raw_target_code(AssignToArgName),
+			target_code_input(ArgRval),
+			raw_target_code(";\n")
+		] }
 	;
 		% if the variable doesn't occur in the ArgNames list,
 		% it can't be used, so we just ignore it
-		{ AssignInputString = "" }
+		{ AssignInput = [] }
 	).
 
+:- pred ml_gen_pragma_c_output_arg_list(list(ml_c_arg)::in, prog_context::in,
+		list(target_code_component)::out,
+		mlds__defns::out, mlds__statements::out,
+		ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_pragma_c_output_arg_list([], _, [], [], []) --> [].
+ml_gen_pragma_c_output_arg_list([C_Arg | C_Args], Context, Components,
+		ConvDecls, ConvStatements) -->
+	ml_gen_pragma_c_output_arg(C_Arg, Context, Components1,
+			ConvDecls1, ConvStatements1),
+	ml_gen_pragma_c_output_arg_list(C_Args, Context, Components2,
+			ConvDecls2, ConvStatements2),
+	{ Components = list__append(Components1, Components2) },
+	{ ConvDecls = list__append(ConvDecls1, ConvDecls2) },
+	{ ConvStatements = list__append(ConvStatements1, ConvStatements2) }.
+
 % ml_gen_pragma_c_output_arg generates C code to assign the value of an output
 % arg for a `pragma c_code' declaration.
 %
-:- pred ml_gen_pragma_c_output_arg(ml_c_arg::in, string::out,
+:- pred ml_gen_pragma_c_output_arg(ml_c_arg::in, prog_context::in,
+		list(target_code_component)::out,
+		mlds__defns::out, mlds__statements::out,
 		ml_gen_info::in, ml_gen_info::out) is det.
 
 ml_gen_pragma_c_output_arg(ml_c_arg(Var, MaybeNameAndMode, OrigType),
-		AssignOutputString) -->
+		Context, AssignOutput, ConvDecls, ConvStatements) -->
 	=(MLDSGenInfo),
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
 	(
@@ -2022,46 +2064,26 @@
 	->
 		ml_variable_type(Var, VarType),
 		ml_gen_var(Var, VarLval),
-		{ ml_gen_box_or_unbox_rval(OrigType, VarType, lval(VarLval),
-			ArgRval) },
-		{ ml_gen_c_code_for_rval(ArgRval, Var_ArgName) },
+		ml_gen_box_or_unbox_lval(VarType, OrigType, VarLval, ArgName,
+			Context, ArgLval, ConvDecls, ConvStatements),
 		{ type_util__var(VarType, _) ->
 			Cast = "(MR_Box) "
 		;
 			Cast = ""
 		},
-		{ string__format("\t%s = %s%s;\n", [s(Var_ArgName), s(Cast),
-			s(ArgName)], AssignOutputString) }
+		{ string__format(" = %s%s;\n", [s(Cast), s(ArgName)],
+			AssignFromArgName) },
+		{ AssignOutput = [
+			raw_target_code("\t"),
+			target_code_output(ArgLval),
+			raw_target_code(AssignFromArgName)
+		] }
 	;
 		% if the variable doesn't occur in the ArgNames list,
 		% it can't be used, so we just ignore it
-		{ AssignOutputString = "" }
-	).
-
-	%
-	% XXX this is a bit of a hack --
-	% for `pragma c_code', we generate the C code for an mlds__rval
-	% directly rather than going via the MLDS
-	%
-:- pred ml_gen_c_code_for_rval(mlds__rval::in, string::out) is det.
-ml_gen_c_code_for_rval(ArgRval, Var_ArgName) :-
-	( ArgRval = lval(var(qual(ModuleName, VarName))) ->
-		SymName = mlds_module_name_to_sym_name(ModuleName),
-		llds_out__sym_name_mangle(SymName, MangledModuleName),
-		llds_out__name_mangle(VarName, MangledVarName),
-		string__append_list([MangledModuleName, "__",
-			MangledVarName], Var_ArgName)
-	; ArgRval = lval(mem_ref(lval(var(qual(ModuleName, VarName))), _)) ->
-		SymName = mlds_module_name_to_sym_name(ModuleName),
-		llds_out__sym_name_mangle(SymName, MangledModuleName),
-		llds_out__name_mangle(VarName, MangledVarName),
-		string__append_list(["*", MangledModuleName, "__",
-			MangledVarName], Var_ArgName)
-	;
-		% XXX don't complain until run-time
-		% sorry("complicated pragma c_code")
-		Var_ArgName =
-		"*(MR_fatal_error(""complicated pragma c_code""),(MR_Word *)0)"
+		{ AssignOutput = [] },
+		{ ConvDecls = [] },
+		{ ConvStatements = [] }
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.24
diff -u -d -r1.24 mlds.m
--- compiler/mlds.m	2000/05/22 18:00:06	1.24
+++ compiler/mlds.m	2000/05/25 03:00:32
@@ -861,15 +861,13 @@
 	% foreign language interfacing
 	%
 
-	;	target_code(target_lang, string)
-			% Do whatever is specified by the string,
+	;	target_code(target_lang, list(target_code_component))
+			% Do whatever is specified by the target_code_compoenents,
 			% which can be any piece of code in the specified
 			% target language (C, assembler, or whatever)
 			% that does not have any non-local flow of control.
-
 	.
 
-
 	%
 	% This is just a random selection of possible languages
 	% that we might want to target...
@@ -881,6 +879,17 @@
 	;	lang_asm
 	;	lang_java_asm
 	;	lang_java_bytecode
+	.
+
+:- type target_code_component
+	--->	user_target_code(string, maybe(prog_context))
+			% user_target_code holds C code from
+			% the user's `pragma c_code' declaration
+	;	raw_target_code(string)
+			% raw_target_code holds C code that the
+			% compiler has generated.
+	;	target_code_input(mlds__rval)
+	;	target_code_output(mlds__lval)
 	.
 
 	% XXX I'm not sure what representation we should use here
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.33
diff -u -d -r1.33 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/05/24 06:04:48	1.33
+++ compiler/mlds_to_c.m	2000/05/25 03:07:56
@@ -1575,13 +1575,36 @@
 	%
 	% foreign language interfacing
 	%
-mlds_output_atomic_stmt(_Indent, target_code(TargetLang, CodeString), Context) -->
+mlds_output_atomic_stmt(_Indent, target_code(TargetLang, Components),
+		Context) -->
 	( { TargetLang = lang_C } ->
-		mlds_output_context(Context),
-		io__write_string(CodeString)
+		list__foldl(mlds_output_target_code_component(Context),
+			Components)
 	;
 		{ error("mlds_to_c.m: sorry, target_code only works for lang_C") }
 	).
+
+:- pred mlds_output_target_code_component(mlds__context, target_code_component,
+		io__state, io__state).
+:- mode mlds_output_target_code_component(in, in, di, uo) is det.
+
+mlds_output_target_code_component(Context,
+		user_target_code(CodeString, MaybeUserContext)) -->
+	( { MaybeUserContext = yes(UserContext) } ->
+		mlds_output_context(mlds__make_context(UserContext))
+	;
+		mlds_output_context(Context)
+	),
+	io__write_string(CodeString).
+mlds_output_target_code_component(Context, raw_target_code(CodeString)) -->
+	mlds_output_context(Context),
+	io__write_string(CodeString).
+mlds_output_target_code_component(Context, target_code_input(Rval)) -->
+	mlds_output_context(Context),
+	mlds_output_rval(Rval).
+mlds_output_target_code_component(Context, target_code_output(Lval)) -->
+	mlds_output_context(Context),
+	mlds_output_lval(Lval).
 
 :- pred mlds_output_init_args(list(mlds__rval), list(mlds__type), mlds__context,
 		int, mlds__lval, mlds__tag, indent, io__state, io__state).
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.6
diff -u -d -r1.6 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2000/04/18 16:41:53	1.6
+++ compiler/ml_elim_nested.m	2000/05/25 05:36:16
@@ -758,7 +758,25 @@
 	fixup_rval(Rval0, Rval).
 fixup_atomic_stmt(trail_op(TrailOp0), trail_op(TrailOp)) -->
 	fixup_trail_op(TrailOp0, TrailOp).
-fixup_atomic_stmt(target_code(Lang, String), target_code(Lang, String)) --> [].
+fixup_atomic_stmt(target_code(Lang, Components0),
+		target_code(Lang, Components)) -->
+	list__map_foldl(fixup_target_code_component,
+		Components0, Components).
+
+:- pred fixup_target_code_component(target_code_component,
+		target_code_component, elim_info, elim_info).
+:- mode fixup_target_code_component(in, out, in, out) is det.
+
+fixup_target_code_component(raw_target_code(Code),
+		raw_target_code(Code)) --> [].
+fixup_target_code_component(user_target_code(Code, Context),
+		user_target_code(Code, Context)) --> [].
+fixup_target_code_component(target_code_input(Rval0),
+		target_code_input(Rval)) -->
+	fixup_rval(Rval0, Rval).
+fixup_target_code_component(target_code_output(Lval0),
+		target_code_output(Lval)) -->
+	fixup_lval(Lval0, Lval).
 
 :- pred fixup_trail_op(trail_op, trail_op, elim_info, elim_info).
 :- mode fixup_trail_op(in, out, in, out) is det.

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------