[m-rev.] for prelim review: fix generation of type_ctor_info for unboxed types bug

[Peter Ross]

On Tue, Dec 02, 2003 at 03:38:36AM +1100, Fergus Henderson wrote:
> On 01-Dec-2003, Peter Ross <pro at missioncriticalit.com> wrote:
> > This is for preliminary review.  How does this look to you Fergus?
> 
I updated some of the comments and added a test case.

===================================================================


Estimated hours taken: 8
Branches: main

The comparison and unification function pointers stored in the
type_ctor_info must be pointers to functions where all the arguments
are boxed.  This wasn't occuring on the IL backend for types which
are value types.

compiler/rtti_to_mlds.m:
	Call ml_gen_closure_wrapper to construct a version of the
	comparison and unification functions where the arguments are
	boxed.  The wrapper function simply unboxes the arguments and
	calls the actual special pred.

compiler/ml_closure_gen.m:
	Adapt ml_gen_closure_wrapper so that it can generate a wrapper
	function for special preds.

tests/hard_coded/Mmakefile:
tests/hard_coded/equality_pred_which_requires_boxing.exp:
tests/hard_coded/equality_pred_which_requires_boxing.m:
	Add a test case for this bug.

Index: mercury/compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.22
diff -u -r1.22 ml_closure_gen.m
--- mercury/compiler/ml_closure_gen.m	13 Nov 2003 13:04:33 -0000	1.22
+++ mercury/compiler/ml_closure_gen.m	1 Dec 2003 20:41:14 -0000
@@ -50,7 +50,8 @@
 	%
 	% The ClosureKind parameter specifies whether the closure is
 	% an ordinary closure, used for higher-order procedure calls,
-	% or a typeclass_info, used for class method calls.
+	% or a typeclass_info, used for class method calls, or a call
+	% to a special pred.
 	% The NumClosuresArgs parameter specifies how many arguments
 	% to extract from the closure.
 	%
@@ -62,7 +63,8 @@
 
 :- type closure_kind
 	--->	higher_order_proc_closure
-	;	typeclass_info_closure.
+	;	typeclass_info_closure
+	;	special_pred.
 
 	% ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context,
 	%	LocalVarDefn):
@@ -565,6 +567,8 @@
 	%	}
 	%
 	% Actually, that is a simplified form.
+	% Also when calling a special pred then the closure argument isn't
+	% required.
 	% In full generality, it will look more like this:
 	%
 	% #if MODEL_SEMI
@@ -769,19 +773,25 @@
 	% some unbox operations).
 	{ WrapperArgs1 = list__map(arg_delete_gc_trace_code, WrapperArgs0) },
 
-	% then insert the `closure_arg' parameter
-	{ ClosureArgType = mlds__generic_type },
-	{ ClosureArgName = mlds__var_name("closure_arg", no) },
-	{ ClosureArgDeclType = list__det_head(ml_make_boxed_types(1)) },
-	gen_closure_gc_trace_code(ClosureArgName, ClosureArgDeclType,
-		ClosureKind, WrapperArgTypes, Purity, PredOrFunc,
-		Context, ClosureArgGCTraceCode),
-	{ ClosureArg = mlds__argument(
-		data(var(ClosureArgName)),
-		ClosureArgType,
-		ClosureArgGCTraceCode) },
-	{ WrapperParams = mlds__func_params([ClosureArg | WrapperArgs1],
-		WrapperRetType) },
+	% then insert the `closure_arg' parameter, if needed.
+	( { ClosureKind = special_pred } ->
+		{ MaybeClosureA = no },
+		{ WrapperArgs = WrapperArgs1 }
+	;
+		{ ClosureArgType = mlds__generic_type },
+		{ ClosureArgName = mlds__var_name("closure_arg", no) },
+		{ ClosureArgDeclType = list__det_head(ml_make_boxed_types(1)) },
+		gen_closure_gc_trace_code(ClosureArgName, ClosureArgDeclType,
+			ClosureKind, WrapperArgTypes, Purity, PredOrFunc,
+			Context, ClosureArgGCTraceCode),
+		{ ClosureArg = mlds__argument(
+			data(var(ClosureArgName)),
+			ClosureArgType,
+			ClosureArgGCTraceCode) },
+		{ MaybeClosureA = yes({ClosureArgType, ClosureArgName}) },
+		{ WrapperArgs = [ClosureArg | WrapperArgs1] }
+	),
+	{ WrapperParams = mlds__func_params(WrapperArgs, WrapperRetType) },
 
 	% also compute the lvals for the parameters,
 	% and local declarations for any by-value output parameters
