[m-rev.] for review: allow arbitrary types in class constraints

[David Overton]

On Fri, May 03, 2002 at 10:23:43AM +0100, David Jeffery wrote:
> The diff looks fine, but could you please post the full versions of all the
> test cases rather than relative diffs? I'd like to make sure that all the
> important cases have been tested before you commit.


Index: hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.44
diff -u -r1.44 Mmakefile
--- hard_coded/typeclasses/Mmakefile	12 Feb 2001 05:14:57 -0000	1.44
+++ hard_coded/typeclasses/Mmakefile	6 May 2002 00:01:49 -0000
@@ -8,6 +8,9 @@
 #-----------------------------------------------------------------------------#
 
 PROGS=	\
+	arbitrary_constraint_class \
+	arbitrary_constraint_pred_2 \
+	arbitrary_constraint_pred_1 \
 	constrained_lambda \
 	extract_typeinfo \
 	exist_disjunction \
@@ -42,6 +45,7 @@
 	nondet_class_method \
 	operator_classname \
 	record_syntax \
+	recursive_instance_1 \
 	reordered_existential_constraint \
 	superclass_bug \
 	superclass_bug2 \
Index: hard_coded/typeclasses/arbitrary_constraint_class.exp
===================================================================
RCS file: hard_coded/typeclasses/arbitrary_constraint_class.exp
diff -N hard_coded/typeclasses/arbitrary_constraint_class.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/arbitrary_constraint_class.exp	6 May 2002 00:01:49 -0000
@@ -0,0 +1 @@
+0.00000000000000
Index: hard_coded/typeclasses/arbitrary_constraint_class.m
===================================================================
RCS file: hard_coded/typeclasses/arbitrary_constraint_class.m
diff -N hard_coded/typeclasses/arbitrary_constraint_class.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/arbitrary_constraint_class.m	6 May 2002 00:01:49 -0000
@@ -0,0 +1,37 @@
+:- module arbitrary_constraint_class.
+:- interface.
+
+:- import_module float, string, io.
+
+:- typeclass solver_for(B, S) where [
+	func coerce(B) = S
+].
+
+:- typeclass solver_for_float(U) <= solver_for(float, U) where [].
+
+:- instance solver_for(float, string) where [
+	coerce(Float) = string__float_to_string(Float)
+].
+
+:- instance solver_for_float(string) where [].
+
+:- pred mg(T, T) <= solver_for_float(T).
+:- mode mg(in, out) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module std_util.
+
+mg(S0, S) :-
+	( semidet_succeed ->
+		S = coerce(0.0)
+	;
+		S = S0
+	).
+
+
+main -->
+	{ mg("1.0", S) },
+	io__write_string(S),
+	io__nl.
Index: hard_coded/typeclasses/arbitrary_constraint_pred_1.exp
===================================================================
RCS file: hard_coded/typeclasses/arbitrary_constraint_pred_1.exp
diff -N hard_coded/typeclasses/arbitrary_constraint_pred_1.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/arbitrary_constraint_pred_1.exp	6 May 2002 00:01:49 -0000
@@ -0,0 +1 @@
+0.00000000000000
Index: hard_coded/typeclasses/arbitrary_constraint_pred_1.m
===================================================================
RCS file: hard_coded/typeclasses/arbitrary_constraint_pred_1.m
diff -N hard_coded/typeclasses/arbitrary_constraint_pred_1.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/arbitrary_constraint_pred_1.m	6 May 2002 00:01:49 -0000
@@ -0,0 +1,33 @@
+:- module arbitrary_constraint_pred_1.
+:- interface.
+
+:- import_module float, string, io.
+
+:- typeclass solver_for(B, S) where [
+	func coerce(B) = S
+].
+
+:- instance solver_for(float, string) where [
+	coerce(Float) = string__float_to_string(Float)
+].
+
+:- pred mg(T, T) <= solver_for(float, T).
+:- mode mg(in, out) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module std_util.
+
+mg(S0, S) :-
+	( semidet_succeed ->
+		S = coerce(0.0)
+	;
+		S = S0
+	).
+
+
+main -->
+	{ mg("1.0", S) },
+	io__write_string(S),
+	io__nl.
Index: hard_coded/typeclasses/arbitrary_constraint_pred_2.exp
===================================================================
RCS file: hard_coded/typeclasses/arbitrary_constraint_pred_2.exp
diff -N hard_coded/typeclasses/arbitrary_constraint_pred_2.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/arbitrary_constraint_pred_2.exp	6 May 2002 00:01:49 -0000
@@ -0,0 +1 @@
+42.0000000000000
Index: hard_coded/typeclasses/arbitrary_constraint_pred_2.m
===================================================================
RCS file: hard_coded/typeclasses/arbitrary_constraint_pred_2.m
diff -N hard_coded/typeclasses/arbitrary_constraint_pred_2.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/arbitrary_constraint_pred_2.m	6 May 2002 00:01:49 -0000
@@ -0,0 +1,34 @@
+:- module arbitrary_constraint_pred_2.
+:- interface.
+
+:- import_module float, io.
+:- import_module list.
+
+:- typeclass solver_for(B, S) where [
+	func coerce(B) = S
+].
+
+:- instance solver_for(list(T), float) where [
+	coerce(_) = 42.0
+].
+
+:- pred mg(T, T) <= solver_for(list(T), T).
+:- mode mg(in, out) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module std_util.
+
+mg(S0, S) :-
+	( semidet_succeed ->
+		S = coerce([S0])
+	;
+		S = S0
+	).
+
+
+main -->
+	{ mg(1.0, S) },
+	io__print(S),
+	io__nl.
Index: hard_coded/typeclasses/recursive_instance_1.exp
===================================================================
RCS file: hard_coded/typeclasses/recursive_instance_1.exp
diff -N hard_coded/typeclasses/recursive_instance_1.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/recursive_instance_1.exp	6 May 2002 00:01:49 -0000
@@ -0,0 +1 @@
+3
Index: hard_coded/typeclasses/recursive_instance_1.m
===================================================================
RCS file: hard_coded/typeclasses/recursive_instance_1.m
diff -N hard_coded/typeclasses/recursive_instance_1.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ hard_coded/typeclasses/recursive_instance_1.m	6 May 2002 00:01:49 -0000
@@ -0,0 +1,34 @@
+:- module recursive_instance_1.
+:- interface.
+
+:- import_module int, io.
+:- import_module list.
+
+:- typeclass foo(T, U) where [
+	func bar(T) = U
+].
+
+:- instance foo(int, list(T)) <= foo(list(int), T) where [
+	bar(N) = ( N < 0 -> [bar([N+1])] ; [] )
+].
+
+:- instance foo(list(T), int) <= foo(T, list(int)) where [
+	( bar([X | Xs]) = N + bar(Xs) :-
+		bar(X) = B,
+		( B = [N | _]
+		; B = [],
+			N = 1
+		)
+	),
+	( bar([]) = 0 )
+].
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module std_util, char.
+
+main -->
+	{ X = bar([0,1,2]) },
+	io__write_int(X),
+	io__nl.
Index: invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.108
diff -u -r1.108 Mmakefile
--- invalid/Mmakefile	25 Mar 2002 21:13:29 -0000	1.108
+++ invalid/Mmakefile	6 May 2002 00:01:49 -0000
@@ -103,6 +103,8 @@
 	type_mismatch.m \
 	type_vars.m \
 	typeclass_bogus_method.m \
