[m-rev.] diff: fix bugs with existential types & secondary tags

Fergus Henderson fjh at cs.mu.OZ.AU
Mon Apr 30 01:51:03 AEST 2001
Previous message: [m-rev.] diff: fix bugs with existential types & secondary tags
Next message: [m-rev.] diff: fix bugs with existential types & secondary tags
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
On 29-Apr-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> I'll test this a bit more and add a regression test before committing it.

Further testing uncovered yet another bug.
Here's a relative diff.
I'll go ahead and commit these changes now.

--- CHANGES.deep_copy.old	Mon Apr 30 01:33:24 2001
+++ CHANGES.deep_copy	Mon Apr 30 01:44:54 2001
@@ -1,9 +1,9 @@
 
-Estimated hours taken: 6
+Estimated hours taken: 8
 Branches: main, release
 
-Fix bugs with the handling of existentially typed data types with
-secondary tags in various parts of the RTTI code.
+Fix bugs with the handling of existentially typed data types
+in various parts of the RTTI code.
 
 Most of these bugs were due to passing in the pointer to the secondary
 tag, rather than the pointer to the first real argument (one word
@@ -21,7 +21,17 @@
 	typed data types, it was trying to use the type_infos in the original
 	data after they had already been replaced by forwarding pointers.
 
+compiler/polymorphism.m:
+	Fix existentially typed data types, make sure that the
+	type_infos come BEFORE the typeclass_infos, not vice versa.
+	This is needed to match the code in the runtime system.
+	It's also consistent with the way we order them for procedure calls.
+
 runtime/mercury_type_info.h:
-	Add some extra emphasis to a comment, to hopefully reduce the
-	likelihood of this bug re-occurring.
+	Improve the comments a little.
+
+tests/hard_coded/Mmakefile:
+tests/hard_coded/deep_copy_exist.m:
+tests/hard_coded/deep_copy_exist.exp:
+	Regression tests.
 
/mnt/hg/home/hg/fjh/ws-hg3/mercury
cvs diff compiler/polymorphism.m runtime/mercury_type_info.h tests/hard_coded/Mmakefile tests/hard_coded/deep_copy_exist.exp tests/hard_coded/deep_copy_exist.m
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.208
diff -u -d -r1.208 polymorphism.m
--- compiler/polymorphism.m	2001/04/07 14:04:53	1.208
+++ compiler/polymorphism.m	2001/04/29 15:31:54
@@ -1599,10 +1599,12 @@
 			PolyInfo3, PolyInfo),
 
 	%
-	% the type_class_info variables go before the type_info variables
+	% the type_class_info variables go AFTER the type_info variables
+	% (for consistency with the order for argument passing,
+	% and because the RTTI support in the runtime system relies on it)
 	%
-	list__append(ExtraTypeClassGoals, ExtraTypeInfoGoals, ExtraGoals),
-	list__append(ExtraTypeClassVars, ExtraTypeInfoVars, ExtraVars).
+	list__append(ExtraTypeInfoGoals, ExtraTypeClassGoals, ExtraGoals),
+	list__append(ExtraTypeInfoVars, ExtraTypeClassVars, ExtraVars).
 
 %-----------------------------------------------------------------------------%
 
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.69
diff -u -d -r1.69 mercury_type_info.h
--- runtime/mercury_type_info.h	2001/04/06 06:19:28	1.69
+++ runtime/mercury_type_info.h	2001/04/29 15:44:33
@@ -614,7 +614,7 @@
 /*---------------------------------------------------------------------------*/
 
 /*
-** The argument number gives the offset in the cell (in a form in which
+** The argument number field gives the offset in the cell (in a form in which
 ** it can be given to the MR_field macro directly) of either of the typeinfo
 ** itself or of the typeclassinfo containing the typeinfo. If the former,
 ** the offset field will be negative; otherwise, it will be an integer
@@ -632,23 +632,24 @@
 ** existentially quantified type variables occurring in the types of some
 ** of the arguments of a functor in a du type.
 ** 
-** The num_typeinfos_plain gives the number of typeinfos directly inserted
-** at the start of the memory cell of the functor, while the num_tcis field
-** gives the number of typeclassinfos inserted after them. The arguments
-** visible to the programmer start after these two blocks, which means that
-** when accessing them, one must add the sum of num_typeinfos_plain and
-** num_tcis to the visible argument number in order to arrive at an offset
-** in the cell.
-**
+** The MR_exist_typeinfos_plain field gives the number of typeinfos
+** directly inserted at the start of the memory cell of the functor, while
+** the MR_exist_tcis field gives the number of typeclassinfos
+** inserted AFTER them.  The arguments visible to the programmer start AFTER
+** these two blocks, which means that when accessing them, one must add
+** the sum of MR_exist_typeinfos_plain and MR_exist_tcis to
+** the visible argument number in order to arrive at an offset in the cell.
+** 
 ** It is possible for a typeclassinfo to contain more than one type variable.
-** The num_typeinfos_in_tci field contains the total number of typeinfos stored
-** inside the typeclassinfos of the cell.
-**
-** The typeinfo_locns field points to an array of MR_ExistTypeInfoLocns.
-** This array has num_typeinfos_plain + num_typeinfos_in_tci elements,
-** each one of which describes the location (directly in the cell or indirectly
-** inside a typeclassinfo) of the typeinfo for an existentially quantified
-** type variable. The typeinfo for type variable N will be at the offset
+** The MR_exist_typeinfos_in_tci field contains the total number of typeinfos
+** stored inside the typeclassinfos of the cell.
+** 
+** The MR_exist_typeinfo_locns field points to an array of
+** MR_ExistTypeInfoLocns.  This array has MR_exist_typeinfos_plain +
+** MR_exist_typeinfos_in_tci elements, each one of which describes
+** the location (directly in the cell or indirectly inside a typeclassinfo)
+** of the typeinfo for an existentially quantified type variable. 
+** The typeinfo for type variable N will be at the offset
 ** N - MR_PSEUDOTYPEINFO_EXIST_VAR_BASE - 1. (The one is subtracted to convert
 ** from type var numbering, which starts at 1, to array offset numbering).
 */