@@ -790,7 +800,8 @@
 		WrapperHeadVarDecls, WrapperHeadVarLvals, WrapperCopyOutLvals),
 
 	%
-	% generate code to declare and initialize the closure pointer.
+	% generate code to declare and initialize the closure pointer,
+	% if needed
 	% XXX we should use a struct type for the closure, but
 	% currently we're using a low-level data representation
 	% in the closure
@@ -802,26 +813,35 @@
 	% #endif
 	%	closure = closure_arg;
 	%
-	{ ClosureName = mlds__var_name("closure", no) },
-	{ ClosureType = mlds__generic_type },
-	% If we were to generate GC tracing code for the closure pointer,
-	% it would look like this:
-	%	{ ClosureDeclType = list__det_head(ml_make_boxed_types(1)) },
-	%	gen_closure_gc_trace_code(ClosureName, ClosureDeclType,
-	%		ClosureKind, WrapperArgTypes, Purity, PredOrFunc,
-	%		Context, ClosureGCTraceCode),
-	% But we don't need any GC tracing code for the closure pointer,
-	% because it won't be live across an allocation, and because
-	% (unlike the closure_arg parameter) it isn't referenced from
-	% the GC tracing for other variables.
-	{ ClosureGCTraceCode = no },
 	{ MLDS_Context = mlds__make_context(Context) },
-	{ ClosureDecl = ml_gen_mlds_var_decl(var(ClosureName),
-		ClosureType, ClosureGCTraceCode, MLDS_Context) },
-	ml_gen_var_lval(ClosureName, ClosureType, ClosureLval),
-	ml_gen_var_lval(ClosureArgName, ClosureArgType, ClosureArgLval),
-	{ InitClosure = ml_gen_assign(ClosureLval, lval(ClosureArgLval),
-		Context) },
+	( { MaybeClosureA = yes({ClosureArgType1, ClosureArgName1}) } ->
+		{ ClosureName = mlds__var_name("closure", no) },
+		{ ClosureType = mlds__generic_type },
+		% If we were to generate GC tracing code for the closure
+		% pointer, it would look like this:
+		%	{ ClosureDeclType = list__det_head(
+		%			ml_make_boxed_types(1)) },
+		%	gen_closure_gc_trace_code(ClosureName, ClosureDeclType,
+		%		ClosureKind, WrapperArgTypes, Purity,
+		%		PredOrFunc, Context, ClosureGCTraceCode),
+		% But we don't need any GC tracing code for the closure pointer,
+		% because it won't be live across an allocation, and because
+		% (unlike the closure_arg parameter) it isn't referenced from
+		% the GC tracing for other variables.
+		{ ClosureGCTraceCode = no },
+		{ ClosureDecl = ml_gen_mlds_var_decl(var(ClosureName),
+			ClosureType, ClosureGCTraceCode, MLDS_Context) },
+		ml_gen_var_lval(ClosureName, ClosureType, ClosureLval),
+		ml_gen_var_lval(ClosureArgName1, ClosureArgType1,
+				ClosureArgLval),
+		{ InitClosure = ml_gen_assign(ClosureLval, lval(ClosureArgLval),
+			Context) },
+		{ MaybeClosureB = yes({ClosureDecl, InitClosure}) },
+		{ MaybeClosureC = yes(ClosureLval) }
+	;
+		{ MaybeClosureB = no },
+		{ MaybeClosureC = no }
+	),
 
 	%
 	% if the wrapper function is model_non, then