+	typeclass_constraint_extra_var.m \
+	typeclass_constraint_no_var.m \
 	typeclass_mode.m \
 	typeclass_missing_det.m \
 	typeclass_missing_det_2.m \
Index: invalid/typeclass_constraint_extra_var.err_exp
===================================================================
RCS file: invalid/typeclass_constraint_extra_var.err_exp
diff -N invalid/typeclass_constraint_extra_var.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ invalid/typeclass_constraint_extra_var.err_exp	6 May 2002 00:01:49 -0000
@@ -0,0 +1,8 @@
+typeclass_constraint_extra_var.m:015: In declaration for predicate `typeclass_constraint_extra_var:mg/2':
+typeclass_constraint_extra_var.m:015:   error in type class constraints: type variable
+typeclass_constraint_extra_var.m:015:   `U' occurs only in the constraints,
+typeclass_constraint_extra_var.m:015:   not in the predicate's argument types.
+typeclass_constraint_extra_var.m:025: In clause for predicate `typeclass_constraint_extra_var:mg/2':
+typeclass_constraint_extra_var.m:025:   unsatisfiable typeclass constraint(s):
+typeclass_constraint_extra_var.m:025:   `typeclass_constraint_extra_var:solver_for((list:list(T)), T)'.
+For more information, try recompiling with `-E'.
Index: invalid/typeclass_constraint_extra_var.m
===================================================================
RCS file: invalid/typeclass_constraint_extra_var.m
diff -N invalid/typeclass_constraint_extra_var.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ invalid/typeclass_constraint_extra_var.m	6 May 2002 00:01:49 -0000
@@ -0,0 +1,34 @@
+:- module typeclass_constraint_extra_var.
+:- interface.
+
+:- import_module float, io.
+:- import_module list.
+
+:- typeclass solver_for(B, S) where [
+	func coerce(B) = S
+].
+
+:- instance solver_for(list(T), float) where [
+	coerce(_) = 42.0
+].
+
+:- pred mg(T, T) <= solver_for(list(U), T).
+:- mode mg(in, out) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module std_util.
+
+mg(S0, S) :-
+	( semidet_succeed ->
+		S = coerce([S0])
+	;
+		S = S0
+	).
+
+
+main -->
+	{ mg(1.0, S) },
+	io__print(S),
+	io__nl.
Index: invalid/typeclass_constraint_no_var.err_exp
===================================================================
RCS file: invalid/typeclass_constraint_no_var.err_exp
diff -N invalid/typeclass_constraint_no_var.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ invalid/typeclass_constraint_no_var.err_exp	6 May 2002 00:01:49 -0000
@@ -0,0 +1,5 @@
+typeclass_constraint_no_var.m:015: Error: class constraint contains no variables: solver_for(list(float), float).
+typeclass_constraint_no_var.m:016: Error: mode declaration for predicate `typeclass_constraint_no_var:mg/2'
+typeclass_constraint_no_var.m:016:   without preceding `pred' declaration.
+typeclass_constraint_no_var.m:016: Inferred :- pred mg(T1, T1).
+For more information, try recompiling with `-E'.
Index: invalid/typeclass_constraint_no_var.m
===================================================================
RCS file: invalid/typeclass_constraint_no_var.m
diff -N invalid/typeclass_constraint_no_var.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ invalid/typeclass_constraint_no_var.m	6 May 2002 00:01:49 -0000
@@ -0,0 +1,34 @@
+:- module typeclass_constraint_no_var.
+:- interface.
+
+:- import_module float, io.
+:- import_module list.
+
+:- typeclass solver_for(B, S) where [
+	func coerce(B) = S
+].
+
+:- instance solver_for(list(T), float) where [
+	coerce(_) = 42.0
+].
+
+:- pred mg(T, T) <= solver_for(list(float), float).
+:- mode mg(in, out) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module std_util.
+
+mg(S0, S) :-
+	( semidet_succeed ->
+		S = S0
+	;
+		S = S0
+	).
+
+
+main -->
+	{ mg(1.0, S) },
+	io__print(S),
+	io__nl.

-- 
David Overton      Computer Science and Software Engineering
PhD Student        The University of Melbourne   +61 3 8344 9159
Research Fellow    Monash University (Clayton)   +61 3 9905 5779
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------