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


_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Reply via email to