@@ -867,23 +887,33 @@
 	% `Offset' specifies the offset to add to the argument number to
 	% get the field number within the closure.  (Argument numbers start
 	% from 1, and field numbers start from 0.)
-	{
-		ClosureKind = higher_order_proc_closure,
-		Offset = ml_closure_arg_offset
+	( { MaybeClosureC = yes(ClosureLval1) } ->
+		{ ClosureKind = higher_order_proc_closure,
+			Offset = ml_closure_arg_offset
+		; ClosureKind = typeclass_info_closure,
+			Offset = ml_typeclass_info_arg_offset
+		; ClosureKind = special_pred,
+			unexpected(this_file,
+				"ml_gen_closure_wrapper: special_pred")
+		},
+		ml_gen_closure_field_lvals(ClosureLval1, Offset, 1,
+				NumClosureArgs, ClosureArgLvals)
 	;
-		ClosureKind = typeclass_info_closure,
-		Offset = ml_typeclass_info_arg_offset
-	},
-	ml_gen_closure_field_lvals(ClosureLval, Offset, 1, NumClosureArgs,
-		ClosureArgLvals),
+		{ ClosureArgLvals = [] }
+	),
 	{ CallLvals = list__append(ClosureArgLvals, WrapperHeadVarLvals) },
 	ml_gen_call(PredId, ProcId, ProcHeadVarNames, CallLvals,
 		ProcBoxedArgTypes, CodeModel, Context, yes,
 		Decls0, Statements0),
 
 	% insert the stuff to declare and initialize the closure
-	{ Decls1 = [ClosureDecl | Decls0] },
-	{ Statements1 = [InitClosure | Statements0] },
+	( { MaybeClosureB = yes({ClosureDecl1, InitClosure1}) } ->
+		{ Decls1 = [ClosureDecl1 | Decls0] },
+		{ Statements1 = [InitClosure1 | Statements0] }
+	;
+		{ Decls1 = Decls0 },
+		{ Statements1 = Statements0 }
+	),
 
 	%
 	% For semidet code, add the declaration `MR_bool succeeded;'
@@ -904,9 +934,12 @@
 	% needed for accurate GC
 	%
 	{ module_info_globals(ModuleInfo, Globals) },
-	( { globals__get_gc_method(Globals, accurate) } ->
-		ml_gen_closure_wrapper_gc_decls(ClosureKind, ClosureArgName,
-			ClosureArgType, PredId, ProcId, Context, GC_Decls)
+	(
+		{ MaybeClosureA = yes({ClosureArgType2, ClosureArgName2}) },
+		{ globals__get_gc_method(Globals, accurate) }
+	->
+		ml_gen_closure_wrapper_gc_decls(ClosureKind, ClosureArgName2,
+			ClosureArgType2, PredId, ProcId, Context, GC_Decls)
 	;
 		{ GC_Decls = [] }
 	),
@@ -970,6 +1003,10 @@
 	;
 		{ ClosureKind = typeclass_info_closure },
 		{ ClosureActualType = sample_typeclass_info_type }
+	;
+		{ ClosureKind = special_pred },
+		{ unexpected(this_file,
+				"gen_closure_gc_trace_code: special_pred") }
 	),
 	ml_gen_maybe_gc_trace_code(ClosureName, ClosureDeclType,
 		ClosureActualType, Context, ClosureGCTraceCode).
@@ -1177,6 +1214,11 @@
 			target_code_input(lval(ClosureLayoutPtrLval)),
 			raw_target_code(");\n", [])
 		] }
+	;
+		{ ClosureKind = special_pred },
+		{ unexpected(this_file,
+			"ml_gen_closure_wrapper_gc_decls: special_pred") }
+
 	),
 	{ TypeParamsGCInit = mlds__statement(atomic(inline_target_code(
 		lang_C, TypeParamsGCInitFragments)), MLDS_Context) },
Index: mercury/compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.43
diff -u -r1.43 rtti_to_mlds.m
--- mercury/compiler/rtti_to_mlds.m	1 Dec 2003 06:53:29 -0000	1.43
+++ mercury/compiler/rtti_to_mlds.m	1 Dec 2003 20:41:25 -0000
@@ -195,17 +195,32 @@
 	prog_out__sym_name_to_string(TypeModule, TypeModuleName),
 	NumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
 	NumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
-	gen_functors_layout_info(ModuleInfo, RttiTypeCtor, TypeCtorDetails,
-		FunctorsInfo, LayoutInfo, SubDefns),
 	FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, type_functors),
 	LayoutRttiId = ctor_rtti_id(RttiTypeCtor, type_layout),
+
+	some [!Defns] (
+	    gen_functors_layout_info(ModuleInfo, RttiTypeCtor,
+			TypeCtorDetails, FunctorsInfo, LayoutInfo, !:Defns),
+
+	    %
+	    % Note that gen_init_special_pred will by necessity add an extra
+	    % level of indirection to calling the special preds.  However the
+	    % backend compiler should be smart enough to ensure that this is
+	    % inlined away.
+	    %
+	    gen_init_special_pred(ModuleInfo, UnifyUniv, UnifyInit, !Defns),
+	    gen_init_special_pred(ModuleInfo, CompareUniv, CompareInit, !Defns),
+
+	    SubDefns = !.Defns
+	),
+
 	Init = init_struct(mlds__rtti_type(RttiId), [
 		gen_init_int(TypeArity),
 		gen_init_int(Version),
 		gen_init_int(NumPtags),
 		gen_init_type_ctor_rep(TypeCtorData),
-		gen_init_proc_id_from_univ(ModuleInfo, UnifyUniv),
-		gen_init_proc_id_from_univ(ModuleInfo, CompareUniv),
+		UnifyInit,
+		CompareInit,
 		gen_init_string(TypeModuleName),
 		gen_init_string(TypeName),
 		% In the C back-end, these two "structs" are actually unions.
@@ -224,6 +239,8 @@
 			% commented out.
 		% gen_init_maybe(gen_init_rtti_name(RttiTypeCtor),
 		%	MaybeHashCons),
+		% XXX this may need to change to call
+		% gen_init_special_pred, if this is re-enabled.
 		% gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
 	]).
 
