strong type derivation in ghc 6.12 compared to 6.12
Seyed Hosein Attarzadeh Niaki
shan2 at kth.se
Tue Apr 27 15:40:33 EDT 2010
I have problems with upgrading some already working code for GHC 6.12.
The following code:
-----------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable,
GeneralizedNewtypeDeriving, TemplateHaskell #-}
import Data.Data
import Language.Haskell.TH.Syntax
class Nat a
class (Data a, Lift a) => ProcType a
instance (Lift a, Nat s) => Lift (FSVec s a) where
lift (FSVec xs) = undefined
newtype Nat s => FSVec s a = FSVec {unFSVec :: [a]}
deriving (Eq, Typeable, Data)
-- The following line does not cause a problem in GHC 6.10
-- instance (Typeable s, Nat s, ProcType a) => ProcType (FSVec s a)
-----------------------------------------------------------
works fine in ghc 6.10.4 and I get (extra stuff removed):
//
*Main> :i FSVec
newtype (Nat s) => ...
instance (Data a, Typeable s, Nat s) => Data (FSVec s a)
-- Defined at ghctest.hs:16:26-29
...
//
but in 6.12.2 what I get is:
//
*Main> :i FSVec
newtype (Nat s) => ...
instance (Data s, Data a, Nat s) => Data (FSVec s a)
...
//
So, although the last line in the above code compiles correctly in ghc
6.10.4, in 6.12.2 GHC complains with:
//
ghctest.hs:19:10:
Could not deduce (Data s)
from the context (Typeable s, Nat s, ProcType a)
arising from the superclasses of an instance declaration
at ghctest.hs:19:10-64
Possible fix:
add (Data s) to the context of the instance declaration
In the instance declaration for `ProcType (FSVec s a)'
Failed, modules loaded: none.
//
Why are they different? Why 6.12 derives a stronger constraint? Is it a
bug or it was not working correctly before?
--
Hosein Attarzadeh
More information about the Glasgow-haskell-users
mailing list