[m-rev.] for review: fix rtti get_arg bugs for il grade

[Peter Ross]

Hi,

Could someone with more familarity with the RTTI sub-system cast a critical
eye over these changes, ie zs, trd or fjh.

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


Estimated hours taken: 8
Branches: main

Fix bugs in get_arg when used with high-level data.

library/rtti_implementation.m:
	Fix a bug where the number of extra args in a functor where
	being calculated according to whether or not a particular arg
	of that functor was an existentially quantified type variable,
	instead of just calculating the number of extra args from the
	information in the exist_info for that functor.
	Fix a bug where with high-level data the type of the secondary
	tag doesn't matter for determing the offset to find a functors
	arg.

Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.24
diff -u -r1.24 rtti_implementation.m
--- library/rtti_implementation.m	26 Nov 2002 16:26:11 -0000	1.24
+++ library/rtti_implementation.m	26 Nov 2002 23:16:10 -0000
@@ -793,11 +793,15 @@
 		U, int, sectag_locn, du_functor_descriptor, type_info) = T.
 
 get_arg(Term, Index, SecTagLocn, FunctorDesc, TypeInfo) = (Arg) :-
+	ExistInfo = FunctorDesc ^ functor_exist_info,
+	ExtraArgs = (ExistInfo ^ exist_info_typeinfos_plain) + 
+			(ExistInfo ^ exist_info_tcis),
+
 	ArgTypes = FunctorDesc ^ functor_arg_types,
 	PseudoTypeInfo = get_pti_from_arg_types(ArgTypes, Index),
-	get_type_and_extra_args(TypeInfo, PseudoTypeInfo, Term,
-		FunctorDesc, ExtraArgs, ArgTypeInfo),
-	( SecTagLocn = none ->
+	get_arg_type_info(TypeInfo, PseudoTypeInfo, Term,
+			FunctorDesc, ArgTypeInfo),
+	( ( SecTagLocn = none ; high_level_data ) ->
 		TagOffset = 0
 	;
 		TagOffset = 1
@@ -805,18 +809,31 @@
 	RealArgsOffset = TagOffset + ExtraArgs,
 	Arg = get_subterm(ArgTypeInfo, Term, Index, RealArgsOffset).
 
-:- pred get_type_and_extra_args(type_info::in, P::in, T::in,
-	du_functor_descriptor::in, int::out, type_info::out) is det.
+:- pred high_level_data is semidet.
+:- pragma promise_pure(high_level_data/0).
+:- pragma foreign_proc("MC++", high_level_data,
+		[will_not_call_mercury, thread_safe], "
+#ifdef MR_HIGHLEVEL_DATA
+	SUCCESS_INDICATOR = MR_TRUE;
+#else
+	SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+high_level_data :-
+	fail.
+
+:- pred get_arg_type_info(type_info::in, P::in, T::in,
+	du_functor_descriptor::in, type_info::out) is det.
 
-get_type_and_extra_args(TypeInfoParams, PseudoTypeInfo, Term,
-		FunctorDesc, ExtraArgs, ArgTypeInfo) :-
+get_arg_type_info(TypeInfoParams, PseudoTypeInfo, Term,
+		FunctorDesc, ArgTypeInfo) :-
 	( 
 		typeinfo_is_variable(PseudoTypeInfo, VarNum)
 	->
 		get_type_info_for_var(TypeInfoParams,
-			VarNum, Term, FunctorDesc, ExtraArgs, ExpandedTypeInfo),
+			VarNum, Term, FunctorDesc, ExpandedTypeInfo),
 		( typeinfo_is_variable(ExpandedTypeInfo, _) ->
-			error("get_type_and_extra_args: unbound type variable")
+			error("get_arg_type_info: unbound type variable")
 		;
 			ArgTypeInfo = ExpandedTypeInfo
 		)
@@ -840,9 +857,8 @@
 			(pred(I::in, TI0::in, TI::out) is det :-
 
 				PTI = get_pti_from_type_info(CastTypeInfo, I),
-				get_type_and_extra_args(TypeInfoParams, PTI,
-					Term, FunctorDesc, _ExtraArgs,
-					ETypeInfo),
+				get_arg_type_info(TypeInfoParams, PTI,
+					Term, FunctorDesc, ETypeInfo),
 				( 
 					same_pointer_value_untyped(
 						ETypeInfo, PTI)
@@ -869,8 +885,7 @@
 			ArgTypeInfo = ArgTypeInfo1
 		;
 			ArgTypeInfo = CastTypeInfo
-		),
-		ExtraArgs = 0
+		)
 	).
 
 	% XXX this is completely unimplemented.
@@ -926,20 +941,15 @@
 	
 :- pred get_type_info_for_var(
 		type_info::in, int::in, T::in, du_functor_descriptor::in,
-		int::out, type_info::out) is det.
+		type_info::out) is det.
 
-get_type_info_for_var(TypeInfo, VarNum, Term, FunctorDesc,
-			ExtraArgs, ArgTypeInfo) :-
+get_type_info_for_var(TypeInfo, VarNum, Term, FunctorDesc, ArgTypeInfo) :-
 	(
 		type_variable_is_univ_quant(VarNum) 
 	->
-		ArgTypeInfo = TypeInfo ^ type_info_index(VarNum),
-		ExtraArgs = 0
+		ArgTypeInfo = TypeInfo ^ type_info_index(VarNum)
 	;
 		ExistInfo = FunctorDesc ^ functor_exist_info,
-		ExtraArgs = (ExistInfo ^ exist_info_typeinfos_plain) + 
-			(ExistInfo ^ exist_info_tcis),
-
 		ExistVarNum = VarNum - pseudotypeinfo_exist_var_base - 1,
 		ExistLocn = ExistInfo ^ typeinfo_locns_index(ExistVarNum),
 		Slot = ExistLocn ^ exist_arg_num,

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