[m-rev.] for review: reserved address tag test optimization

Fergus Henderson fjh at cs.mu.OZ.AU
Thu Nov 1 03:36:21 AEDT 2001


Branches: main
Estimated hours taken: 4

Avoid some unnecessary tag tests when using reserved address
data representations.

compiler/hlds_data.m:
	Add new cons_tag alternative `single_functor'.
	This is equivalent to `unshared_tag(0)' except that it
	also means that there are no other primary tag values used.

	Previously this wasn't needed, since any tag tests
	against `unshared_tag(0)' would be marked as `cannot_fail'
	by determinism analysis.  However, now that we have
	reserved addresses, that is not sufficient: a tag test against 
	`shared_with_reserved_address(null_pointer, unshared_tag(0))'
	is semidet, because it needs to first check for null,
	but if there are no other functors then it should NOT
	bother to check that the tag is zero.  We need the
	`single_functor' alternative to optimize that case.

compiler/make_tags.m:
	Assign `single_functor' representations rather than
	`unshared_tag(0)' if there are no other functors remaining.

compiler/ml_unify_gen.m:
compiler/unify_gen.m:
	Optimize away the tag test for `single_functor' alternatives.

compiler/bytecode_gen.m:
compiler/hlds_data.m:
compiler/type_ctor_info.m:
compiler/switch_util.m:
compiler/ml_unify_gen.m:
compiler/unify_gen.m:
	Minor changes to handle the new cons_tag alternative:
	treat it the same as `unshared_tag(0)'.

compiler/code_util.m:
compiler/unify_proc.m:
	Use `single_functor' rather than `unshared_tag(0)' for tuples.

compiler/ml_code_util.m:
	Add ml_gen_and and ml_gen_not, for use by compiler/ml_unify_gen.m.

Workspace: /home/earth/fjh/ws-earth3/mercury
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.64
diff -u -d -r1.64 bytecode_gen.m
--- compiler/bytecode_gen.m	24 Oct 2001 07:09:49 -0000	1.64
+++ compiler/bytecode_gen.m	31 Oct 2001 15:21:43 -0000
@@ -748,6 +748,9 @@
 :- pred bytecode_gen__map_cons_tag(cons_tag::in, byte_cons_tag::out) is det.
 
 bytecode_gen__map_cons_tag(no_tag, no_tag).
+	% `single_functor' is just an optimized version of `unshared_tag(0)'
+	% this optimization is not important for the bytecode
+bytecode_gen__map_cons_tag(single_functor, unshared_tag(0)).
 bytecode_gen__map_cons_tag(unshared_tag(Primary), unshared_tag(Primary)).
 bytecode_gen__map_cons_tag(shared_remote_tag(Primary, Secondary),
 	shared_remote_tag(Primary, Secondary)).
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.132
diff -u -d -r1.132 code_util.m
--- compiler/code_util.m	31 May 2001 05:59:31 -0000	1.132
+++ compiler/code_util.m	31 Oct 2001 15:20:27 -0000
@@ -709,7 +709,7 @@
 		% couldn't be, it's just not worth the effort.
 		type_is_tuple(Type, _)
 	->
-		Tag = unshared_tag(0)
+		Tag = single_functor
 	;
 			% Use the type to determine the type_id
 		( type_to_type_id(Type, TypeId0, _) ->
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.59
diff -u -d -r1.59 hlds_data.m
--- compiler/hlds_data.m	31 Oct 2001 13:12:18 -0000	1.59
+++ compiler/hlds_data.m	31 Oct 2001 15:22:41 -0000
@@ -363,6 +363,12 @@
 	;	deep_profiling_proc_static_tag(rtti_proc_label)
 			% This is for constants representing procedure
 			% descriptions for deep profiling.
+	;	single_functor
+			% This is for types with a single functor
+			% (and possibly also some constants represented
+			% using reserved addresses -- see below).
+			% For these types, we don't need any tags.
+			% We just store a pointer to the argument vector.
 	;	unshared_tag(tag_bits)
 			% This is for constants or functors which can be
 			% distinguished with just a primary tag.
@@ -452,6 +458,7 @@
 get_secondary_tag(base_typeclass_info_constant(_, _, _)) = no.
 get_secondary_tag(tabling_pointer_constant(_, _)) = no.
 get_secondary_tag(deep_profiling_proc_static_tag(_)) = no.
+get_secondary_tag(single_functor) = no.
 get_secondary_tag(unshared_tag(_)) = no.
 get_secondary_tag(shared_remote_tag(_PrimaryTag, SecondaryTag)) =
 		yes(SecondaryTag).
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.34
diff -u -d -r1.34 make_tags.m
--- compiler/make_tags.m	24 Oct 2001 07:09:52 -0000	1.34
+++ compiler/make_tags.m	31 Oct 2001 15:26:43 -0000
@@ -265,9 +265,16 @@
 		CtorTags0, CtorTags) :-
 	Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
 	make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
