[m-dev.] diff: MLDS function calling convention

[Fergus Henderson]

Estimated hours taken: 6

Change the MLDS calling convention so that for model_det Mercury functions
with output mode results, the function results get mapped to MLDS function
return values rather than to by-ref parameters.  The rationale for this is
to make interoperability simpler (especially for the IL & Java back-ends).

compiler/lambda.m:
	Change the rules for compatibility of closures so that for
	MLDS grades function closures are not treated as compatible
	with predicate closures.

compiler/ml_code_util.m:
	Change ml_gen_params so that it takes a pred_or_func parameter, and
	for model_det functions it maps the output-moded function results
	to MLDS return values.

compiler/ml_code_gen.m:
	For model_det functions with output mode results,
	return the function result by value.
	Rename the `output_vars' field of the ml_gen_info as
	`byref_output_vars'.

compiler/ml_call_gen.m:
	Pass down the pred_or_func parameter to ml_gen_params.
	For calls to model_det functions with output mode results,
	return the function result by value.

compiler/hlds_goal.m:
	Add new predicate generic_call_pred_or_func, for use by ml_call_gen.m.

compiler/ml_unify_gen.m:
	Modify the code for generating wrapper functions for closures so
	that it reflects the new calling convention for Mercury functions.

compiler/mlds.m:
compiler/mlds_to_c.m:
compiler/ml_code_gen.m:
	Don't handle model_det functions with output mode results specially
	in `pragma export' anymore, since the internal MLDS form now
	has the same prototype as the exported one.

Workspace: /home/pgrad/fjh/fs/roy/traveller/mercury
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.78
diff -u -d -r1.78 hlds_goal.m
--- compiler/hlds_goal.m	2000/10/13 04:04:31	1.78
+++ compiler/hlds_goal.m	2000/10/26 02:31:52
@@ -225,6 +225,8 @@
 		)
 	.
 
+:- func generic_call_pred_or_func(generic_call) = pred_or_func.
+
 	% Builtin Aditi operations. 
 :- type aditi_builtin
 	--->
@@ -1614,6 +1616,15 @@
 	instmap_delta_init_reachable(InstMapDelta0),
 	instmap_delta_insert(InstMapDelta0, Var, Inst, InstMapDelta),
 	goal_info_init(NonLocals, InstMapDelta, det, GoalInfo).
+
+generic_call_pred_or_func(higher_order(_, PredOrFunc, _)) = PredOrFunc.
+generic_call_pred_or_func(class_method(_, _, _, CallId)) =
+	simple_call_id_pred_or_func(CallId).
+generic_call_pred_or_func(aditi_builtin(_, CallId)) =
+	simple_call_id_pred_or_func(CallId).
+
+:- func simple_call_id_pred_or_func(simple_call_id) = pred_or_func.
+simple_call_id_pred_or_func(PredOrFunc - _) = PredOrFunc.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.67
diff -u -d -r1.67 lambda.m
--- compiler/lambda.m	2000/10/13 13:55:31	1.67
+++ compiler/lambda.m	2000/10/26 03:29:30
@@ -395,21 +395,32 @@
 			list__member(InitialVar, Vars)
 		),
 
-		proc_info_interface_code_model(Call_ProcInfo, Call_CodeModel),
-		determinism_to_code_model(Detism, CodeModel),
 			% Check that the code models are compatible.
 			% Note that det is not compatible with semidet,
 			% and semidet is not compatible with nondet,
 			% since the calling conventions are different.
-			% But if we're using the LLDS back-end
+			% If we're using the LLDS back-end
 			% (i.e. not --high-level-code),
 			% det is compatible with nondet.
-		( CodeModel = Call_CodeModel
-		; CodeModel = model_non, Call_CodeModel = model_det,
-			module_info_globals(ModuleInfo0, Globals),
-			globals__lookup_bool_option(Globals,
-				highlevel_code, no)
+			% If we're using the MLDS back-end,
+			% then predicates and functions have different
+			% calling conventions.
+		proc_info_interface_code_model(Call_ProcInfo, Call_CodeModel),
+		determinism_to_code_model(Detism, CodeModel),
+		module_info_globals(ModuleInfo0, Globals),
+		globals__lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+		(
+			HighLevelCode = no,
+			( CodeModel = Call_CodeModel
+			; CodeModel = model_non, Call_CodeModel = model_det
+			)
+		;
+			HighLevelCode = yes,
+			pred_info_get_is_pred_or_func(Call_PredInfo, Call_PredOrFunc),
+			PredOrFunc = Call_PredOrFunc,
+			CodeModel = Call_CodeModel
 		),
+			
 			% check that the curried arguments are all input
 		proc_info_argmodes(Call_ProcInfo, Call_ArgModes),
 		list__length(InitialVars, NumInitialVars),
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.16
diff -u -d -r1.16 ml_call_gen.m
--- compiler/ml_call_gen.m	2000/10/22 09:17:56	1.16
+++ compiler/ml_call_gen.m	2000/10/28 05:00:38
@@ -135,8 +135,9 @@
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
 	{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
 	{ ArgNames = ml_gen_var_names(VarSet, ArgVars) },
+	{ PredOrFunc = generic_call_pred_or_func(GenericCall) },
 	{ Params0 = ml_gen_params(ModuleInfo, ArgNames,
-		BoxedArgTypes, ArgModes, CodeModel) },
+		BoxedArgTypes, ArgModes, PredOrFunc, CodeModel) },
 
 	%
 	% insert the `closure_arg' parameter
@@ -201,7 +202,7 @@
 	ml_gen_var_list(ArgVars, ArgLvals),
 	ml_variable_types(ArgVars, ActualArgTypes),
 	ml_gen_arg_list(ArgNames, ArgLvals, ActualArgTypes, BoxedArgTypes,
-		ArgModes, CodeModel, Context,
+		ArgModes, PredOrFunc, CodeModel, Context,
 		InputRvals, OutputLvals, OutputTypes,
 		ConvArgDecls, ConvOutputStatements),
 	{ ClosureRval = unop(unbox(ClosureArgType), lval(ClosureLval)) },