@@ -1155,7 +1156,7 @@
 ** which (directly or indirectly) contains the typeinfos of the existentially
 ** quantified type variables, and the descriptor of the function symbol,
 ** which describes how those typeinfos can be found in the cell. The cell
-** address is supposed to point past the remote secondary tag, if any;
+** address is supposed to point PAST the remote secondary tag, if any;
 ** it should point to the first argument, whether it is a user visible argument
 ** or a typeinfo/typeclass_info inserted into the cell by the compiler.
 **
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.112
diff -u -d -r1.112 Mmakefile
--- tests/hard_coded/Mmakefile	2001/03/05 04:02:38	1.112
+++ tests/hard_coded/Mmakefile	2001/04/29 15:41:18
@@ -30,6 +30,7 @@
 	cycles2 \
 	deep_copy \
 	deep_copy_bug \
+	deep_copy_exist \
 	det_in_semidet_cntxt \
 	division_test \
 	dupcall_types_bug \
Index: tests/hard_coded/deep_copy_exist.exp
===================================================================
RCS file: deep_copy_exist.exp
diff -N deep_copy_exist.exp
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ deep_copy_exist.exp	Mon Apr 30 01:41:06 2001
@@ -0,0 +1,51 @@
+TESTING DISCRIMINATED UNIONS
+apple([9, 5, 1])
+apple([9, 5, 1])
+apple([9, 5, 1])
+banana([three, one, two])
+banana([three, one, two])
+banana([three, one, two])
+zop(3.30000000000000, 2.03000000000000)
+zop(3.30000000000000, 2.03000000000000)
+zop(3.30000000000000, 2.03000000000000)
+zip(3, 2)
+zip(3, 2)
+zip(3, 2)
+zap(3, -2.11100000000000)
+zap(3, -2.11100000000000)
+zap(3, -2.11100000000000)
+wombat
+wombat
+wombat
+foo
+foo
+foo
+tuple_a(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, 17)
+tuple_a(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, 17)
+tuple_a(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, 17)
+tuple_b(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, ["x", "y", "z"])
+tuple_b(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, ["x", "y", "z"])
+tuple_b(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, ["x", "y", "z"])
+tuple_c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ["p", "q"], 17)
+tuple_c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ["p", "q"], 17)
+tuple_c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ["p", "q"], 17)
+tuple_d(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 'a', 15, 'z', 17)
+tuple_d(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 'a', 15, 'z', 17)
+tuple_d(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 'a', 15, 'z', 17)
+
+TESTING POLYMORPHISM
+poly_three(3.33000000000000, 4, poly_one(9.11000000000000))
+poly_three(3.33000000000000, 4, poly_one(9.11000000000000))
+poly_three(3.33000000000000, 4, poly_one(9.11000000000000))
+poly_two(3)
+poly_two(3)
+poly_two(3)
+poly_one([2399.30000000000])
+poly_one([2399.30000000000])
+poly_one([2399.30000000000])
+
+TESTING BUILTINS
+univ_cons(["hi! I\'m a univ!"])
+univ_cons(["hi! I\'m a univ!"])
+univ_cons(["hi! I\'m a univ!"])
+
Index: tests/hard_coded/deep_copy_exist.m
===================================================================
RCS file: deep_copy_exist.m
diff -N deep_copy_exist.m
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ deep_copy_exist.m	Mon Apr 30 00:14:32 2001
@@ -0,0 +1,193 @@
+% Test case for deep_copy of existentially quantified
+% data types.
+
+:- module deep_copy_exist.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module char, list, int, std_util, term, map, string, require.
+:- import_module enum.
+
+:- pred test_builtins(io__state::di, io__state::uo) is det.
+:- pred test_discriminated(io__state::di, io__state::uo) is det.
+:- pred test_polymorphism(io__state::di, io__state::uo) is det.
+
+:- pred newline(io__state::di, io__state::uo) is det.
+
+:- type my_enum ---> one ; two ; three.
+:- instance enum(my_enum) where [
+	to_int(one) = 1,
+	to_int(two) = 2,
+	to_int(three) = 3,
+	from_int(1) = one,
+	from_int(2) = two,
+	from_int(3) = three
+].
+
+:- pred test_all(T::in, io__state::di, io__state::uo) is det.
+
+:- type fruit	--->	some [T] apple(list(T))
+		;	some [T] banana(list(T)) => enum(T).
+
+:- type thingie	--->	foo ; some [T] bar(T) ; some [T1, T2] bar(T1, T2) ;
+			some [T] (qux(T) => enum(T)) ;
+			some [T] (quux(list(T)) => enum(T)) ;
+			some [T3] quuux(int, T3) ; wombat ; 
+			zoom(int) ; some [T] zap(int, T) ;
+			some [T1, T2] zip(T1, T2) => enum(T2) ;
+			some [T] zop(float, T).
+
+:- type poly(A)	--->	poly_one(A) ; some [B] poly_two(B) ; 
+			some [B] poly_three(B, A, poly(B)) ;
+			some [B] poly_four(A, B) => enum(B).
+
+:- type bit_vector_test
+	--->	some [T] tuple_a(
+			int,	% 0
+			int,	% 1
+			int,	% 2
+			int,	% 3
+			int,	% 4
+			int,	% 5
+			int,	% 6
+			int,	% 7
+			int,	% 8
+			int,	% 9
+			int,	% 10
+			int,	% 11
+			int,	% 12
+			int,	% 13
+			int,	% 14
+			T,	% 15
+			int,	% 16
+			int)	% 17
+	;	some [T] tuple_b(
+			int,	% 0
+			int,	% 1
+			int,	% 2
+			int,	% 3
+			int,	% 4
+			int,	% 5
+			int,	% 6
+			int,	% 7
+			int,	% 8
+			int,	% 9
+			int,	% 10
+			int,	% 11
+			int,	% 12
+			int,	% 13
+			int,	% 14
+			T,	% 15
+			int,	% 16
+			T)	% 17
+	;	some [T1] tuple_c(
+			int,	% 0
+			int,	% 1
+			int,	% 2
+			int,	% 3
+			int,	% 4
+			int,	% 5
+			int,	% 6
+			int,	% 7
+			int,	% 8
+			int,	% 9
+			int,	% 10
+			int,	% 11
+			int,	% 12
+			int,	% 13
+			int,	% 14
+			int,	% 15
+			T1,	% 16
+			int)	% 17
+	;	some [T1, T2] tuple_d(
+			int,	% 0
+			int,	% 1
+			int,	% 2
+			int,	% 3
+			int,	% 4
+			int,	% 5
+			int,	% 6
+			int,	% 7
+			int,	% 8
+			int,	% 9
+			int,	% 10
+			int,	% 11
+			int,	% 12
+			int,	% 13
+			T1,	% 14
+			int,	% 15
+			T2,	% 16
+			int)	% 17
+		=> enum(T2).
+
+%----------------------------------------------------------------------------%
+
+main -->
+	test_discriminated,
+	test_polymorphism,
+	test_builtins.
+
+%----------------------------------------------------------------------------%
+
+test_all(T) -->
+	io__write(T), 
+	io__write_string("\n"),
+	{ copy(T, T1) },
+	io__write(T), 
+	io__write_string("\n"),
+	io__write(T1),
+	newline.
+
+%----------------------------------------------------------------------------%
+
+test_discriminated -->
+	io__write_string("TESTING DISCRIMINATED UNIONS\n"),
+
+		% test no secondary tags
+	test_all('new apple'([9,5,1])),
+	test_all('new banana'([three, one, two])),
+
+		% test remote secondary tags
+	test_all('new zop'(3.3, 2.03)),
+	test_all('new zip'(3, 2)),
+	test_all('new zap'(3, -2.111)),
+
+		% test local secondary tags
+	test_all(wombat),
+	test_all(foo),
+
+		% test the contains_var bit vector
+	test_all('new tuple_a'(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+		14, ["a", "b", "c"], 16, 17)),
+	test_all('new tuple_b'(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+		14, ["a", "b", "c"], 16, ["x", "y", "z"])),
+	test_all('new tuple_c'(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+		14, 15, ["p", "q"], 17)),
+	test_all('new tuple_d'(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+		'a', 15, 'z', 17)),
+
+	newline.	
+
+test_polymorphism -->
+	io__write_string("TESTING POLYMORPHISM\n"),
+	test_all('new poly_three'(3.33, 4, poly_one(9.11))),
+	test_all('new poly_two'(3)),
+	test_all(poly_one([2399.3])),
+
+	newline.
+
+test_builtins -->
+	io__write_string("TESTING BUILTINS\n"),
+
+		% test univ.
+	{ type_to_univ(["hi! I'm a univ!"], Univ) }, 
+	test_all(Univ),
+	
+	newline.
+
+newline -->
+	io__write_char('\n').

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
Previous message: [m-rev.] diff: fix bugs with existential types & secondary tags
Next message: [m-rev.] diff: fix bugs with existential types & secondary tags
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the reviews mailing list