[m-rev.] for post-commit review: fix extracting type_infos (erlang)

[Peter Wang]

Estimated hours taken: 8
Branches: main

library/private_builtin.m:
	Fix the Erlang implementation of type_info_from_typeclass_info which
	was not taking into account extra instance arguments in
	typeclass_infos.

	Fix a similar bug in superclass_from_typeclass_info (untested but we
	follow the corresponding C macros).

tests/hard_coded/typeclasses/Mmakefile:
tests/hard_coded/typeclasses/extract_typeinfo2.exp:
tests/hard_coded/typeclasses/extract_typeinfo2.m:
	Add a test case for the first bug fix.

Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.171
diff -u -r1.171 private_builtin.m
--- library/private_builtin.m	2 Jul 2007 05:30:32 -0000	1.171
+++ library/private_builtin.m	8 Aug 2007 07:05:08 -0000
@@ -711,9 +711,11 @@
         TypeInfo::out),
     [will_not_call_mercury, promise_pure, thread_safe],
 "
+    BaseTypeClassInfo = element(1, TypeClassInfo),
+    ExtraArgs = element(1, BaseTypeClassInfo),
         % Indexes start at 1 in Erlang,
         % while in C they start at 0
-    TypeInfo = element(Index + 1, TypeClassInfo)
+    TypeInfo = element(ExtraArgs + Index + 1, TypeClassInfo)
 ").
 
 :- pragma foreign_proc("Erlang",
@@ -731,9 +733,11 @@
         TypeClassInfo::out),
     [will_not_call_mercury, promise_pure, thread_safe],
 "
+    BaseTypeClassInfo = element(1, TypeClassInfo0),
+    ExtraArgs = element(1, BaseTypeClassInfo),
         % Indexes start at 1 in Erlang,
         % while in C they start at 0
-    TypeClassInfo = element(Index + 1, TypeClassInfo0)
+    TypeClassInfo = element(ExtraArgs + Index + 1, TypeClassInfo0)
 ").
 
 :- pragma foreign_proc("Erlang",
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.58
diff -u -r1.58 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile	19 Oct 2006 07:29:51 -0000	1.58
+++ tests/hard_coded/typeclasses/Mmakefile	8 Aug 2007 07:05:08 -0000
@@ -12,6 +12,7 @@
 	complicated_fundeps \
 	constrained_lambda \
 	extract_typeinfo \
+	extract_typeinfo2 \
 	exist_disjunction \
 	existential_type_classes \
 	existential_data_types \
Index: tests/hard_coded/typeclasses/extract_typeinfo2.exp
===================================================================
RCS file: tests/hard_coded/typeclasses/extract_typeinfo2.exp
diff -N tests/hard_coded/typeclasses/extract_typeinfo2.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/extract_typeinfo2.exp	8 Aug 2007 07:05:08 -0000
@@ -0,0 +1 @@
+'>'
Index: tests/hard_coded/typeclasses/extract_typeinfo2.m
===================================================================
RCS file: tests/hard_coded/typeclasses/extract_typeinfo2.m
diff -N tests/hard_coded/typeclasses/extract_typeinfo2.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/extract_typeinfo2.m	8 Aug 2007 07:05:08 -0000
@@ -0,0 +1,41 @@
+% Regression test for extracting type_infos from typeclass infos with
+% extra instance arguments.
+
+:- module extract_typeinfo2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module enum.
+:- import_module int.
+:- import_module list.
+
+:- type xvar(T)
+    --->    xvar(int).
+
+:- type dummy ---> dummy.
+
+:- instance enum(xvar(_)).
+
+:- instance enum(xvar(_)) where [
+    to_int(xvar(I)) = I,
+    from_int(I) = xvar(I)
+].
+
+main(!IO) :-
+    comp(R, xvar(63), xvar(61) : xvar(dummy)),
+    io.print(R, !IO),
+    io.nl(!IO).
+
+:- pred comp(comparison_result::out, T::in, T::in) is det <= enum(T).
+:- pragma no_inline(comp/3).
+
+comp(R, A, B) :-
+    % The Erlang backend was extracting the 'dummy' type_info rather than the
+    % 'xvar(int)' typeinfo, therefore comparing A and B as dummy values, i.e.
+    % always equal.
+    compare(R, A, B).
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------