@@ -303,6 +304,7 @@
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
 	{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
 		PredInfo, ProcInfo) },
+	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 	{ pred_info_arg_types(PredInfo, PredArgTypes) },
 	{ proc_info_argmodes(ProcInfo, ArgModes) },
 
@@ -312,7 +314,7 @@
 	% to pass as the function call's arguments and return values
 	%
 	ml_gen_arg_list(ArgNames, ArgLvals, ActualArgTypes, PredArgTypes,
-		ArgModes, CodeModel, Context,
+		ArgModes, PredOrFunc, CodeModel, Context,
 		InputRvals, OutputLvals, OutputTypes,
 		ConvArgDecls, ConvOutputStatements),
 
@@ -536,14 +538,16 @@
 % Generate rvals and lvals for the arguments of a procedure call
 %
 :- pred ml_gen_arg_list(list(var_name), list(mlds__lval), list(prog_type),
-		list(prog_type), list(mode), code_model, prog_context,
-		list(mlds__rval), list(mlds__lval), list(mlds__type),
-		mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
-:- mode ml_gen_arg_list(in, in, in, in, in, in, in, out, out, out, out, out,
+		list(prog_type), list(mode), pred_or_func, code_model,
+		prog_context, list(mlds__rval), list(mlds__lval),
+		list(mlds__type), mlds__defns, mlds__statements,
+		ml_gen_info, ml_gen_info).
+:- mode ml_gen_arg_list(in, in, in, in, in, in, in, in, out, out, out, out, out,
 		in, out) is det.
 
-ml_gen_arg_list(VarNames, VarLvals, CallerTypes, CalleeTypes, Modes, CodeModel,
-		Context, InputRvals, OutputLvals, OutputTypes,
+ml_gen_arg_list(VarNames, VarLvals, CallerTypes, CalleeTypes, Modes,
+		PredOrFunc, CodeModel, Context,
+		InputRvals, OutputLvals, OutputTypes,
 		ConvDecls, ConvOutputStatements) -->
 	(
 		{ VarNames = [] },
@@ -565,11 +569,13 @@
 		{ Modes = [Mode | Modes1] }
 	->
 		ml_gen_arg_list(VarNames1, VarLvals1,
-			CallerTypes1, CalleeTypes1, Modes1, CodeModel, Context,
+			CallerTypes1, CalleeTypes1, Modes1,
+			PredOrFunc, CodeModel, Context,
 			InputRvals1, OutputLvals1, OutputTypes1,
 			ConvDecls1, ConvOutputStatements1),
 		=(MLDSGenInfo),
 		{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+		{ mode_to_arg_mode(ModuleInfo, Mode, CalleeType, ArgMode) },
 		(
 			{ type_util__is_dummy_argument_type(CalleeType) }
 		->
@@ -581,7 +587,7 @@
 			{ OutputTypes = OutputTypes1 },
 			{ ConvDecls = ConvDecls1 },
 			{ ConvOutputStatements = ConvOutputStatements1 }
-		; { mode_to_arg_mode(ModuleInfo, Mode, CalleeType, top_in) } ->
+		; { ArgMode = top_in } ->
 			%
 			% it's an input argument
 			%
@@ -618,11 +624,24 @@
 			ml_gen_info_get_globals(Globals),
 			{ CopyOut = get_copy_out_option(Globals, CodeModel) },
 			(
-				%
-				% if the target language allows multiple
-				% return values, then use them
-				%
-				{ CopyOut = yes }
+				(
+					%
+					% if the target language allows
+					% multiple return values, then use them
+					%
+					{ CopyOut = yes }
+				;
+					%
+					% if this is the result argument 
+					% of a model_det function, and it has
+					% an output mode, then return it as a
+					% value
+					%
+					{ VarNames1 = [] },
+					{ CodeModel = model_det },
+					{ PredOrFunc = function },
+					{ ArgMode = top_out }
+				)
 			->
 				{ InputRvals = InputRvals1 },
 				{ OutputLvals = [ArgLval | OutputLvals1] },
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.62
diff -u -d -r1.62 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/10/22 15:57:36	1.62
+++ compiler/ml_code_gen.m	2000/10/28 21:48:44
@@ -778,28 +778,22 @@
 		MLDS_Name, MLDS_ModuleName),
 	MLDS_FuncParams = ml_gen_proc_params(ModuleInfo, PredId, ProcId),
 	MLDS_Context = mlds__make_context(ProgContext),
-
-	(
-		is_output_det_function(ModuleInfo, PredId, ProcId)
-	->
-		IsOutDetFunc = yes
-	;
-		IsOutDetFunc = no
-	),
-
 	ML_Defn = ml_pragma_export(C_Name, qual(MLDS_ModuleName, MLDS_Name),
-			MLDS_FuncParams, MLDS_Context, IsOutDetFunc).
+			MLDS_FuncParams, MLDS_Context).
 
 
 	%
-	% Test to see if the procedure is of the following form
-	%   :- func <name>(...) = V::out is det.
-	% as these need to handled specially.
+	% Test to see if the procedure is 
+	% a model_det function whose function result has an output mode
+	% (whose type is not a dummy argument type like io__state),
+	% and if so, bind RetVar to the procedure's return value.
+	% These procedures need to handled specially: for such functions,
+	% we map the Mercury function result to an MLDS return value.
 	%
-:- pred is_output_det_function(module_info, pred_id, proc_id).
-:- mode is_output_det_function(in, in, in) is semidet.
+:- pred is_output_det_function(module_info, pred_id, proc_id, prog_var).
+:- mode is_output_det_function(in, in, in, out) is semidet.
 
-is_output_det_function(ModuleInfo, PredId, ProcId) :-
+is_output_det_function(ModuleInfo, PredId, ProcId, RetArgVar) :-
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo,
 			ProcInfo),
 	
@@ -808,9 +802,11 @@
 
 	proc_info_argmodes(ProcInfo, Modes),
 	pred_info_arg_types(PredInfo, ArgTypes),
+	proc_info_headvars(ProcInfo, ArgVars),
 	modes_to_arg_modes(ModuleInfo, Modes, ArgTypes, ArgModes),
 	pred_args_to_func_args(ArgModes, _InputArgModes, RetArgMode),
 	pred_args_to_func_args(ArgTypes, _InputArgTypes, RetArgType),
+	pred_args_to_func_args(ArgVars, _InputArgVars, RetArgVar),
 
 	RetArgMode = top_out,
 	\+ type_util__is_dummy_argument_type(RetArgType).
@@ -984,13 +980,29 @@
 	MLDSGenInfo0 = ml_gen_info_init(ModuleInfo, PredId, ProcId),
 	MLDS_Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId),
 
+	% Set up the initial success continuation, if any.
+	% Also figure out which output variables are returned by
+	% value (rather than being passed by reference) and remove
+	% them from the byref_output_vars field in the ml_gen_info.
 	( CodeModel = model_non ->
-		% set up the initial success continuation
-		ml_set_up_initial_succ_cont(ModuleInfo, NondetCopiedOutputVars,
-			MLDSGenInfo0, MLDSGenInfo2)
+		ml_set_up_initial_succ_cont(ModuleInfo, CopiedOutputVars,
+			MLDSGenInfo0, MLDSGenInfo1)
 	;
-		NondetCopiedOutputVars = [],
-		MLDSGenInfo2 = MLDSGenInfo0
+		(
+			is_output_det_function(ModuleInfo, PredId, ProcId,
+				ResultVar)
+		->
+			CopiedOutputVars = [ResultVar],
+			ml_gen_info_get_byref_output_vars(MLDSGenInfo0,
+				ByRefOutputVars0),
+			list__delete_all(ByRefOutputVars0,
+				ResultVar, ByRefOutputVars),
+			ml_gen_info_set_byref_output_vars(ByRefOutputVars,	
+				MLDSGenInfo0, MLDSGenInfo1)
+		;
+			CopiedOutputVars = [],
+			MLDSGenInfo1 = MLDSGenInfo0
+		)
 	),
 
 	% This would generate all the local variables at the top of the
@@ -999,23 +1011,29 @@
 	% 		VarTypes, HeadVars, ModuleInfo),
 	% But instead we now generate them locally for each goal.
 	% We just declare the `succeeded' var here,
-	% plus, if --nondet-copy-out is enabled,
-	% locals for the output arguments.
+	% plus locals for any output arguments that are returned by value
+	% (e.g. if --nondet-copy-out is enabled, or for det function return
+	% values).
 	MLDS_Context = mlds__make_context(Context),
-	( NondetCopiedOutputVars = [] ->
+	( CopiedOutputVars = [] ->
 		% optimize common case
 		OutputVarLocals = []
 	;
 		proc_info_varset(ProcInfo, VarSet),
 		proc_info_vartypes(ProcInfo, VarTypes),
-		OutputVarLocals = ml_gen_local_var_decls(VarSet, VarTypes,
-			MLDS_Context, ModuleInfo, NondetCopiedOutputVars)
+		% note that for headvars we must use the types from
+		% the procedure interface, not from the procedure body
+		HeadVarTypes = map__from_corresponding_lists(HeadVars,
+			ArgTypes),
+		OutputVarLocals = ml_gen_local_var_decls(VarSet,
+			map__overlay(VarTypes, HeadVarTypes),
+			MLDS_Context, ModuleInfo, CopiedOutputVars)
 	),
 	MLDS_LocalVars = [ml_gen_succeeded_var_decl(MLDS_Context) |
 			OutputVarLocals],
-	ml_gen_proc_body(CodeModel, HeadVars, ArgTypes, Goal,
+	ml_gen_proc_body(CodeModel, HeadVars, ArgTypes, CopiedOutputVars, Goal,
 			MLDS_Decls0, MLDS_Statements,
-			MLDSGenInfo2, MLDSGenInfo),
+			MLDSGenInfo1, MLDSGenInfo),
 	ml_gen_info_get_extra_defns(MLDSGenInfo, ExtraDefns),
 	MLDS_Decls = list__append(MLDS_LocalVars, MLDS_Decls0),
 	MLDS_Statement = ml_gen_block(MLDS_Decls, MLDS_Statements, Context),
@@ -1035,9 +1053,9 @@
 		% for the output variables and then pass them to the
 		% continuation, rather than passing them by reference.
 		=(MLDSGenInfo0),
-		{ ml_gen_info_get_output_vars(MLDSGenInfo0,
+		{ ml_gen_info_get_byref_output_vars(MLDSGenInfo0,
 			NondetCopiedOutputVars) },
-		ml_gen_info_set_output_vars([])
+		ml_gen_info_set_byref_output_vars([])
 	;
 		{ NondetCopiedOutputVars = [] }
 	),
@@ -1092,11 +1110,11 @@
 	% Generate the code for a procedure body.
 	%
 :- pred ml_gen_proc_body(code_model, list(prog_var), list(prog_type),
-		hlds_goal, mlds__defns, mlds__statements,
+		list(prog_var), hlds_goal, mlds__defns, mlds__statements,
 		ml_gen_info, ml_gen_info).
-:- mode ml_gen_proc_body(in, in, in, in, out, out, in, out) is det.
+:- mode ml_gen_proc_body(in, in, in, in, in, out, out, in, out) is det.
 
-ml_gen_proc_body(CodeModel, HeadVars, ArgTypes, Goal,
+ml_gen_proc_body(CodeModel, HeadVars, ArgTypes, CopiedOutputVars, Goal,
 		MLDS_Decls, MLDS_Statements) -->
 	{ Goal = _ - GoalInfo },
 	{ goal_info_get_context(GoalInfo, Context) },
@@ -1111,8 +1129,12 @@
 	% or unification/compare procedures for equivalence types --
 	% the parameters types may not match the types of the head variables.
 	% In such cases, we need to box/unbox/cast them to the right type.
+	% We also grab the original (uncast) lvals for the copied output
+	% variables (if any) here, since for the return statement that
+	% we append below, we want the original vars, not their cast versions.
 	%
-	ml_gen_convert_headvars(HeadVars, ArgTypes, Context,
+	ml_gen_var_list(CopiedOutputVars, CopiedOutputVarOriginalLvals),
+	ml_gen_convert_headvars(HeadVars, ArgTypes, CopiedOutputVars, Context,
 		ConvDecls, ConvInputStatements, ConvOutputStatements),
 	(
 		{ ConvDecls = [] },
@@ -1144,16 +1166,8 @@
 	%
 	% Finally append an appropriate `return' statement, if needed.
 	%
-	( { CodeModel = model_semi } ->
-		ml_gen_test_success(Succeeded),
-		{ ReturnStmt = return([Succeeded]) },
-		{ ReturnStatement = mlds__statement(ReturnStmt,
-			mlds__make_context(Context)) },
-		{ MLDS_Statements = list__append(MLDS_Statements1,
-			[ReturnStatement]) }
-	;
-		{ MLDS_Statements = MLDS_Statements1 }
-	).
+	ml_append_return_statement(CodeModel, CopiedOutputVarOriginalLvals,
+		Context, MLDS_Statements1, MLDS_Statements).
 
 %
 % In certain cases -- for example existentially typed procedures,
@@ -1162,13 +1176,14 @@
 % In such cases, we need to box/unbox/cast them to the right type.
 % This procedure handles that.
 %
-:- pred ml_gen_convert_headvars(list(prog_var), list(prog_type), prog_context,
+:- pred ml_gen_convert_headvars(list(prog_var), list(prog_type),
+		list(prog_var), prog_context,
 		mlds__defns, mlds__statements, mlds__statements,
 		ml_gen_info, ml_gen_info).
-:- mode ml_gen_convert_headvars(in, in, in, out, out, out, in, out) is det.
+:- mode ml_gen_convert_headvars(in, in, in, in, out, out, out, in, out) is det.
 
-ml_gen_convert_headvars([], [], _, [], [], []) --> [].
-ml_gen_convert_headvars([Var|Vars], [HeadType|HeadTypes],
+ml_gen_convert_headvars([], [], _, _, [], [], []) --> [].
+ml_gen_convert_headvars([Var|Vars], [HeadType|HeadTypes], CopiedOutputVars,
 		Context, Decls, InputStatements, OutputStatements) -->
 	ml_variable_type(Var, BodyType),
 	(
@@ -1181,8 +1196,8 @@
 		{ map__is_empty(Subst) }
 	->
 		% just recursively process the remaining arguments
-		ml_gen_convert_headvars(Vars, HeadTypes, Context,
-				Decls, InputStatements, OutputStatements)
+		ml_gen_convert_headvars(Vars, HeadTypes, CopiedOutputVars,
+			Context, Decls, InputStatements, OutputStatements)
 	;
 		%
 		% generate the lval for the head variable
@@ -1210,15 +1225,20 @@
 		%
 		% Recursively process the remaining arguments
 		%
-		ml_gen_convert_headvars(Vars, HeadTypes, Context,
-				Decls1, InputStatements1, OutputStatements1),
+		ml_gen_convert_headvars(Vars, HeadTypes, CopiedOutputVars,
+			Context, Decls1, InputStatements1, OutputStatements1),
 
 		%
 		% Add the code to convert this input or output.
 		%
 		=(MLDSGenInfo2),
-		{ ml_gen_info_get_output_vars(MLDSGenInfo2, OutputVars) },
-		{ list__member(Var, OutputVars) ->
+		{ ml_gen_info_get_byref_output_vars(MLDSGenInfo2,
+			ByRefOutputVars) },
+		{
+			( list__member(Var, ByRefOutputVars)
+			; list__member(Var, CopiedOutputVars)
+			)
+		->
 			InputStatements = InputStatements1,
 			OutputStatements = list__append(OutputStatements1,
 				ConvOutputStatements)
@@ -1229,9 +1249,9 @@
 		},
 		{ list__append(ConvDecls, Decls1, Decls) }
 	).
-ml_gen_convert_headvars([], [_|_], _, _, _, _) -->
+ml_gen_convert_headvars([], [_|_], _, _, _, _, _) -->
 	{ error("ml_gen_convert_headvars: length mismatch") }.
-ml_gen_convert_headvars([_|_], [], _, _, _, _) -->
+ml_gen_convert_headvars([_|_], [], _, _, _, _, _) -->
 	{ error("ml_gen_convert_headvars: length mismatch") }.
 
 %-----------------------------------------------------------------------------%
@@ -1591,8 +1611,9 @@
 	( { NondetCopyOut = yes } ->
 		{ goal_info_get_context(GoalInfo, Context) },
 		{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
-		{ ml_gen_info_get_output_vars(MLDSGenInfo0, OutputVars) },
-		{ VarsToCopy = set__intersect(set__list_to_set(OutputVars),
+		{ ml_gen_info_get_byref_output_vars(MLDSGenInfo0,
+			ByRefOutputVars) },
+		{ VarsToCopy = set__intersect(set__list_to_set(ByRefOutputVars),
 			NonLocals) },
 		ml_gen_make_locals_for_output_args(
 			set__to_sorted_list(VarsToCopy), Context,
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.26
diff -u -d -r1.26 ml_code_util.m
--- compiler/ml_code_util.m	2000/10/22 13:57:37	1.26
+++ compiler/ml_code_util.m	2000/10/28 21:49:41
@@ -32,6 +32,14 @@
 	% Generate an MLDS assignment statement.
 :- func ml_gen_assign(mlds__lval, mlds__rval, prog_context) = mlds__statement.
 
+	%
+	% Append an appropriate `return' statement for the given code_model
+	% and returning the given lvals, if needed.
+	%
+:- pred ml_append_return_statement(code_model, list(mlds__lval), prog_context,
+		mlds__statements, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_append_return_statement(in, in, in, in, out, in, out) is det.
+
 	% Generate a block statement, i.e. `{ <Decls>; <Statements>; }'.
 	% But if the block consists only of a single statement with no
 	% declarations, then just return that statement.
@@ -115,7 +123,7 @@
 	% given argument types, modes, and code model.
 	%
 :- func ml_gen_params(module_info, list(string), list(prog_type),
-		list(mode), code_model) = mlds__func_params.
+		list(mode), pred_or_func, code_model) = mlds__func_params.
 
 	% Given a list of variables and their corresponding modes,
 	% return a list containing only those variables which have
@@ -456,11 +464,12 @@
 :- pred ml_gen_info_get_var_types(ml_gen_info, map(prog_var, prog_type)).
 :- mode ml_gen_info_get_var_types(in, out) is det.
 
-:- pred ml_gen_info_get_output_vars(ml_gen_info, list(prog_var)).
-:- mode ml_gen_info_get_output_vars(in, out) is det.
+:- pred ml_gen_info_get_byref_output_vars(ml_gen_info, list(prog_var)).
+:- mode ml_gen_info_get_byref_output_vars(in, out) is det.
 
-:- pred ml_gen_info_set_output_vars(list(prog_var), ml_gen_info, ml_gen_info).
-:- mode ml_gen_info_set_output_vars(in, in, out) is det.
+:- pred ml_gen_info_set_byref_output_vars(list(prog_var),
+		ml_gen_info, ml_gen_info).
+:- mode ml_gen_info_set_byref_output_vars(in, in, out) is det.
 
 :- pred ml_gen_info_get_globals(globals, ml_gen_info, ml_gen_info).
 :- mode ml_gen_info_get_globals(out, in, out) is det.
@@ -639,6 +648,31 @@
 	MLDS_Statement = mlds__statement(MLDS_Stmt,
 		mlds__make_context(Context)).
 
+	%
+	% Append an appropriate `return' statement for the given code_model
+	% and returning the given OutputVarLvals, if needed.
+	%
+ml_append_return_statement(CodeModel, CopiedOutputVarLvals, Context,
+		MLDS_Statements0, MLDS_Statements) -->
+	( { CodeModel = model_semi } ->
+		ml_gen_test_success(Succeeded),
+		{ ReturnStmt = return([Succeeded]) },
+		{ ReturnStatement = mlds__statement(ReturnStmt,
+			mlds__make_context(Context)) },
+		{ MLDS_Statements = list__append(MLDS_Statements0,
+			[ReturnStatement]) }
+	; { CodeModel \= model_non, CopiedOutputVarLvals \= [] } ->
+		{ CopiedOutputVarRvals = list__map(func(Lval) = lval(Lval),
+			CopiedOutputVarLvals) },
+		{ ReturnStmt = return(CopiedOutputVarRvals) },
+		{ ReturnStatement = mlds__statement(ReturnStmt,
+			mlds__make_context(Context)) },
+		{ MLDS_Statements = list__append(MLDS_Statements0,
+			[ReturnStatement]) }
+	;
+		{ MLDS_Statements = MLDS_Statements0 }
+	).
+
 	% Generate a block statement, i.e. `{ <Decls>; <Statements>; }'.
 	% But if the block consists only of a single statement with no
 	% declarations, then just return that statement.
@@ -859,12 +893,13 @@
 		PredInfo, ProcInfo),
 	proc_info_varset(ProcInfo, VarSet),
 	proc_info_headvars(ProcInfo, HeadVars),
+	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
 	pred_info_arg_types(PredInfo, HeadTypes),
 	proc_info_argmodes(ProcInfo, HeadModes),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
 	FuncParams = ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes,
-		HeadModes, CodeModel).
+		HeadModes, PredOrFunc, CodeModel).
 
 	% As above, but from the rtti_proc_id rather than
 	% from the module_info, pred_id, and proc_id.
@@ -874,41 +909,74 @@
 	HeadVars = RttiProcId^proc_headvars,
 	ArgTypes = RttiProcId^arg_types,
 	ArgModes = RttiProcId^proc_arg_modes,
+	PredOrFunc = RttiProcId^pred_or_func,
 	CodeModel = RttiProcId^proc_interface_code_model,
 	HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
 	FuncParams = ml_gen_params_base(ModuleInfo, HeadVarNames,
-		ArgTypes, ArgModes, CodeModel).
+		ArgTypes, ArgModes, PredOrFunc, CodeModel).
 	
 	% Generate the function prototype for a procedure with the
 	% given argument types, modes, and code model.
 	%
-ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, CodeModel) =
-		FuncParams :-
+ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, PredOrFunc,
+		CodeModel) = FuncParams :-
 	modes_to_arg_modes(ModuleInfo, HeadModes, HeadTypes, ArgModes),
 	FuncParams = ml_gen_params_base(ModuleInfo, HeadVarNames,
-		HeadTypes, ArgModes, CodeModel).
+		HeadTypes, ArgModes, PredOrFunc, CodeModel).
 
 :- func ml_gen_params_base(module_info, list(string), list(prog_type),
-		list(arg_mode), code_model) = mlds__func_params.
+		list(arg_mode), pred_or_func, code_model) = mlds__func_params.
 
 ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