@@ -1048,8 +1065,7 @@
 		list(mlds__defn), list(mlds__defn)).
 :- mode gen_init_method(in, in, in, out, in, out) is det.
 
-gen_init_method(ModuleInfo, NumExtra, RttiProcId, Init,
-		ExtraDefns0, ExtraDefns) :-
+gen_init_method(ModuleInfo, NumExtra, RttiProcId, Init, !ExtraDefns) :-
 	%
 	% we can't store the address of the typeclass method directly in
 	% the base_typeclass_info; instead, we need to generate
@@ -1064,7 +1080,36 @@
 	% Hopefully the Mercury HLDS->HLDS inlining and/or
 	% the target code compiler will be able to optimize this...
 	%
+	gen_wrapper_func_and_initializer(ModuleInfo, NumExtra, RttiProcId,
+			typeclass_info_closure, Init, !ExtraDefns).
+
+:- pred gen_init_special_pred(module_info::in, univ::in, mlds__initializer::out,
+		list(mlds__defn)::in, list(mlds__defn)::out) is det.
+
+gen_init_special_pred(ModuleInfo, RttiProcIdUniv, Init, !ExtraDefns) :-
+	%
+	% we can't store the address of the special pred procedure directly
+	% in the type_ctor_info because when the special pred is called
+	% by looking up its address in the type_ctor_info its always called
+	% with its arguments boxed, but the generated special pred may operate
+	% on unboxed values, hence we need to generate a wrapper function
+	% which unboxes the arguments if necessary.
+	%
+	( univ_to_type(RttiProcIdUniv, RttiProcId) ->
+		NumExtra = 0,
+		gen_wrapper_func_and_initializer(ModuleInfo, NumExtra,
+				RttiProcId, special_pred, Init, !ExtraDefns)
+	;
+		error("gen_init_special_pred: cannot extract univ value")
+	).
+
+:- pred gen_wrapper_func_and_initializer(module_info, int, rtti_proc_label,
+		closure_kind, mlds__initializer,
+		list(mlds__defn), list(mlds__defn)).
+:- mode gen_wrapper_func_and_initializer(in, in, in, in, out, in, out) is det.
 
+gen_wrapper_func_and_initializer(ModuleInfo, NumExtra, RttiProcId,
+		ClosureKind, Init, ExtraDefns0, ExtraDefns) :-
 	%
 	% We start off by creating a fresh MLGenInfo here,
 	% using the pred_id and proc_id of the wrapped procedure.
@@ -1083,16 +1128,15 @@
 	% Now we can safely go ahead and generate the wrapper function
 	%
 	term__context_init(Context),
