newtype deriving clause ceases to work in HEAD

Simon Peyton-Jones simonpj at microsoft.com
Wed Nov 29 21:12:50 EST 2006


It's actually a software engineering choice, in this case a good one.  The instance that 6.4.1 derives looks like this:

instance MonadReader a (ReaderT r (ErrorT CompilerError (Either CompilerError)))
       => MonadReader a (CM r)

The instance declaration is ok, but you'll never be able to use it, because the instance in Control.Monad.Reader looks like:

instance (Monad m) => MonadReader r (ReaderT r m) where

You intended to write
        deriving (MonadReader r)

GHC 6.4.1 accepts your declaration but generates a useless insatance decl.   GHC 6.6 will still let you generate the same instance, but only if you use another type variable, for instance
        deriving (MonadReader x)

GHC 6.6's behaviour is defined by the appropriate section of the user manual, which you got when you pulled the HEAD.

In short, a false alarm, I believe, though it took me a few minutes to puzzle out!

Simon

| -----Original Message-----
| From: glasgow-haskell-users-bounces at haskell.org [mailto:glasgow-haskell-users-
| bounces at haskell.org] On Behalf Of Mathieu Boespflug
| Sent: 29 November 2006 00:25
| To: glasgow-haskell-users at haskell.org
| Subject: newtype deriving clause ceases to work in HEAD
|
| Hi,
|
| The following code compiles with GHC 6.4.2, but does not typecheck
| with GHC HEAD pulled on Sunday.
|
| module CompilerMonad where
|
| import Control.Monad
| import Control.Monad.Reader
| import Control.Monad.Error
|
| newtype CompilerError = CE String deriving Error
|
| newtype CM r a = CM (ReaderT r (ErrorT CompilerError (Either
| CompilerError)) a)
|     deriving (Monad, MonadReader a, MonadError CompilerError)
|
| Compiling the code gives:
|
| $ /home/mboes/src/ghc/compiler/stage2/ghc-inplace /tmp/CompilerMonad.hs
|
| /tmp/CompilerMonad.hs:10:8:
|     Can't make a derived instance of `MonadReader a (CM r)'
|       (even with cunning newtype deriving:
|        the eta-reduction property does not hold)
|     When deriving instances for `CM'
|
| whereas with 6.4.2
|
| $ ghc-6.4.2 --make /tmp/CompilerMonad.hs
| Chasing modules from: /tmp/CompilerMonad.hs
| Compiling CompilerMonad    ( /tmp/CompilerMonad.hs, /tmp/CompilerMonad.o )
|
| As the above code seemed to be doing what I meant for it to do in
| 6.4.2, and the docs for HEAD don't seem to have changed, I'm curious
| as to why this doesn't work in HEAD anymore, and indeed, if this is
| perhaps a regression?
|
| Thanks,
|
| Mathieu
| _______________________________________________
| Glasgow-haskell-users mailing list
| Glasgow-haskell-users at haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


More information about the Glasgow-haskell-users mailing list