-		CodeModel) = FuncParams :-
+		PredOrFunc, CodeModel) = FuncParams :-
 	module_info_globals(ModuleInfo, Globals),
 	CopyOut = get_copy_out_option(Globals, CodeModel),
 	ml_gen_arg_decls(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
 		CopyOut, FuncArgs0, RetTypes0),
-	( CodeModel = model_semi ->
+	(
+		CodeModel = model_det,
+		%
+		% for model_det Mercury functions whose result argument has an
+		% output mode, make the result into the MLDS return type
+		%
+		(
+			RetTypes0 = [],
+			PredOrFunc = function,
+			pred_args_to_func_args(HeadModes, _, ResultMode),
+			ResultMode = top_out,
+			pred_args_to_func_args(HeadTypes, _, ResultType),
+			\+ type_util__is_dummy_argument_type(ResultType)
+		->
+			pred_args_to_func_args(FuncArgs0, FuncArgs,
+				_RetArgName - RetTypePtr),
+			( RetTypePtr = mlds__ptr_type(RetType) ->
+				RetTypes = [RetType]
+			;
+				error("output mode function result doesn't have pointer type")
+			)
+		;
+			FuncArgs = FuncArgs0,
+			RetTypes = RetTypes0
+		)
+	;
+		CodeModel = model_semi,
+		%
+		% for model_semi procedures, return a bool
+		%
+		FuncArgs = FuncArgs0,
 		RetTypes = [mlds__native_bool_type | RetTypes0]
-	; CodeModel = model_non, CopyOut = yes ->
-		RetTypes = []
 	;
-		RetTypes = RetTypes0
-	),
-	( CodeModel = model_non ->
+		CodeModel = model_non,
+		%
+		% for model_non procedures, we return values
+		% by passing them to the continuation
+		%
 		( CopyOut = yes ->
-			ContType = mlds__cont_type(RetTypes0)
+			ContType = mlds__cont_type(RetTypes0),
+			RetTypes = []
 		;
-			ContType = mlds__cont_type([])
+			ContType = mlds__cont_type([]),
+			RetTypes = RetTypes0
 		),
 		ContName = data(var("cont")),
 		ContArg = ContName - ContType,
@@ -925,8 +993,6 @@
 			FuncArgs = list__append(FuncArgs0,
 				[ContArg, ContEnvArg])
 		)
-	;
-		FuncArgs = FuncArgs0
 	),
 	FuncParams = mlds__func_params(FuncArgs, RetTypes).
 
