On Jul 25, 2011, at 4:55 PM, Ryan Ingram wrote:
My guess is that nobody has put forward a clear enough design that solves all the problems. In particular, orphan instances are tricky.
Here's an example:
module Prelude where
class (Functor m, Applicative m) => Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
a >> b = a >>= const b
pure = return
(<*>) = ap
fmap = liftM
module X where
data X a = ...
module Y where
instance Functor X where fmap = ...
module Z where
instance Monad X where
return = ...
(>>=) = ...
-- default implementation of fmap brought in from Monad definition
module Main where
import X
import Z
foo :: X Int
foo = ...
bar :: X Int
bar = fmap (+1) foo -- which implementation of fmap is used? The one from Y?
I don't believe it would make orphan instances any trickier than they already are. If Functor m => Monad m, you can't have Monad m without Functor m, so module Z must introduce Functor m either implicitly or explicitly or it cannot compile. Viewed from outside a module, the problem is the same either way. I would propose that viewed from outside a module, an implicitly declared instance should be indistinguishable from an explicitly declared one, and within a module the implicit instance would be generated if and only if there is no overlapping instance in scope. An additional warning flag could be added to warn people who are worried about it that they have implicitly created an orphan instance for a superclass.
The only real problem I see relating to orphans is in cases where old code declares an orphan Monad instance for a type without a Functor instances, something which I don't think happens very often (except perhaps with Either, but forcing a solution to that hornet's nest would be a Good Thing IMO). But either way, that breakage is more related to the superclass change than to any new means of declaring instances; even without the latter, the former would force those modules to introduce orphan Functor instances explicitly (or to introduce non-orphans somewhere to avoid doing so)