-		% if we're about to run out of unshared tags, start assigning
-		% shared remote tags instead
-	( Val = MaxTag, Rest \= [] ->
+	% If there's only one functor,
+	% give it the "single_functor" (untagged)
+	% representation, rather than giving it unshared_tag(0).
+	( Val = 0, Rest = [] ->
+		Tag = maybe_add_reserved_addresses(ReservedAddresses,
+			single_functor),
+		map__set(CtorTags0, ConsId, Tag, CtorTags)
+	% if we're about to run out of unshared tags, start assigning
+	% shared remote tags instead
+	; Val = MaxTag, Rest \= [] ->
 		assign_shared_remote_tags([Ctor | Rest], MaxTag, 0,
 			ReservedAddresses, CtorTags0, CtorTags)
 	;
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.46
diff -u -d -r1.46 ml_code_util.m
--- compiler/ml_code_util.m	24 Oct 2001 13:34:27 -0000	1.46
+++ compiler/ml_code_util.m	31 Oct 2001 15:42:56 -0000
@@ -105,6 +105,18 @@
 
 %-----------------------------------------------------------------------------%
 %
+% Routines for generating expressions.
+%
+
+	% conjunction: ml_gen_and(X,Y) = binop((and), X, Y),
+	% except that it does some constant folding on the result.
+:- func ml_gen_and(mlds__rval, mlds__rval) = mlds__rval.
+
+	% negation: ml_gen_not(X) = unop(std_unop(not), X),
+:- func ml_gen_not(mlds__rval) = mlds__rval.
+
+%-----------------------------------------------------------------------------%
+%
 % Routines for generating types.
 %
 
@@ -949,6 +961,22 @@
 	Abstractness = concrete,
 	MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
 		Virtuality, Finality, Constness, Abstractness).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for generating expressions.
+%
+
+ml_gen_and(X, Y) =
+	(if X = const(true) then
+		Y
+	else if Y = const(true) then
+		X
+	else
+		binop((and), X, Y)
+	).
+
+ml_gen_not(X) = unop(std_unop(not), X).
 
 %-----------------------------------------------------------------------------%
 %
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.44
diff -u -d -r1.44 ml_unify_gen.m
--- compiler/ml_unify_gen.m	25 Oct 2001 07:04:57 -0000	1.44
+++ compiler/ml_unify_gen.m	31 Oct 2001 16:13:11 -0000
@@ -260,7 +260,9 @@
 		%
 		% ordinary compound terms
 		%
-		{ Tag = unshared_tag(TagVal),
+		{ Tag = single_functor, TagVal = 0,
+		  MaybeSecondaryTag = no
+		; Tag = unshared_tag(TagVal),
 		  MaybeSecondaryTag = no
 		; Tag = shared_remote_tag(TagVal, SecondaryTag),
 		  MaybeSecondaryTag = yes(SecondaryTag)
@@ -345,6 +347,7 @@
 		% compound terms, including lambda expressions
 		%
 		{ Tag = pred_closure_tag(_, _, _), TagVal = 0
+		; Tag = single_functor, TagVal = 0
 		; Tag = unshared_tag(TagVal)
 		; Tag = shared_remote_tag(TagVal, _SecondaryTag)
 		}
@@ -458,6 +461,8 @@
 % so we don't need to handle them here.
 ml_gen_constant(no_tag, _, _) -->
 	{ error("ml_gen_constant: no_tag") }.
+ml_gen_constant(single_functor, _, _) -->
+	{ error("ml_gen_constant: single_functor") }.
 ml_gen_constant(unshared_tag(_), _, _) -->
 	{ error("ml_gen_constant: unshared_tag") }.
 ml_gen_constant(shared_remote_tag(_, _), _, _) -->
@@ -1446,6 +1451,11 @@
 			{ error("ml_code_gen: no_tag: arity != 1") }
 		)
 	;
+		{ Tag = single_functor },
+		% treat single_functor the same as unshared_tag(0)
+		ml_gen_det_deconstruct_2(unshared_tag(0), Type, Var, ConsId,
+			Args, Modes, Context, MLDS_Statements)
+	;
 		{ Tag = unshared_tag(UnsharedTag) },
 		ml_gen_var(Var, VarLval),
 		ml_variable_types(Args, ArgTypes),
@@ -1492,6 +1502,11 @@
 
 ml_tag_offset_and_argnum(Tag, TagBits, OffSet, ArgNum) :-
 	(
+		Tag = single_functor,
+		TagBits = 0,
+		OffSet = 0,
+		ArgNum = 1
+	;
 		Tag = unshared_tag(UnsharedTag),
 		TagBits = UnsharedTag,
 		OffSet = 0,
@@ -1883,6 +1898,7 @@
 	% This should never happen
 	error("Attempted deep_profiling_proc_static unification").
 ml_gen_tag_test_rval(no_tag, _, _, _Rval) = const(true).
+ml_gen_tag_test_rval(single_functor, _, _, _Rval) = const(true).
 ml_gen_tag_test_rval(unshared_tag(UnsharedTag), _, _, Rval) =
 	binop(eq, unop(std_unop(tag), Rval),
 		  unop(std_unop(mktag), const(int_const(UnsharedTag)))).
@@ -1926,7 +1942,7 @@
 	CheckReservedAddrs = (func(RA, TestRval0) = TestRval :-
 		EqualRA = ml_gen_tag_test_rval(reserved_address(RA), VarType,
 					ModuleInfo, Rval),
-		TestRval = binop((and), unop(std_unop(not), EqualRA), TestRval0)
+		TestRval = ml_gen_and(ml_gen_not(EqualRA), TestRval0)
 	),
 	MatchesThisTag = ml_gen_tag_test_rval(ThisTag, VarType, ModuleInfo,
 			Rval),
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.4
diff -u -d -r1.4 switch_util.m
--- compiler/switch_util.m	24 Oct 2001 07:09:56 -0000	1.4
+++ compiler/switch_util.m	31 Oct 2001 15:53:28 -0000
@@ -278,6 +278,7 @@
 switch_util__switch_priority(int_constant(_), 1).
 switch_util__switch_priority(reserved_address(_), 1).
 switch_util__switch_priority(shared_local_tag(_, _), 1).
+switch_util__switch_priority(single_functor, 2).
 switch_util__switch_priority(unshared_tag(_), 2).
 switch_util__switch_priority(float_constant(_), 3).
 switch_util__switch_priority(shared_remote_tag(_, _), 4).
@@ -352,7 +353,11 @@
 switch_util__get_ptag_counts_2([], Max, Max, PtagCountMap, PtagCountMap).
 switch_util__get_ptag_counts_2([ConsTag | TagList], MaxPrimary0, MaxPrimary,
 		PtagCountMap0, PtagCountMap) :-
-	( ConsTag = unshared_tag(Primary) ->
+	(
+		( ConsTag = single_functor, Primary = 0
+		; ConsTag = unshared_tag(Primary)
+		)
+	->
 		int__max(MaxPrimary0, Primary, MaxPrimary1),
 		( map__search(PtagCountMap0, Primary, _) ->
 			error("unshared tag is shared")
@@ -406,7 +411,11 @@
 switch_util__group_cases_by_ptag([], PtagCaseMap, PtagCaseMap).
 switch_util__group_cases_by_ptag([Case0 | Cases0], PtagCaseMap0, PtagCaseMap) :-
 	Case0 = case(_Priority, Tag, _ConsId, Goal),
-	( Tag = unshared_tag(Primary) ->
+	(
+		( Tag = single_functor, Primary = 0
+		; Tag = unshared_tag(Primary)
+		)
+	->
 		( map__search(PtagCaseMap0, Primary, _Group) ->
 			error("unshared tag is shared")
 		;
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.16
diff -u -d -r1.16 type_ctor_info.m
--- compiler/type_ctor_info.m	25 Oct 2001 12:41:16 -0000	1.16
+++ compiler/type_ctor_info.m	31 Oct 2001 15:53:40 -0000
@@ -666,7 +666,11 @@
 
 type_ctor_info__process_cons_tag(ConsTag, RttiName, ConsRep,
 		TagMap0, TagMap) :-
-	( ConsTag = unshared_tag(ConsPtag) ->
+	(
+		( ConsTag = single_functor, ConsPtag = 0
+		; ConsTag = unshared_tag(ConsPtag)
+		)
+	->
 		Locn = sectag_none,
 		Ptag = ConsPtag,
 		Stag = 0,
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.116
diff -u -d -r1.116 unify_gen.m
--- compiler/unify_gen.m	24 Oct 2001 07:09:56 -0000	1.116
+++ compiler/unify_gen.m	31 Oct 2001 16:13:41 -0000
@@ -256,6 +256,8 @@
 	error("Attempted deep_profiling_proc_static_tag unification").
 unify_gen__generate_tag_test_rval_2(no_tag, _Rval, TestRval) :-
 	TestRval = const(true).
+unify_gen__generate_tag_test_rval_2(single_functor, _Rval, TestRval) :-
+	TestRval = const(true).
 unify_gen__generate_tag_test_rval_2(unshared_tag(UnsharedTag), Rval,
 		TestRval) :-
 	TestRval = binop(eq,	unop(tag, Rval),
@@ -346,6 +348,11 @@
 		{ error(
 		"unify_gen__generate_construction_2: no_tag: arity != 1") }
 	).
+unify_gen__generate_construction_2(single_functor,
+		Var, Args, Modes, AditiInfo, GoalInfo, Code) -->
+	% treat single_functor the same as unshared_tag(0)
+	unify_gen__generate_construction_2(unshared_tag(0),
+			Var, Args, Modes, AditiInfo, GoalInfo, Code).
 unify_gen__generate_construction_2(unshared_tag(Ptag),
 		Var, Args, Modes, _, _, Code) -->
 	code_info__get_module_info(ModuleInfo),
@@ -802,6 +809,11 @@
 		;
 			{ error("unify_gen__generate_det_deconstruction: no_tag: arity != 1") }
 		)
+	;
+		{ Tag = single_functor },
+		% treat single_functor the same as unshared_tag(0)
+		unify_gen__generate_det_deconstruction_2(Var, Cons, Args,
+			Modes, unshared_tag(0), Code)
 	;
 		{ Tag = unshared_tag(Ptag) },
 		{ Rval = var(Var) },
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.96
diff -u -d -r1.96 unify_proc.m
--- compiler/unify_proc.m	24 Oct 2001 13:34:38 -0000	1.96
+++ compiler/unify_proc.m	31 Oct 2001 15:57:47 -0000
@@ -539,7 +539,7 @@
 
 		CtorSymName = unqualified("{}"),
 		ConsId = cons(CtorSymName, TupleArity),
-		map__from_assoc_list([ConsId - unshared_tag(0)],
+		map__from_assoc_list([ConsId - single_functor],
 			ConsTagValues),
 		UnifyPred = no,
 		IsEnum = no,

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  | "... it seems to me that 15 years of
The University of Melbourne         | email is plenty for one lifetime."
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- Prof. Donald E. Knuth
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list