@@ -1186,9 +1252,9 @@
 		{ VarName = ml_gen_var_name(VarSet, Var) },
 		ml_qualify_var(VarName, VarLval),
 		%
-		% output variables are passed by reference...
+		% output variables may be passed by reference...
 		%
-		{ ml_gen_info_get_output_vars(MLDSGenInfo, OutputVars) },
+		{ ml_gen_info_get_byref_output_vars(MLDSGenInfo, OutputVars) },
 		( { list__member(Var, OutputVars) } ->
 			ml_gen_type(Type, MLDS_Type),
 			{ Lval = mem_ref(lval(VarLval), MLDS_Type) }
@@ -1602,7 +1668,9 @@
 			proc_id :: proc_id,
 			varset :: prog_varset,
 			var_types :: map(prog_var, prog_type),
-			output_vars :: list(prog_var),	% output arguments
+			byref_output_vars :: list(prog_var),
+				% output arguments that are passed by
+				% reference
 
 			%
 			% these fields get updated as we traverse
@@ -1634,7 +1702,7 @@
 	proc_info_varset(ProcInfo, VarSet),
 	proc_info_vartypes(ProcInfo, VarTypes),
 	proc_info_argmodes(ProcInfo, HeadModes),
-	OutputVars = select_output_vars(ModuleInfo, HeadVars, HeadModes,
+	ByRefOutputVars = select_output_vars(ModuleInfo, HeadVars, HeadModes,
 		VarTypes),
 
 	FuncLabelCounter = 0,
@@ -1653,7 +1721,7 @@
 			ProcId,
 			VarSet,
 			VarTypes,
-			OutputVars,
+			ByRefOutputVars,
 			FuncLabelCounter,
 			CommitLabelCounter,
 			CondVarCounter,
@@ -1675,8 +1743,9 @@
 ml_gen_info_get_proc_id(Info, Info^proc_id).
 ml_gen_info_get_varset(Info, Info^varset).
 ml_gen_info_get_var_types(Info, Info^var_types).
-ml_gen_info_get_output_vars(Info, Info^output_vars).
-ml_gen_info_set_output_vars(OutputVars, Info, Info^output_vars := OutputVars).
+ml_gen_info_get_byref_output_vars(Info, Info^byref_output_vars).
+ml_gen_info_set_byref_output_vars(OutputVars, Info,
+		Info^byref_output_vars := OutputVars).
 
 ml_gen_info_use_gcc_nested_functions(UseNestedFuncs) -->
 	ml_gen_info_get_globals(Globals),
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.36
diff -u -d -r1.36 mlds.m
--- compiler/mlds.m	2000/10/22 07:27:19	1.36
+++ compiler/mlds.m	2000/10/28 04:43:09
@@ -628,9 +628,7 @@
 		string,			% Exported name
 		mlds__qualified_entity_name, % MLDS name for exported entity
 		mlds__func_params,	% MLDS function parameters
-		mlds__context,
-		bool			% is a det function with the
-					% final args mode top_out.
+		mlds__context
 	).
 
 
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.59
diff -u -d -r1.59 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/10/22 13:57:37	1.59
+++ compiler/mlds_to_c.m	2000/10/28 21:23:47
@@ -472,21 +472,14 @@
 
 mlds_output_pragma_export_defn(ModuleName, Indent, PragmaExport) -->
 	{ PragmaExport = ml_pragma_export(_C_name, MLDS_Name, MLDS_Signature,
-			Context, IsFunc) },
+			Context) },
 	mlds_output_pragma_export_func_name(ModuleName, Indent, PragmaExport),
 	io__write_string("\n"),
 	mlds_indent(Context, Indent),
 	io__write_string("{\n"),
 	mlds_indent(Context, Indent),
