[m-rev.] diff: fix for bug #122

[Mark Brown]

compiler/check_typeclass.m:
	When checking the consistency of typeclass instances with respect to
	functional dependencies, ignore pairs of instances that are imported
	from the same module.  The proper check will be time at the time the
	imported module is compiled.  Checking such imported pairs may lead
	to false errors because an abstract instance may be regarded as
	inconsistent with its concrete implementation even if their heads
	are identical.

	This addresses bug #122.

tests/hard_coded/typeclasses/Mmakefile:
tests/hard_coded/typeclasses/submodule_consistency_tc.m:
tests/hard_coded/typeclasses/submodule_consistency_tcin.m:
tests/hard_coded/typeclasses/submodule_consistency_tcin.sub.m:
tests/hard_coded/typeclasses/submodule_consistency_test.m:
tests/hard_coded/typeclasses/submodule_consistency_test.exp:
	Add a test case for this bug.

Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.126
diff -u -r1.126 check_typeclass.m
--- compiler/check_typeclass.m	12 Jan 2010 03:12:36 -0000	1.126
+++ compiler/check_typeclass.m	18 Jan 2010 07:07:39 -0000
@@ -1231,9 +1231,19 @@
 
 check_consistency_pair(ClassId, ClassDefn, FunDeps, InstanceA, InstanceB,
         !ModuleInfo, !Specs) :-
-    list.foldl2(
-        check_consistency_pair_2(ClassId, ClassDefn, InstanceA, InstanceB),
-        FunDeps, !ModuleInfo, !Specs).
+    % If both instances are imported from the same module then we don't need
+    % to check the consistency, since this would have been checked when
+    % compiling that module.
+    (
+        InstanceA ^ instance_module = InstanceB ^ instance_module,
+        status_is_imported(InstanceA ^ instance_status) = yes
+    ->
+        true
+    ;
+        list.foldl2(
+            check_consistency_pair_2(ClassId, ClassDefn, InstanceA, InstanceB),
+            FunDeps, !ModuleInfo, !Specs)
+    ).
 
 :- pred check_consistency_pair_2(class_id::in, hlds_class_defn::in,
     hlds_instance_defn::in, hlds_instance_defn::in, hlds_class_fundep::in,
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.59
diff -u -r1.59 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile	8 Aug 2007 07:07:59 -0000	1.59
+++ tests/hard_coded/typeclasses/Mmakefile	18 Jan 2010 07:07:39 -0000
@@ -56,6 +56,7 @@
 	record_syntax \
 	recursive_instance_1 \
 	reordered_existential_constraint \
+	submodule_consistency_test \
 	superclass_bug \
 	superclass_bug2 \
 	superclass_bug3 \
Index: tests/hard_coded/typeclasses/submodule_consistency_tc.m
===================================================================
RCS file: tests/hard_coded/typeclasses/submodule_consistency_tc.m
diff -N tests/hard_coded/typeclasses/submodule_consistency_tc.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/submodule_consistency_tc.m	18 Jan 2010 07:07:39 -0000
@@ -0,0 +1,9 @@
+:- module submodule_consistency_tc.
+:- interface.
+
+:- import_module io.
+
+:- typeclass tc(A, B) <= ((A -> B)) where 
+[
+    pred atob(A::in, B::out, io::di, io::uo) is det
+].
Index: tests/hard_coded/typeclasses/submodule_consistency_tcin.m
===================================================================
RCS file: tests/hard_coded/typeclasses/submodule_consistency_tcin.m
diff -N tests/hard_coded/typeclasses/submodule_consistency_tcin.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/submodule_consistency_tcin.m	18 Jan 2010 07:07:39 -0000
@@ -0,0 +1,25 @@
+:- module submodule_consistency_tcin.
+
+:- interface.
+
+:- import_module submodule_consistency_tc.
+
+:- type b(B) ---> b(B).
+:- type a(A) ---> a(A).
+
+% The following instance caused problems because the abstract instance
+% declaration was included twice in the private interface file.
+:- instance tc(a(A), b(B)) <= tc(A, B).
+
+:- implementation.
+
+:- include_module submodule_consistency_tcin.sub.
+:- import_module submodule_consistency_tcin.sub.
+
+:- instance tc(a(A), b(B)) <= tc(A, B) where
+[
+    (atob(a(A), b(B), !IO) :-
+        atob(A, B, !IO)
+    )
+].
+
Index: tests/hard_coded/typeclasses/submodule_consistency_tcin.sub.m
===================================================================
RCS file: tests/hard_coded/typeclasses/submodule_consistency_tcin.sub.m
diff -N tests/hard_coded/typeclasses/submodule_consistency_tcin.sub.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/submodule_consistency_tcin.sub.m	18 Jan 2010 07:07:39 -0000
@@ -0,0 +1,13 @@
+:- module submodule_consistency_tcin.sub.
+
+:- interface.
+
+:- import_module io.
+
+:- pred test(io::di, io::uo) is det.
+
+:- implementation.
+
+test(!IO) :-
+    io.write_string("Sub", !IO).
+
Index: tests/hard_coded/typeclasses/submodule_consistency_test.exp
===================================================================
RCS file: tests/hard_coded/typeclasses/submodule_consistency_test.exp
diff -N tests/hard_coded/typeclasses/submodule_consistency_test.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/submodule_consistency_test.exp	18 Jan 2010 07:07:39 -0000
@@ -0,0 +1 @@
+Hello world
Index: tests/hard_coded/typeclasses/submodule_consistency_test.m
===================================================================
RCS file: tests/hard_coded/typeclasses/submodule_consistency_test.m
diff -N tests/hard_coded/typeclasses/submodule_consistency_test.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/submodule_consistency_test.m	18 Jan 2010 07:07:39 -0000
@@ -0,0 +1,18 @@
+:- module submodule_consistency_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+
+:- implementation.
+
+:- import_module string.
+
+:- import_module submodule_consistency_tcin.
+
+main(!IO) :-
+    io.write_string("Hello world\n", !IO).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------