[m-dev.] diff: add pred_or_func to higher_order_call goals

[Fergus Henderson]

> Fix a bug for the case of a higher-order function call in code
> with common sub-expression; mercury 0.7 failed this test, reporting
> "Software Error: modecheck fails when repeated", due to confusion
> between h.o. _function_ call and h.o. _predicate_ call.
> 
> compiler/hlds_goal.m:
> 	Add a new `pred_or_func' field to HLDS higher_order_calls.
> 
> compiler/modes.m:
> compiler/modecheck_call.m:
> compiler/hlds_out.m:
> compiler/*.m:
> 	Add code to handle the new field for higher_order_call goals.
> 
> tests/valid/Mmake:
> tests/valid/ho_func_call.m:
> 	Regression test for the above-mentioned bug.

And now here's the actual diff...  well, actually it is mostly very boring,
so I'm only posting the vaguely interesting parts.

Index: modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.203
diff -u -u -r1.203 modes.m
--- modes.m	1997/09/01 04:18:30	1.203
+++ modes.m	1997/09/01 12:59:01
@@ -767,9 +767,10 @@
 	mode_info_unset_call_context,
 	mode_checkpoint(exit, "call").
 
-modecheck_goal_expr(higher_order_call(PredVar, Args0, _, _, _),
+modecheck_goal_expr(higher_order_call(PredVar, Args0, _, _, _, PredOrFunc),
 		GoalInfo0, Goal) -->
-	modecheck_higher_order_pred_call(PredVar, Args0, GoalInfo0, Goal).
+	modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0,
+		Goal).
 
 modecheck_goal_expr(unify(A0, B0, _, UnifyInfo0, UnifyContext), GoalInfo0, Goal)
 		-->
Index: modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.14
diff -u -u -r1.14 modecheck_call.m
--- modecheck_call.m	1997/07/27 15:01:08	1.14
+++ modecheck_call.m	1997/09/01 13:15:26
@@ -35,9 +35,9 @@
 :- mode modecheck_higher_order_call(in, in, in, out, out, out, out, out,
 				mode_info_di, mode_info_uo) is det.
 
-:- pred modecheck_higher_order_pred_call(var, list(var), hlds_goal_info,
-		hlds_goal_expr, mode_info, mode_info).
-:- mode modecheck_higher_order_pred_call(in, in, in, out,
+:- pred modecheck_higher_order_pred_call(var, list(var), pred_or_func,
+		hlds_goal_info, hlds_goal_expr, mode_info, mode_info).
+:- mode modecheck_higher_order_pred_call(in, in, in, in, out,
 		mode_info_di, mode_info_uo) is det.
 
 :- pred modecheck_higher_order_func_call(var, list(var), var, hlds_goal_info,
@@ -54,17 +54,19 @@
 :- import_module clause_to_proc, inst_match, make_hlds.
 :- import_module map, list, bool, std_util, set.
 
-modecheck_higher_order_pred_call(PredVar, Args0, GoalInfo0, Goal) -->
-	mode_checkpoint(enter, "higher-order predicate call"),
-	mode_info_set_call_context(higher_order_call(predicate)),
+modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0, Goal)
+		-->
+	mode_checkpoint(enter, "higher-order call"),
+	mode_info_set_call_context(higher_order_call(PredOrFunc)),
 	=(ModeInfo0),
 
 	{ mode_info_get_instmap(ModeInfo0, InstMap0) },
-	modecheck_higher_order_call(predicate, PredVar, Args0,
+	modecheck_higher_order_call(PredOrFunc, PredVar, Args0,
 			Types, Modes, Det, Args, ExtraGoals),
 
 	=(ModeInfo),
-	{ Call = higher_order_call(PredVar, Args, Types, Modes, Det) },
+	{ Call = higher_order_call(PredVar, Args, Types, Modes, Det,
+			PredOrFunc) },
 	{ handle_extra_goals(Call, ExtraGoals, GoalInfo0,
 			[PredVar | Args0], [PredVar | Args],
 			InstMap0, ModeInfo, Goal) },
@@ -83,7 +85,8 @@
 			Types, Modes, Det, Args, ExtraGoals),
 
 	=(ModeInfo),
-	{ Call = higher_order_call(FuncVar, Args, Types, Modes, Det) },
+	{ Call = higher_order_call(FuncVar, Args, Types, Modes, Det,
+				function) },
 	{ handle_extra_goals(Call, ExtraGoals, GoalInfo0,
 				[FuncVar | Args1], [FuncVar | Args],
 				InstMap0, ModeInfo, Goal) },
Index: hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.171
diff -u -u -r1.171 hlds_out.m
--- hlds_out.m	1997/08/23 20:33:31	1.171
+++ hlds_out.m	1997/09/01 13:16:22
@@ -932,12 +932,34 @@
 		io__write_string("\n")
 	).
 
-hlds_out__write_goal_2(higher_order_call(PredVar, ArgVars, _, _, _),
+hlds_out__write_goal_2(higher_order_call(PredVar, ArgVars, _, _, _, PredOrFunc),
 		_ModuleInfo, VarSet, AppendVarnums, Indent, Follow, _) -->
 		% XXX we should print more info here
+	globals__io_lookup_string_option(verbose_dump_hlds, Verbose),
 	hlds_out__write_indent(Indent),
-	hlds_out__write_functor(term__atom("call"), [PredVar|ArgVars], VarSet,
-		AppendVarnums),
+	(	{ PredOrFunc = predicate },
+		( { string__contains_char(Verbose, 'l') } ->
+			io__write_string("% higher-order predicate call"),
+			hlds_out__write_indent(Indent)
+		;
+			[]
+		),
+		hlds_out__write_functor(term__atom("call"), [PredVar|ArgVars],
+			VarSet, AppendVarnums)
+	;
+		{ PredOrFunc = function },
+		( { string__contains_char(Verbose, 'l') } ->
+			io__write_string("% higher-order function application"),
+			hlds_out__write_indent(Indent)
+		;
+			[]
+		),
+		{ pred_args_to_func_args(ArgVars, FuncArgVars, FuncRetVar) },
+		mercury_output_var(FuncRetVar, VarSet, AppendVarnums),
+		io__write_string(" = "),
+		hlds_out__write_functor(term__atom("apply"), FuncArgVars,
+			VarSet, AppendVarnums)
+	),
 	io__write_string(Follow),
 	io__write_string("\n").
 
Index: hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.39
diff -u -u -r1.39 hlds_goal.m
--- hlds_goal.m	1997/08/23 20:33:23	1.39
+++ hlds_goal.m	1997/09/01 12:42:59
@@ -52,7 +52,8 @@
 			list(var),	% the list of argument variables
 			list(type),	% the types of the argument variables
 			list(mode),	% the modes of the argument variables
-			determinism	% the determinism of the called pred
+			determinism,	% the determinism of the called pred
+			pred_or_func	% call/N (pred) or apply/N (func)
 		)
 
 		% Deterministic disjunctions are converted
@@ -859,7 +860,7 @@
 
 goal_is_atomic(conj([])).
 goal_is_atomic(disj([], _)).
-goal_is_atomic(higher_order_call(_,_,_,_,_)).
+goal_is_atomic(higher_order_call(_,_,_,_,_,_)).
 goal_is_atomic(call(_,_,_,_,_,_)).
 goal_is_atomic(unify(_,_,_,_,_)).
 goal_is_atomic(pragma_c_code(_,_,_,_,_,_,_,_)).


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