-	(
-		{ IsFunc = yes },
-		mlds_output_pragma_export_func_defn_body(ModuleName, MLDS_Name,
-				MLDS_Signature)
-	;
-		{ IsFunc = no },
-		mlds_output_pragma_export_defn_body(ModuleName, MLDS_Name,
-				MLDS_Signature)
-	),
+	mlds_output_pragma_export_defn_body(ModuleName, MLDS_Name,
+				MLDS_Signature),
 	io__write_string("}\n").
 
 :- pred mlds_output_pragma_export_func_name(mlds_module_name, indent,
@@ -494,15 +487,7 @@
 :- mode mlds_output_pragma_export_func_name(in, in, in, di, uo) is det.
 
 mlds_output_pragma_export_func_name(ModuleName, Indent,
-		ml_pragma_export(C_name, _MLDS_Name, Signature0, Context,
-			IsFunc)) -->
-	(
-		{ IsFunc = yes }
-	->
-		{ Signature = det_func_signature(Signature0) }
-	;
-		{ Signature = Signature0 }
-	),
+		ml_pragma_export(C_name, _MLDS_Name, Signature, Context)) -->
 	{ Name = qual(ModuleName, export(C_name)) },
 	mlds_indent(Context, Indent),
 	mlds_output_func_decl_ho(Indent, Name, Context, Signature,
@@ -549,8 +534,7 @@
 	
 
 	%
-	% Output the definition body for a pragma export when it is
-	% *NOT* a det function whose last arg is top_out.
+	% Output the definition body for a pragma export
 	%
 :- pred mlds_output_pragma_export_defn_body(mlds_module_name,
 		mlds__qualified_entity_name, func_params, io__state, io__state).
@@ -578,47 +562,6 @@
 
 
 	%
-	% Output the definition body for a pragma export when it is
-	% det function whose last arg is top_out.
-	%
-:- pred mlds_output_pragma_export_func_defn_body(mlds_module_name,
-		mlds__qualified_entity_name, func_params,
-		io__state, io__state).
-:- mode mlds_output_pragma_export_func_defn_body(in, in, in, di, uo) is det.
-
-mlds_output_pragma_export_func_defn_body(ModuleName, FuncName, Signature) -->
-	{ ExportedSignature = det_func_signature(Signature) },
-	{ ExportedSignature = mlds__func_params(_ExpParameters, ExpRetTypes) },
-	{ Signature = mlds__func_params(Parameters, _RetTypes) },
-
-	( { ExpRetTypes = [ExpRetType0] } ->
-		{ ExpRetType = ExpRetType0 }
-	;
-		{ error("mlds_output_pragma_export_func_defn_body") }
-	),
-
-		% Define a variable to hold the function result.
-	io__write_string("\t"),
-	mlds_output_type_prefix(ExpRetType),
-	io__write_string(" arg"),
-	mlds_output_type_suffix(ExpRetType),
-	io__write_string(";\n"),
-
-		% Call the MLDS function.
-	io__write_string("\t"),
-	mlds_output_fully_qualified_name(FuncName),
-	io__write_string("("),
-	write_func_args(ModuleName, Parameters),
-	io__write_string(");\n"),
-
-		% return the function result.
-	io__write_string("\t"),
-	io__write_string("return ("),
-	mlds_output_pragma_export_type(prefix, ExpRetType),
-	mlds_output_pragma_export_type(suffix, ExpRetType),
-	io__write_string(") arg;\n").
-
-	%
 	% Write out the arguments to the MLDS function.  Note the last
 	% in the list of the arguments is the return value, so it must
 	% be "&arg"
@@ -1985,7 +1928,7 @@
 		io__write_char(' '),
 		mlds_output_rval(Rval)
 	;
-		{ error("mld_output_stmt: multiple return values") }
+		{ error("mlds_output_stmt: multiple return values") }
 	),
 	io__write_string(";\n").
 	
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.21
diff -u -d -r1.21 ml_unify_gen.m
--- compiler/ml_unify_gen.m	2000/10/22 13:57:38	1.21
+++ compiler/ml_unify_gen.m	2000/10/28 21:49:07
@@ -555,7 +555,8 @@
 	=(Info),
 	{ ml_gen_info_get_module_info(Info, ModuleInfo) },
 	{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
-		_PredInfo, ProcInfo) },
+		PredInfo, ProcInfo) },
+	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 	{ proc_info_headvars(ProcInfo, ProcHeadVars) },
 	{ proc_info_argmodes(ProcInfo, ProcArgModes) },
 	{ proc_info_interface_code_model(ProcInfo, CodeModel) },
