[m-rev.] for review: better code for unify and compare procs

[Zoltan Somogyi]

For review by Fergus. Together with the change to jumpopt, this change
reduces the size of aditi_backend.rl_code.c by 13 to 18%, depending on
the measure (lines, characters, object code size). It should also make
some compare predicates faster.

Zoltan.

compiler/unify_proc.m:
	Modify the clauses handling constants in the code we generate for
	unify and compare predicates to make the generated code more compact.

	For unify predicates, instead of clauses such as

		(
			...
		;
			X = f, Y = f
		;
			X = g, Y = g
		;
			...
		),

	generate clauses such as

		(
			...
		;
			X = f, Y = X
		;
			X = g, Y = X
		;
			...
		),

	since the latter allows dupelim.m to merge the code of the affected
	clauses, whereas the former doesn't. To avoid infinite recursion,
	we compare X and Y as integers. (If the target doesn't allow constants
	to be compared as integers, we generate code we used to generate.)

	For compare predicates, once we know that X and Y have the same index
	and X is a constant, do not check the value of Y; it must be the same
	as X.

compiler/options.m:
	Add an option that says whether constants can be compared as integers.

compiler/handle_options.m:
	Set the value of the new option depending on the characteristics of the
	target.

cvs diff: Diffing .
Index: handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.193
diff -u -b -r1.193 handle_options.m
--- handle_options.m	1 Dec 2003 15:55:34 -0000	1.193
+++ handle_options.m	10 Jan 2004 16:01:02 -0000
@@ -1304,6 +1304,15 @@
 		[]
 	),
 
