[m-rev.] diff: fix handling of abstract typeclass declarations

[Simon Taylor]

Estimated hours taken: 0.5
Branches: main

compiler/make_hlds.m:
	Apply a missing subsitution when checking whether the superclass
	constraints for a typeclass declaration match.

tests/valid/Mmakefile:
tests/valid/abstract_typeclass.m:
	Test case.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.392
diff -u -u -r1.392 make_hlds.m
--- compiler/make_hlds.m	12 Dec 2001 00:30:02 -0000	1.392
+++ compiler/make_hlds.m	3 Jan 2002 14:49:20 -0000
@@ -2501,11 +2501,14 @@
 :- mode superclass_constraints_are_identical(in, in,
 	in, in, in, in) is semidet.
 
-superclass_constraints_are_identical(OldVars, OldVarSet, OldConstraints0,
+superclass_constraints_are_identical(OldVars0, OldVarSet, OldConstraints0,
 		Vars, VarSet, Constraints) :-
 	varset__merge_subst(VarSet, OldVarSet, _, Subst),
 	apply_subst_to_constraint_list(Subst,
 		OldConstraints0, OldConstraints1),
+	OldVars = term__term_list_to_var_list(
+		map__apply_to_list(OldVars0, Subst)),
+
 	map__from_corresponding_lists(OldVars, Vars, VarRenaming),
 	apply_variable_renaming_to_constraint_list(VarRenaming,
 		OldConstraints1, OldConstraints),
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.93
diff -u -u -r1.93 Mmakefile
--- tests/valid/Mmakefile	29 Dec 2001 06:37:33 -0000	1.93
+++ tests/valid/Mmakefile	3 Jan 2002 13:46:03 -0000
@@ -21,6 +21,7 @@
 	semi_fail_in_non_ite.m
 
 TYPECLASS_SOURCES= \
+	abstract_typeclass.m \
 	constraint_proof_bug.m \
 	func_method.m \
 	instance_superclass.m \
Index: tests/valid/abstract_typeclass.m
===================================================================
RCS file: tests/valid/abstract_typeclass.m
diff -N tests/valid/abstract_typeclass.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/abstract_typeclass.m	3 Jan 2002 13:45:13 -0000
@@ -0,0 +1,12 @@
+:- module abstract_typeclass.
+
+:- interface.
+
+:- typeclass group(T) where [].
+:- typeclass scalable(T) where [].
+
+:- typeclass vector(T) <= (group(T), scalable(T)).
+:- typeclass vector(T) <= (group(T), scalable(T)) where [
+        func dot(T, T) = float
+].
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------