@@ -596,7 +597,7 @@
 	{ WrapperHeadVarNames = ml_gen_wrapper_head_var_names(1,
 		list__length(WrapperHeadVars)) },
 	{ WrapperParams0 = ml_gen_params(ModuleInfo, WrapperHeadVarNames,
-		WrapperBoxedArgTypes, WrapperArgModes, CodeModel) },
+		WrapperBoxedArgTypes, WrapperArgModes, PredOrFunc, CodeModel) },
 
 	% then insert the `closure_arg' parameter
 	{ ClosureArg = data(var("closure_arg")) - mlds__generic_type },
@@ -607,8 +608,8 @@
 	% also compute the lvals for the parameters,
 	% and local declarations for any --copy-out output parameters
 	ml_gen_wrapper_arg_lvals(WrapperHeadVarNames, WrapperBoxedArgTypes,
-		WrapperArgModes, CodeModel, Context,
-		WrapperHeadVarDecls, WrapperHeadVarLvals),
+		WrapperArgModes, PredOrFunc, CodeModel, Context,
+		WrapperHeadVarDecls, WrapperHeadVarLvals, WrapperCopyOutLvals),
 
 	%
 	% generate code to declare and initialize the closure pointer.
@@ -687,20 +688,18 @@
 
 	%
 	% For semidet code, add the declaration `bool succeeded;'
