
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? -- ryan On Sun, Jul 24, 2011 at 8:55 PM, Ivan Lazar Miljenovic < ivan.miljenovic@gmail.com> wrote:
On 25 July 2011 13:50, Sebastien Zany
wrote: I was thinking the reverse. We can already give default implementations of class operations that can be overridden by giving them explicitly when we declare instances, so why shouldn't we be able to give default implementations of operations of more general classes, which could be overridden by a separate instance declaration for these?
Then I could say something like "a monad is also automatically a functor with fmap by default given by..." and if I wanted to give a more efficient fmap for a particular monad I would just instantiate it as a functor explicitly.
I believe this has been proposed before, but a major problem is that you cannot do such overriding.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe