[m-rev.] diff: check for duplicated instance tvars

[Mark Brown]

Estimated hours taken: 1.5
Branches: main

compiler/prog_io_typeclass.m:
	Enforce the requirement that type variables in instance declarations
	are distinct.

tests/invalid/Mmakefile:
tests/invalid/instance_dup_var.err_exp:
tests/invalid/instance_dup_var.m:
	Test case.

tests/hard_coded/typeclasses/Mmakefile:
	Disable the instance_unconstrained_tvar_dup test case, since we
	don't support the feature that it tests.

tests/invalid/range_restrict.err_exp:
tests/invalid/range_restrict.m:
tests/valid/mpj5.m:
	Comment out the parts of these test cases which use duplicated
	instance variables, and adjust the expected output where applicable.

Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.55
diff -u -r1.55 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m	13 Oct 2006 04:52:24 -0000	1.55
+++ compiler/prog_io_typeclass.m	19 Oct 2006 05:33:53 -0000
@@ -68,6 +68,7 @@
 :- import_module maybe.
 :- import_module pair.
 :- import_module set.
+:- import_module solutions.
 :- import_module string.
 :- import_module term.
 :- import_module varset.
@@ -604,18 +605,21 @@
         ModuleName, Result) :-
     (
         % Check that each type in the arguments of the instance decl
-        % is a functor with vars as args.
-        some [Type] (
-            list.member(Type, Types),
-            \+ type_is_functor_and_vars(Type)
-        )
+        % is a functor with vars as args...
+        all [Type] (
+            list.member(Type, Types)
+        =>
+            type_is_functor_and_vars(Type)
+        ),
+        % ...and that the vars are distinct across the entire arg list.
+        type_vars_are_distinct(Types)
     ->
+        Result = ok1(item_instance([], ClassName, Types,
+            instance_body_abstract, TVarSet, ModuleName))
+    ;
         Msg = "types in instance declarations must be functors " ++
             "with distinct variables as arguments",
         Result = error1([Msg - ErrorTerm])
-    ;
-        Result = ok1(item_instance([], ClassName, Types,
-            instance_body_abstract, TVarSet, ModuleName))
     ).
 
 :- pred type_is_functor_and_vars(mer_type::in) is semidet.
@@ -649,6 +653,16 @@
         type_is_var(Arg)
     ).
 
+:- pred type_vars_are_distinct(list(mer_type)::in) is semidet.
+
+type_vars_are_distinct(Types) :-
+    promise_equivalent_solutions [NumVars, VarsWithoutDups] (
+        solutions.unsorted_solutions(type_list_contains_var(Types), Vars),
+        list.length(Vars, NumVars),
+        list.sort_and_remove_dups(Vars, VarsWithoutDups)
+    ),
+    list.length(VarsWithoutDups, NumVars).
+
 :- pred parse_non_empty_instance(module_name::in, term::in, term::in,
     varset::in, tvarset::in, maybe1(item)::out) is det.
 
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.57
diff -u -r1.57 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile	7 Jun 2006 14:37:39 -0000	1.57
+++ tests/hard_coded/typeclasses/Mmakefile	19 Oct 2006 07:08:38 -0000
@@ -37,7 +37,6 @@
 	impure_methods \
 	instance_clauses \
 	instance_unconstrained_tvar \
-	instance_unconstrained_tvar_dup \
 	instance_unconstrained_tvar_type_spec \
 	inference_test \
 	inference_test_2 \
@@ -97,6 +96,10 @@
 	test_default_func_mode \
 	typeclass_test_5
 
+# We don't support duplicated type variables in instance declarations yet.
+# When we do, this test case should be enabled.
+#	instance_unconstrained_tvar_dup
+
 ifneq "$(findstring java,$(GRADE))" ""
 	PROGS=$(JAVA_TYPECLASSES_PROGS)
 else
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.198
diff -u -r1.198 Mmakefile
--- tests/invalid/Mmakefile	9 Oct 2006 06:40:27 -0000	1.198
+++ tests/invalid/Mmakefile	19 Oct 2006 05:34:40 -0000
@@ -100,6 +100,7 @@
 	inline_conflict \
 	inst_list_dup \
 	instance_bug \
+	instance_dup_var \
 	invalid_export_detism \
 	invalid_import_detism \
 	invalid_main \