+	(
+		{ Target = c },
+		{ TagsMethod = low }
+	->
+		globals__io_set_option(can_compare_constants_as_ints, bool(yes))
+	;
+		globals__io_set_option(can_compare_constants_as_ints, bool(no))
+	),
+
 	( { HighLevel = no } ->
 		postprocess_options_lowlevel
 	;
Index: options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.419
diff -u -b -r1.419 options.m
--- options.m	23 Oct 2003 02:02:09 -0000	1.419
+++ options.m	12 Jan 2004 04:48:36 -0000
@@ -339,6 +339,14 @@
 				% the predicates deciding interface typeinfo
 				% liveness, should go through there.
 		;	body_typeinfo_liveness
+				% Should be set to yes if the target back end
+				% guarantees that comparing two values for
+				% equality, at least one of which is a
+				% constant, can be done by casting them both
+				% to integers and comparing the integers
+				% for equality.
+		;	can_compare_constants_as_ints
+
 	% Options for internal use only
 	% (setting these options to non-default values can result in
 	% programs that do not link, or programs that dump core)
@@ -944,6 +952,7 @@
 	procid_stack_layout	-	bool(no),
 	trace_stack_layout	-	bool(no),
 	body_typeinfo_liveness	-	bool(no),
+	can_compare_constants_as_ints -	bool(no),
 	special_preds		-	bool(yes),
 	type_ctor_info		-	bool(yes),
 	type_ctor_layout	-	bool(yes),
@@ -1575,6 +1584,7 @@
 long_option("procid-stack-layout",	procid_stack_layout).
 long_option("trace-stack-layout",	trace_stack_layout).
 long_option("body-typeinfo-liveness",	body_typeinfo_liveness).
+long_option("can-compare-constants-as-ints",	can_compare_constants_as_ints).
 long_option("special-preds",		special_preds).
 long_option("type-ctor-info",		type_ctor_info).
 long_option("type-ctor-layout",		type_ctor_layout).
@@ -3313,6 +3323,11 @@
 
 		% This is a developer only option.
 %		"--body-typeinfo-liveness",
+%		"(This option is not for general use.)",
+%		For documentation, see the comment in the type declaration.
+
+		% This is a developer only option.
+%		"--can-compare-constants-as-ints",
 %		"(This option is not for general use.)",
 %		For documentation, see the comment in the type declaration.
 
Index: unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.130
diff -u -b -r1.130 unify_proc.m
--- unify_proc.m	21 Dec 2003 05:04:38 -0000	1.130
+++ unify_proc.m	10 Jan 2004 16:54:58 -0000
@@ -1164,29 +1164,39 @@
 
 %	For a type such as
 %
-%		type t(X) ---> a ; b(int) ; c(X); d(int, X, t)
+%	type t ---> a1 ; a2 ; b(int) ; c(float); d(int, string, t).
 %
-%	we want to generate code
+% we want to generate the code
 %
-%		eq(H1, H2) :-
+%	__Unify__(X, Y) :-
 %			(
-%				H1 = a,
-%				H2 = a
+%			X = a1,
+%			Y = X
+%		;
+%			X = a2,
+%			Y = X
 %			;
-%				H1 = b(X1),
-%				H2 = b(X2),
+%			X = b(X1),
+%			Y = b(Y2),
+%			X1 = Y2,
+%		;
+%			X = c(X1),
+%			Y = c(Y1),
 %				X1 = X2,
 %			;
-%				H1 = c(Y1),
-%				H2 = c(Y2),
-%				Y1 = Y2,
-%			;
-%				H1 = d(A1, B1, C1),
-%				H2 = c(A2, B2, C2),
-%				A1 = A2,
-%				B1 = B2,
-%				C1 = C2
+%			X = d(X1, X2, X3),
+%			Y = c(Y1, Y2, Y3),
+%			X1 = y1,
+%			X2 = Y2,
+%			X3 = Y3
 %			).
+%
+% Note that in the disjuncts handling constants, we want to unify Y with X,
+% not with the constant. This allows dupelim to take the code fragments
+% implementing the switch arms for constants and eliminate all but one of them.
+% This can be a significant code size saving for types with lots of constants,
+% such as the one representing Aditi bytecodes, which can lead to significant
+% reductions in C compilation time.
 
 :- pred unify_proc__generate_du_unify_clauses(list(constructor), prog_var,
 		prog_var, prog_context, list(clause),
@@ -1194,29 +1204,60 @@
 :- mode unify_proc__generate_du_unify_clauses(in, in, in, in, out, in, out)
 	is det.
 
-unify_proc__generate_du_unify_clauses([], _H1, _H2, _Context, []) --> [].
-unify_proc__generate_du_unify_clauses([Ctor | Ctors], H1, H2, Context,
-		[Clause | Clauses]) -->
-	{ Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes) },
-	{ list__length(ArgTypes, FunctorArity) },
-	{ FunctorConsId = cons(FunctorName, FunctorArity) },
-	unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars1),
-	unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars2),
-	{ create_atomic_unification(
-		H1, functor(FunctorConsId, no, Vars1), Context, explicit, [], 
-		UnifyH1_Goal) },
-	{ create_atomic_unification(
-		H2, functor(FunctorConsId, no, Vars2), Context, explicit, [], 
-		UnifyH2_Goal) },
-	unify_proc__unify_var_lists(ArgTypes, ExistQTVars, Vars1, Vars2,
-		UnifyArgs_Goal),
-	{ GoalList = [UnifyH1_Goal, UnifyH2_Goal | UnifyArgs_Goal] },
-	{ goal_info_init(GoalInfo0) },
-	{ goal_info_set_context(GoalInfo0, Context,
-		GoalInfo) },
-	{ conj_list_to_goal(GoalList, GoalInfo, Goal) },
-	unify_proc__quantify_clause_body([H1, H2], Goal, Context, Clause),
-	unify_proc__generate_du_unify_clauses(Ctors, H1, H2, Context, Clauses).
+unify_proc__generate_du_unify_clauses([], _X, _Y, _Context, [], !Info).
+unify_proc__generate_du_unify_clauses([Ctor | Ctors], X, Y, Context,
+		[Clause | Clauses], !Info) :-
+	Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes),
+	list__length(ArgTypes, FunctorArity),
+	FunctorConsId = cons(FunctorName, FunctorArity),
+	(
+		ArgTypes = [],
+		can_compare_constants_as_ints(!.Info) = yes
+	->
+		create_atomic_unification(
+			X, functor(FunctorConsId, no, []), Context,
+			explicit, [], UnifyX_Goal),
+		unify_proc__info_new_named_var(int_type, "CastX", CastX,
+			!Info),
+		unify_proc__info_new_named_var(int_type, "CastY", CastY,
+			!Info),
+		generate_unsafe_cast(X, CastX, Context, CastXGoal),
+		generate_unsafe_cast(Y, CastY, Context, CastYGoal),
+		create_atomic_unification(CastY, var(CastX), Context,
+			explicit, [], UnifyY_Goal),
+		GoalList = [UnifyX_Goal, CastXGoal, CastYGoal, UnifyY_Goal]
+	;
+		unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars1,
+			!Info),
+		unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars2,
+			!Info),
+		create_atomic_unification(
+			X, functor(FunctorConsId, no, Vars1), Context,
+			explicit, [], UnifyX_Goal),
+		create_atomic_unification(
+			Y, functor(FunctorConsId, no, Vars2), Context,
+			explicit, [], UnifyY_Goal),
+		unify_proc__unify_var_lists(ArgTypes, ExistQTVars,
+			Vars1, Vars2, UnifyArgs_Goals, !Info),
+		GoalList = [UnifyX_Goal, UnifyY_Goal | UnifyArgs_Goals]
+	),
+	goal_info_init(GoalInfo0),
+	goal_info_set_context(GoalInfo0, Context, GoalInfo),
+	conj_list_to_goal(GoalList, GoalInfo, Goal),
+	unify_proc__quantify_clause_body([X, Y], Goal, Context, Clause, !Info),
+	unify_proc__generate_du_unify_clauses(Ctors, X, Y, Context, Clauses,
+		!Info).
+
+	% Succeed iff the target back end guarantees that comparing two
+	% constants for equality can be done by casting them both to integers
+	% and comparing the integers for equality.
+:- func can_compare_constants_as_ints(unify_proc_info) = bool.
+
+can_compare_constants_as_ints(Info) = CanCompareAsInt :-
+	ModuleInfo = Info ^ module_info,
+	module_info_globals(ModuleInfo, Globals),
+	lookup_bool_option(Globals, can_compare_constants_as_ints,
+		CanCompareAsInt).
 
 %-----------------------------------------------------------------------------%
 