-	ml_gen_closure_wrapper(PredId, ProcId, typeclass_info_closure,
+	ml_gen_closure_wrapper(PredId, ProcId, ClosureKind,
 		NumExtra, Context, WrapperFuncRval, WrapperFuncType,
 		MLGenInfo1, MLGenInfo),
 	ml_gen_info_get_extra_defns(MLGenInfo, ExtraDefns1),
 	ExtraDefns = list__append(ExtraDefns1, ExtraDefns0),
 	
 	%
-	% The initializer for the method field of the base_typeclass_info
-	% is just the wrapper function's address, converted to
-	% mlds__generic_type (by boxing).
+	% The initializer for the wrapper is just the wrapper function's
+	% address, converted to mlds__generic_type (by boxing).
 	%
 	Init = init_obj(unop(box(WrapperFuncType), WrapperFuncRval)).
 
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.208
diff -u -r1.208 Mmakefile
--- tests/hard_coded/Mmakefile	1 Dec 2003 15:56:07 -0000	1.208
+++ tests/hard_coded/Mmakefile	1 Dec 2003 20:41:43 -0000
@@ -43,6 +43,7 @@
 	dupcall_types_bug \
 	dupcall_impurity \
 	elim_special_pred \
+	equality_pred_which_requires_boxing \
 	eqv_type_bug \
 	erroneous_liveness \
 	error_func \

New File: tests/hard_coded/equality_pred_which_requires_boxing.exp
===================================================================
float (boxed): true
float (unboxed): true
foreign_type (boxed): true
foreign_type (unboxed): true
foreign_type(T) (boxed): true
foreign_type(T) (unboxed): true

New File: tests/hard_coded/equality_pred_which_requires_boxing.m
===================================================================
% equality_pred_which_requires_boxing
%
% Check that the unification predicate we generate handles the case where
% the arguments are boxed and unboxed correctly.

:- module equality_pred_which_requires_boxing.

:- interface.

:- import_module io.

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

:- implementation.

:- type type_which_needs_boxing.
:- pragma foreign_type(c, type_which_needs_boxing, "double")
		where equality is unify_ft.
:- pragma foreign_type(il, type_which_needs_boxing,
		"valuetype [mscorlib]System.Double") where equality is unify_ft.

:- type type_which_needs_boxing(T).
:- pragma foreign_type(c, type_which_needs_boxing(T), "double")
		where equality is unify_ft_T.
:- pragma foreign_type(il, type_which_needs_boxing(T),
		"valuetype [mscorlib]System.Double")
		where equality is unify_ft_T.

main(!IO) :-
	% Test a builtin type which requires boxing.
	A = float_a,
	B = float_b,
	unify("float (boxed)", A, B, !IO),
	( A = B ->
		io__write_string("float (unboxed): true\n", !IO)
	;
		io__write_string("float (unboxed): false\n", !IO)
	),

	% Test a simple foreign_type.
	X = create(A),
	Y = create(B),
	unify("foreign_type (boxed)", X, Y, !IO),
	( X = Y ->
		io__write_string("foreign_type (unboxed): true\n", !IO)
	;
		io__write_string("foreign_type (unboxed): false\n", !IO)
	),

	% Test a foreign_type which requires a type_info.
	G = create_T(A),
	H = create_T(B),
	unify("foreign_type(T) (boxed)", G, H, !IO),
	( G = H ->
		io__write_string("foreign_type(T) (unboxed): true\n", !IO)
	;
		io__write_string("foreign_type(T) (unboxed): false\n", !IO)
	).

	% Here we pass in a generic type, so if needed the input
	% arguments will have been boxed.  We then test if the
	% unification pred handles this correctly.
:- pragma no_inline(unify/5).
:- pred unify(string::in, T::in, T::in, io::di, io::uo) is det.
unify(S, X, Y, !IO) :-
	io__write_string(S, !IO),
	( X = Y ->
		io__write_string(": true\n", !IO)
	;
		io__write_string(": false\n", !IO)
	).

:- func create(float) = type_which_needs_boxing.
:- pragma foreign_proc("C", create(X::in) = (Y::out), [promise_pure], "
	Y = X;
").
:- pragma foreign_proc("C#", create(X::in) = (Y::out), [promise_pure], "
	Y = X;
").

:- func create_T(float) = type_which_needs_boxing(int).
:- pragma foreign_proc("C", create_T(X::in) = (Y::out), [promise_pure], "
	Y = X;
").
:- pragma foreign_proc("C#", create_T(X::in) = (Y::out), [promise_pure], "
	Y = X;
").

:- pred unify_ft(type_which_needs_boxing::in, type_which_needs_boxing::in)
		is semidet.
:- pragma foreign_proc("C", unify_ft(X::in, Y::in), [promise_pure], "
	SUCCESS_INDICATOR = (X == Y);
").
:- pragma foreign_proc("C#", unify_ft(X::in, Y::in), [promise_pure], "
	SUCCESS_INDICATOR = (X == Y);
").

:- pred unify_ft_T(type_which_needs_boxing(T)::in,
		type_which_needs_boxing(T)::in) is semidet.
:- pragma foreign_proc("C", unify_ft_T(X::in, Y::in), [promise_pure], "
	SUCCESS_INDICATOR = (X == Y);
").
:- pragma foreign_proc("C#", unify_ft_T(X::in, Y::in), [promise_pure], "
	SUCCESS_INDICATOR = (X == Y);
").

:- pragma no_inline(float_a/0).
:- func float_a = float.
float_a = 1.0.

:- pragma no_inline(float_b/0).
:- func float_b = float.
float_b = 1.0.

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