Index: tests/invalid/instance_dup_var.err_exp
===================================================================
RCS file: tests/invalid/instance_dup_var.err_exp
diff -N tests/invalid/instance_dup_var.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/instance_dup_var.err_exp	19 Oct 2006 05:35:15 -0000
@@ -0,0 +1,2 @@
+instance_dup_var.m:012: Error: types in instance declarations must be functors with distinct variables as arguments: baz(foo(_1, _1), bar).
+instance_dup_var.m:015: Error: types in instance declarations must be functors with distinct variables as arguments: baz(foo(_1, _2), foo(_3, _1)).
Index: tests/invalid/instance_dup_var.m
===================================================================
RCS file: tests/invalid/instance_dup_var.m
diff -N tests/invalid/instance_dup_var.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/instance_dup_var.m	19 Oct 2006 05:16:30 -0000
@@ -0,0 +1,16 @@
+:- module instance_dup_var.
+:- interface.
+
+:- type foo(A, B) ---> foo(A, B).
+:- type bar ---> bar.
+
+:- typeclass baz(X, Y) where [].
+
+:- implementation.
+
+	% Error: T is duplicated.
+:- instance baz(foo(T, T), bar) where [].
+
+	% Error: A is duplicated.
+:- instance baz(foo(A, B), foo(C, A)) where [].
+
Index: tests/invalid/range_restrict.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/range_restrict.err_exp,v
retrieving revision 1.3
diff -u -r1.3 range_restrict.err_exp
--- tests/invalid/range_restrict.err_exp	13 Oct 2006 04:52:38 -0000	1.3
+++ tests/invalid/range_restrict.err_exp	19 Oct 2006 07:20:03 -0000
@@ -1,8 +1,4 @@
-range_restrict.m:011: In instance for typeclass `range_restrict.foo'/2:
-range_restrict.m:011:   functional dependency not satisfied: type variable Y
-range_restrict.m:011:   occurs in the range of the functional dependency, but
-range_restrict.m:011:   is not in the domain.
-range_restrict.m:012: In instance for typeclass `range_restrict.foo'/2:
-range_restrict.m:012:   functional dependency not satisfied: type variables Y
-range_restrict.m:012:   and Z occur in the range of the functional dependency,
-range_restrict.m:012:   but are not in the domain.
+range_restrict.m:010: In instance for typeclass `range_restrict.foo'/2:
+range_restrict.m:010:   functional dependency not satisfied: type variables Y
+range_restrict.m:010:   and Z occur in the range of the functional dependency,
+range_restrict.m:010:   but are not in the domain.
Index: tests/invalid/range_restrict.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/range_restrict.m,v
retrieving revision 1.1
diff -u -r1.1 range_restrict.m
--- tests/invalid/range_restrict.m	20 Apr 2005 12:57:46 -0000	1.1
+++ tests/invalid/range_restrict.m	19 Oct 2006 07:10:35 -0000
@@ -6,8 +6,10 @@
 :- implementation.
 :- import_module list, map.
 
-	% Errors: range-restrictedness
-
-:- instance foo(list(X), map(X, Y)) where [].
+	% Error: range-restrictedness
 :- instance foo(map(W, X), map(Y, Z)) where [].
 
+	% This is also a range-restrictedness error, but since we don't
+	% support duplicated type vars in instance declarations yet, we
+	% can't test for it.
+% :- instance foo(list(X), map(X, Y)) where [].
Index: tests/valid/mpj5.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/mpj5.m,v
retrieving revision 1.1
diff -u -r1.1 mpj5.m
--- tests/valid/mpj5.m	20 Apr 2005 12:57:59 -0000	1.1
+++ tests/valid/mpj5.m	19 Oct 2006 07:13:57 -0000
@@ -11,28 +11,31 @@
 :- type w(T) ---> w(T).
 :- type cf(T) ---> cf(func(T) = bool).
 
-:- instance coll(w(T), list(T)).
-:- instance coll(w(T), cf(T)).
 :- instance coll(int, int).
 
+% We don't support duplicated type vars in instances yet, so these cases
+% are disabled for the moment.
+% :- instance coll(w(T), list(T)).
+% :- instance coll(w(T), cf(T)).
+
 :- implementation.
 :- import_module int.
 
-:- instance coll(w(T), list(T)) where [
-	(e = []),
-	(i(w(E), L) = [E | L]),
-	(m(w(E), L) :- list__member(E, L))
-].
-
-:- instance coll(w(T), cf(T)) where [
-	(e = cf(func(_) = no)),
-	(i(w(E), cf(F)) = cf(func(X) = ( X = E -> yes ; F(X) ))),
-	(m(w(E), cf(F)) :- F(E) = yes)
-].
-
 :- instance coll(int, int) where [
 	(e = 0),
 	(i(N, B) = B \/ (1 << N)),
 	(m(N, B) :- B /\ (1 << N) \= 0)
 ].
 
+% :- instance coll(w(T), list(T)) where [
+% 	(e = []),
+% 	(i(w(E), L) = [E | L]),
+% 	(m(w(E), L) :- list__member(E, L))
+% ].
+
+% :- instance coll(w(T), cf(T)) where [
+% 	(e = cf(func(_) = no)),
+% 	(i(w(E), cf(F)) = cf(func(X) = ( X = E -> yes ; F(X) ))),
+% 	(m(w(E), cf(F)) :- F(E) = yes)
+% ].
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------