newtype deriving clause ceases to work in HEAD

Mathieu Boespflug mboes at tweag.net
Tue Nov 28 19:25:00 EST 2006


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


More information about the Glasgow-haskell-users mailing list