@@ -1224,7 +1265,7 @@
 %
 %		:- type foo ---> f ; g(a, b, c) ; h(foo).
 %
-%	we want to generate code
+% we want to generate the code
 %
 %		index(X, Index) :-
 %			(
@@ -1298,7 +1339,7 @@
 
 %	For a du type, such as
 %
-%		:- type foo ---> f(a) ; g(a, b, c)
+%	:- type foo ---> f(a) ; g(a, b, c) ; h.
 %
 %   	the quadratic code we want to generate is
 %
@@ -1312,6 +1353,10 @@
 %				Y = g(_, _, _),
 %				R = (<)
 %			;
+%			X = f(_),
+%			Y = h,
+%			R = (<)
+%		;
 %				X = g(_, _, _),
 %				Y = f(_),
 %				R = (>)
@@ -1325,7 +1370,28 @@
 %				; 
 %					compare(R, X3, Y3)
 %				)
+%		;
+%			X = g(_, _, _),
+%			Y = h,
+%			R = (<)
+%		;
+%			X = f(_),
+%			Y = h,
+%			R = (<)
+%		;
+%			X = g(_, _, _),
+%			Y = h,
+%			R = (<)
+%		;
+%			X = h,
+%			Y = h,
+%			R = (<)
 %			).
+%
+% Note that in the clauses handling two copies of the same constant,
+% we unify Y with the constant, not with X. This is required to get
+% switch_detection and det_analysis to recognize the determinism of the
+% predicate.
 
 :- pred unify_proc__generate_du_quad_compare_clauses(list(constructor)::in,
 	prog_var::in, prog_var::in, prog_var::in, prog_context::in,
@@ -1369,7 +1435,7 @@
 		Cases0, Cases) -->
 	( { LeftCtor = RightCtor } ->
 		unify_proc__generate_compare_case(LeftCtor, R, X, Y, Context,
-			Case),
+			quad, Case),
 		{ Cmp1 = "<" }
 	;
 		unify_proc__generate_asymmetric_compare_case(LeftCtor,
@@ -1398,13 +1464,15 @@
 %				% This disjunction is generated by
 %				% unify_proc__generate_compare_cases, below.
 %				(
-%					X = f, Y = f,
+%				X = f
 %					R = (=)
 %				;
-%					X = g(X1), Y = g(Y1),
+%				X = g(X1),
+%				Y = g(Y1),
 %					compare(R, X1, Y1)
 %				;
-%					X = h(X1, X2), Y = h(Y1, Y2),
+%				X = h(X1, X2),
+%				Y = h(Y1, Y2),
 %					( compare(R1, X1, Y1), R1 \= (=) ->
 %						R = R1
 %					; 
@@ -1416,6 +1484,9 @@
 %			;
 %				compare_error 	% Abort
 %			).
+%
+% Note that disjuncts covering constants do not test Y, since for constants
+% X_Index = Y_Index implies X = Y.
 
 :- pred unify_proc__generate_du_linear_compare_clauses((type)::in,
 	list(constructor)::in, prog_var::in, prog_var::in, prog_var::in,
@@ -1495,7 +1566,7 @@
 %
 %		(
 %			X = f,		% UnifyX_Goal
-%			Y = f,		% UnifyY_Goal
+%		Y = X,		% UnifyY_Goal
 %			R = (=)		% CompareArgs_Goal
 %		;
 %			X = g(X1),	
@@ -1510,6 +1581,10 @@
 %				compare(R, X2, Y2)
 %			)
 %		)
+%
+% Note that in the clauses for constants, we unify Y with X, not with
+% the constant. This is to allow dupelim to eliminate all but one of
+% the code fragments implementing such switch arms.
 
 :- pred unify_proc__generate_compare_cases(list(constructor), prog_var,
 		prog_var, prog_var, prog_context, list(hlds_goal),
@@ -1520,30 +1595,55 @@
 unify_proc__generate_compare_cases([], _R, _X, _Y, _Context, []) --> [].
 unify_proc__generate_compare_cases([Ctor | Ctors], R, X, Y, Context,
 		[Case | Cases]) -->
-	unify_proc__generate_compare_case(Ctor, R, X, Y, Context, Case),
+	unify_proc__generate_compare_case(Ctor, R, X, Y, Context, linear,
+		Case),
 	unify_proc__generate_compare_cases(Ctors, R, X, Y, Context, Cases).
 
-:- pred unify_proc__generate_compare_case(constructor, prog_var, prog_var,
-		prog_var, prog_context, hlds_goal,
-		unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_compare_case(in, in, in, in, in, out, in, out)
-	is det.
+:- type linear_or_quad	--->	linear ; quad.
+
+:- pred unify_proc__generate_compare_case(constructor::in,
+	prog_var::in, prog_var::in, prog_var::in, prog_context::in,
+	linear_or_quad::in, hlds_goal::out,
+	unify_proc_info::in, unify_proc_info::out) is det.
 
-unify_proc__generate_compare_case(Ctor, R, X, Y, Context, Case) -->
+unify_proc__generate_compare_case(Ctor, R, X, Y, Context, Kind, Case) -->
 	{ Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes) },
 	{ list__length(ArgTypes, FunctorArity) },
 	{ FunctorConsId = cons(FunctorName, FunctorArity) },
+	(
+		{ ArgTypes = [] },
+		{ create_atomic_unification(
+			X, functor(FunctorConsId, no, []), Context,
+			explicit, [], UnifyX_Goal) },
+		{ unify_proc__generate_return_equal(R, Context, EqualGoal) },
+		(
+			{ Kind = linear },
+			% The disjunct we are generating is executed only if
+			% the index values of X and Y are the same, so if X is
+			% bound to a constant, Y must also be bound to that
+			% same constant.
+			{ GoalList = [UnifyX_Goal, EqualGoal] }
+		;
+			{ Kind = quad },
+			{ create_atomic_unification(
+				Y, functor(FunctorConsId, no, []), Context,
+				explicit, [], UnifyY_Goal) },
+			{ GoalList = [UnifyX_Goal, UnifyY_Goal, EqualGoal] }
+		)
+	;
+		{ ArgTypes = [_ | _] },
 	unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars1),
 	unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars2),
 	{ create_atomic_unification(
-		X, functor(FunctorConsId, no, Vars1), Context, explicit, [], 
-		UnifyX_Goal) },
+			X, functor(FunctorConsId, no, Vars1), Context,
+			explicit, [], UnifyX_Goal) },
 	{ create_atomic_unification(
-		Y, functor(FunctorConsId, no, Vars2), Context, explicit, [], 
-		UnifyY_Goal) },
+			Y, functor(FunctorConsId, no, Vars2), Context,
+			explicit, [], UnifyY_Goal) },
 	unify_proc__compare_args(ArgTypes, ExistQTVars, Vars1, Vars2,
 		R, Context, CompareArgs_Goal),
