Functional dependencies question

Andrew J Bromage ajb@spamcop.net
Tue, 13 May 2003 18:16:08 +1000


G'day all.

On Tue, May 13, 2003 at 08:58:35AM +0100, Simon Peyton-Jones wrote:

> Think of it like this.  Should this be acceptable?
> 
> 	f :: a -> a -> a
> 	f x y = x && y

No, because (&&) is not defined on anything but Bool.

> Your signature is
> 	bar :: (Foo Char t) => t
> and we know (from the instance decl) that t must be Bool.

Even if we don't have the instance declaration, we know that t
must be some unique type because of the fundep.  (Of course that
type may be polymorphic, which probably complicates things.)

> It is undoubtedly odd that adding an instance declaration makes a legal
> program illegal, and that might be a reason for relaxing the rule... but
> it's not entirely easy to implement such a relaxation.

Understood, and I'm not so worried about it now that we've found a
few ways to get around my motivating problem.

BTW, even worse than adding an instance declaration making a legal
program illegal is moving an instance declaration across a module
boundary.  GHC appears perfectly happy with this:

<<
	module Foo where

	class Foo a b | a -> b where
	    foo :: a -> b

	bar :: (Foo Char t) => t
	bar = foo 'a'
>>

<<
	module Bar where

	import Foo

	instance Foo Char Bool where
	    foo a = a == 'a'
>>

<<
	% ghci -fglasgow-exts Bar.hs
	[deletia]
	Ok, modules loaded: Bar, Foo.
	*Bar> :t bar
	bar :: Bool
	*Bar> bar
	True
>>

Cheers,
Andrew Bromage