diff: bug fix

[Simon TAYLOR]

Hi Fergus,

Could you please review this one.

Simon.


Estimated hours taken: 2

Bug fix.

compiler/higher_order.m
	lambda.m reorders the argument variables of lambda
 	expressions so that inputs come before outputs.
	higher_order.m was not doing the reordering before
	replacing a higher_order_call with a call to the lambda
 	expression.

compiler/lambda.m
	Export lambda__permute_argvars for use by higher_order.m.

tests/hard_coded/Mmake
tests/hard_coded/ho_order.m
tests/hard_coded/ho_order.exp
	Regression test.



Index: higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.28
diff -u -r1.28 higher_order.m
--- higher_order.m	1997/06/27 04:01:23	1.28
+++ higher_order.m	1997/07/16 07:09:20
@@ -32,7 +32,7 @@
 
 :- import_module hlds_pred, hlds_goal, hlds_data, instmap.
 :- import_module code_util, globals, make_hlds, mode_util, goal_util.
-:- import_module type_util, options, prog_data, quantification.
+:- import_module type_util, options, prog_data, quantification, (lambda).
 :- import_module mercury_to_mercury.
 
 :- import_module assoc_list, bool, char, int, list, map, require, set.
@@ -532,9 +532,10 @@
 maybe_specialize_higher_order_call(Goal0 - GoalInfo, Goal - GoalInfo,
 		PredProcId, Changed, Info0, Info) :-
 	Info0 = info(PredVars, Requests0, NewPreds, Module),