-	% and the `return succeeded;' statement.
 	%
 	( { CodeModel = model_semi } ->
 		{ SucceededVarDecl = ml_gen_succeeded_var_decl(MLDS_Context) },
-		{ Decls2 = [SucceededVarDecl | Decls1] },
-		ml_gen_test_success(Succeeded),
-		{ ReturnStmt = return([Succeeded]) },
-		{ ReturnStatement = mlds__statement(ReturnStmt, MLDS_Context) },
-		{ Statements = list__append(Statements1, [ReturnStatement]) }
+		{ Decls2 = [SucceededVarDecl | Decls1] }
 	;
-		{ Decls2 = Decls1 },
-		{ Statements = Statements1 }
+		{ Decls2 = Decls1 }
 	),
 
+	% Add an appropriate `return' statement
+	ml_append_return_statement(CodeModel, WrapperCopyOutLvals, Context,
+		Statements1, Statements),
+
 	%
 	% Insert the local declarations of the wrapper's output arguments,
 	% if any (this is needed for `--nondet-copy-out')
@@ -738,8 +737,8 @@
 		Names = [Name | Names1]
 	).
 
-	% ml_gen_wrapper_arg_lvals(HeadVarNames, Types, ArgModes, CodeModel,
-	%		LocalVarDefns, HeadVarLvals):
+	% ml_gen_wrapper_arg_lvals(HeadVarNames, Types, ArgModes,
+	%		PredOrFunc, CodeModel, LocalVarDefns, HeadVarLvals):
 	%	Generate lvals for the specified head variables
 	%	passed in the specified modes.
 	%	Also generate local definitions for output variables,
@@ -747,16 +746,19 @@
 	%	rather than passed by reference.
 	%
 :- pred ml_gen_wrapper_arg_lvals(list(var_name), list(prog_type), list(mode),
-		code_model, prog_context, list(mlds__defn), list(mlds__lval),
+		pred_or_func, code_model, prog_context,
+		list(mlds__defn), list(mlds__lval), list(mlds__lval),
 		ml_gen_info, ml_gen_info).
-:- mode ml_gen_wrapper_arg_lvals(in, in, in, in, in, out, out, in, out) is det.
+:- mode ml_gen_wrapper_arg_lvals(in, in, in, in, in, in, out, out, out, in, out)
+		is det.
 
-ml_gen_wrapper_arg_lvals(Names, Types, Modes, CodeModel, Context,
-		Defns, Lvals) -->
+ml_gen_wrapper_arg_lvals(Names, Types, Modes, PredOrFunc, CodeModel, Context,
+		Defns, Lvals, CopyOutLvals) -->
 	(
 		{ Names = [], Types = [], Modes = [] }
 	->
 		{ Lvals = [] },
+		{ CopyOutLvals = [] },
 		{ Defns = [] }
 	;
 		{ Names = [Name | Names1] },
@@ -764,12 +766,15 @@
 		{ Modes = [Mode | Modes1] }
 	->
 		ml_gen_wrapper_arg_lvals(Names1, Types1, Modes1,
-			CodeModel, Context, Defns1, Lvals1),
+			PredOrFunc, CodeModel, Context,
+			Defns1, Lvals1, CopyOutLvals1),
 		ml_qualify_var(Name, VarLval),
 		=(Info),
 		{ ml_gen_info_get_module_info(Info, ModuleInfo) },
-		( { mode_to_arg_mode(ModuleInfo, Mode, Type, top_in) } ->
+		{ mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode) },
+		( { ArgMode = top_in } ->
 			{ Lval = VarLval },
+			{ CopyOutLvals = CopyOutLvals1 },
 			{ Defns = Defns1 }
 		;
 			%
@@ -777,7 +782,21 @@
 			%
 			ml_gen_info_get_globals(Globals),
 			{ CopyOut = get_copy_out_option(Globals, CodeModel) },
-			( { CopyOut = yes } ->
+			(
+				{
+					CopyOut = yes
+				;
+					% for model_det functions,
+					% output mode function results
+					% are mapped to MLDS return values
+					PredOrFunc = function,
+					CodeModel = model_det,
+					ArgMode = top_out,
+					Types1 = [],
+					\+ type_util__is_dummy_argument_type(
+						Type)
+				}
+			->
 				%
 				% output arguments are copied out,
 				% so we need to generate a local declaration
@@ -785,8 +804,11 @@
 				%
 				{ Lval = VarLval },
 				( { type_util__is_dummy_argument_type(Type) } ->
+					{ CopyOutLvals = CopyOutLvals1 },
 					{ Defns = Defns1 }
 				;
+					{ CopyOutLvals = [Lval |
+						CopyOutLvals1] },
 					ml_gen_local_for_output_arg(Name, Type,
 						Context, Defn),
 					{ Defns = [Defn | Defns1] }
@@ -798,6 +820,7 @@
 				%
 				ml_gen_type(Type, MLDS_Type),
 				{ Lval = mem_ref(lval(VarLval), MLDS_Type) },
+				{ CopyOutLvals = CopyOutLvals1 },
 				{ Defns = Defns1 }
 			)
 		),

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