-	{ GoalList = [UnifyX_Goal, UnifyY_Goal, CompareArgs_Goal] },
+		{ GoalList = [UnifyX_Goal, UnifyY_Goal, CompareArgs_Goal] }
+	),
 	{ goal_info_init(GoalInfo0) },
 	{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
 	{ conj_list_to_goal(GoalList, GoalInfo, Case) }.
@@ -1624,10 +1724,7 @@
 		is semidet.
 
 unify_proc__compare_args_2([], _, [], [], R, Context, Return_Equal) -->
-	{ create_atomic_unification(
-		R, functor(cons(unqualified("="), 0), no, []),
-		Context, explicit, [], 
-		Return_Equal) }.
+	{ unify_proc__generate_return_equal(R, Context, Return_Equal) }.
 unify_proc__compare_args_2([_Name - Type|ArgTypes], ExistQTVars, [X|Xs], [Y|Ys],
 		R, Context, Goal) -->
 	{ goal_info_init(GoalInfo0) },
@@ -1670,6 +1767,14 @@
 		unify_proc__compare_args_2(ArgTypes, ExistQTVars, Xs, Ys, R,
 			Context, ElseCase)
 	).
+
+:- pred unify_proc__generate_return_equal(prog_var::in, prog_context::in,
+	hlds_goal::out) is det.
+
+unify_proc__generate_return_equal(ResultVar, Context, Return_Equal) :-
+	create_atomic_unification(
+		ResultVar, functor(cons(unqualified("="), 0), no, []),
+		Context, explicit, [], Return_Equal).
 
 %-----------------------------------------------------------------------------%
 
cvs diff: Diffing notes
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------