-	( Goal0 = higher_order_call(PredVar0, Args0, _Types, _Modes, _Det) ->
+	( Goal0 = higher_order_call(PredVar0, Args0, _Types, Modes0, _Det) ->
 		PredVar = PredVar0,
-		Args = Args0
+		Args = Args0,
+		Modes = Modes0
 	;
 		error("higher_order.m: higher_order_call expected")
 	),
@@ -548,7 +549,13 @@
 		pred_info_module(PredInfo, ModuleName),
 		pred_info_name(PredInfo, PredName),
 		code_util__builtin_state(Module, PredId, ProcId, Builtin),
-		list__append(CurriedArgs, Args, AllArgs),
+
+		% We need to permute the arguments so that inputs come before
+		% outputs, since lambda.m will have done that to the arguments
+		% of the closure.
+		lambda__permute_argvars(Args, Modes, Module, PermutedArgs, _),
+
+		list__append(CurriedArgs, PermutedArgs, AllArgs),
 		MaybeContext = no,
 		Goal1 = call(PredId, ProcId, AllArgs,
 			Builtin, MaybeContext,
Index: lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.28
diff -u -r1.28 lambda.m
--- lambda.m	1997/07/01 04:03:54	1.28
+++ lambda.m	1997/07/16 06:59:13
@@ -48,6 +48,11 @@
 :- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in,
 		in, out, out, out) is det.
 
+	% Permute the list of variables so that inputs come before outputs.
+:- pred lambda__permute_argvars(list(var), list(mode), module_info,
+			list(var), list(mode)).
+:- mode lambda__permute_argvars(in, in, in, out, out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -338,7 +343,7 @@
 		% permute the argument variables so that all the inputs
 		% come before all the outputs.
 		
-		permute_argvars(AllArgVars, AllArgModes, ModuleInfo1,
+		lambda__permute_argvars(AllArgVars, AllArgModes, ModuleInfo1,
 			PermutedArgVars, PermutedArgModes),
 		map__apply_to_list(PermutedArgVars, VarTypes, ArgTypes),
 
@@ -401,21 +406,17 @@
 		)
 	).
 
-:- pred permute_argvars(list(var), list(mode), module_info,
-			list(var), list(mode)).
-:- mode permute_argvars(in, in, in, out, out) is det.
-
 	% permute a list of variables and a corresponding list of their modes
 	% so that all the input variables precede all the output variables.
 
-permute_argvars(AllArgVars, AllArgModes, ModuleInfo,
+lambda__permute_argvars(AllArgVars, AllArgModes, ModuleInfo,
 		PermutedArgVars, PermutedArgModes) :-
 	( split_argvars(AllArgVars, AllArgModes, ModuleInfo,
 		InArgVars, InArgModes, OutArgVars, OutArgModes) ->
 		list__append(InArgVars, OutArgVars, PermutedArgVars),
 		list__append(InArgModes, OutArgModes, PermutedArgModes)
 	;
-		error("lambda.m: permute_argvars: split_argvars failed")
+		error("lambda__permute_argvars: split_argvars failed")
 	).
 
 :- pred split_argvars(list(var), list(mode), module_info,




Index: Mmake
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmake,v
retrieving revision 1.50
diff -u -r1.50 Mmake
--- Mmake	1997/07/09 08:21:08	1.50
+++ Mmake	1997/07/16 08:41:31
@@ -32,6 +32,7 @@
 	higher_order_func_test \
 	higher_order_syntax \
 	ho_func_reg \
+	ho_order \
 	ho_solns \
 	ho_univ_to_type \
 	name_mangling \
@@ -56,6 +57,7 @@
 
 MCFLAGS-boyer		=	--infer-all
 MCFLAGS-func_test	=	--infer-all
+MCFLAGS-ho_order	=	--optimize-higher-order
 MCFLAGS-no_fully_strict	=	--no-fully-strict
 
 # no_fully_strict is expected to fail (it calls error/1)


%-----------------------------------------------------------------------------%
% Regression test for a bug in higher_order.m
% Symptom: "Software Error: variable not found" during code generation.
% Cause: lambda.m reorders the argument variables of lambda
% 	expressions so that inputs come before outputs.
%	higher_order.m was not doing the reordering before
%	replacing a higher_order_call with a call to the lambda
% 	expression.
%-----------------------------------------------------------------------------%
:- module ho_order.

:- interface.

:- import_module io.


:- pred main(io__state, io__state).
:- mode main(di, uo) is det.

%-----------------------------------------------------------------------------%

:- implementation.
:- import_module int, list, map, std_util, string.

%-----------------------------------------------------------------------------%

		% information used during the elimination phase.

main(State0, State) :-
	map__from_assoc_list([0 - 1], Needed),
	map__from_assoc_list([0 - 1, 1 - 2, 2 - 4], ProcTable0),
	ProcIds = [1, 2],
	Keep = no,
	fldl2(ho_order__eliminate_proc(Keep, Needed),
		ProcIds, ProcTable0, _ProcTable, State0, State).

		% eliminate a procedure, if unused

:- pred ho_order__eliminate_proc(maybe(int), map(int, int),
	int, map(int, int), map(int, int), io__state, io__state).
:- mode ho_order__eliminate_proc(in, in, in, in, out, di, uo) is det.

ho_order__eliminate_proc(Keep, Needed, ProcId, 
		ProcTable0, ProcTable) -->
	(
		( { map__search(Needed, ProcId, _) }
		; { Keep = yes(_) }
		)
	->
		{ ProcTable = ProcTable0 }
	;
		io__format("Deleting %i\n", [i(ProcId)]),
		{ map__delete(ProcTable0, ProcId, ProcTable) }
	).

:- pred fldl2(pred(X, Y, Y, Z, Z), list(X), Y, Y, Z, Z).
:- mode fldl2(pred(in, in, out, in, out) is det,
		in, in, out, in, out) is det.
:- mode fldl2(pred(in, in, out, di, uo) is det,
		in, in, out, di, uo) is det.
:- mode fldl2(pred(in, di, uo, di, uo) is det,
		in, di, uo, di, uo) is det.

fldl2(_, [], FirstAcc, FirstAcc, SecAcc, SecAcc).
fldl2(P, [H|T], FirstAcc0, FirstAcc, SecAcc0, SecAcc) :-
	call(P, H, FirstAcc0, FirstAcc1, SecAcc0, SecAcc1),
	fldl2(P, T, FirstAcc1, FirstAcc, SecAcc1, SecAcc).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

tests/hard_coded/ho_order.exp:
%=============================================================================%

Deleting 1
Deleting 2