GHC 7.0.4 recursion while trying to derive type

Hello, Consider the following code: {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverlappingInstances, UndecidableInstances, FunctionalDependencies #-} class Container a b | a -> b where make :: b -> a data Cont a = Cont a deriving (Show, Eq) instance Container (Cont a) a where make x = Cont x -- Part A instance (Container a b, Show a, Eq a, Num b) => Num a where fromInteger x = make (fromInteger x) d = fromInteger 3 :: Cont Integer -- Part B class Convertable a where fromInt :: Integer -> a instance Convertable Integer where fromInt = id instance (Container a b, Convertable b) => Convertable a where fromInt x = make (fromInt x) e = fromInt 3 :: Cont Integer main = do print d print e Part A and B are basically the same, the only difference being that A uses existing Num typeclass, and B creates a new one. The problem is that it compiles and works in GHC 7.2.2, but in 7.0.4 (which is the one included in the most recent Haskell Platform, that's why I bumped into this issue) part A generates the following error: t4.hs:17:31: Context reduction stack overflow; size = 21 Use -fcontext-stack=N to increase stack size to N $dNum :: Num b19 [ skipped ] $dNum :: Num b0 In the first argument of `make', namely `(fromInteger x)' In the expression: make (fromInteger x) In an equation for `fromInteger': fromInteger x = make (fromInteger x) My understanding is that in line "fromInteger x = make (fromInteger x)" compiler should take into account that 1) the signature for make is "make :: b -> a" 2) type b is known at the moment of creating instance (because a == Cont Integer, which is an instance of Container (Cont Integer) Integer). and cast "fromInteger x" to type b and pass it to make. In 7.0.4 part B (which is based on the same idea) works correctly, so it may have something to do with how fromInteger is defined in GHC guts. So, the question is, could anyone please tell me, is what I am trying to do actually correct, and what was changed from 7.0.4 to 7.2.2 to make it work? Thank you in advance. Best regards, Bogdan

Am 08.01.2012 04:39, schrieb Bogdan Opanchuk:
Hello,
Consider the following code:
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverlappingInstances, UndecidableInstances, FunctionalDependencies #-}
We have also such (cruel) code using these extension.
t4.hs:17:31: Context reduction stack overflow; size = 21 Use -fcontext-stack=N to increase stack size to N
Our code compiles with ghc-7-0.4 if we add -fcontext-stack=31 to the ghc command line. Does your code compile with an increased (try 100) context-stack? [..]
So, the question is, could anyone please tell me, is what I am trying to do actually correct, and what was changed from 7.0.4 to 7.2.2 to make it work?
I cannot answer this, but our code also compiles with ghc-7.2.2 using a lower context-stack (of 26). HTH Christian
Thank you in advance.
Best regards, Bogdan

Am 09.01.2012 13:16, schrieb Christian Maeder:
I cannot answer this, but our code also compiles with ghc-7.2.2 using a lower context-stack (of 26).
Apologies, I've just re-checked and noticed that our code changed and needs consistently -fcontext-stack=26 for ghc-7.2.2 and ghc-7.0.4 (and ghc-7.0.2). C.

Hello Christian,
On Mon, Jan 9, 2012 at 11:31 PM, Christian Maeder
We have also such (cruel) code using these extension.
I understand that this code is not very good; I am just learning Haskell, and it is an experiment to see what its type system can handle.
I cannot answer this, but our code also compiles with ghc-7.2.2 using a lower context-stack (of 26). Apologies, I've just re-checked and noticed that our code changed and needs consistently -fcontext-stack=26 for ghc-7.2.2 and ghc-7.0.4 (and ghc-7.0.2).
I just tried compiling my code with ghc7.0.4 and stack size 100, and it produces the same error. In fact, I would be surprised if it helped, because I would expect either infinite recursion (when type derivation fails) or successful compilation with some small stack size (definitely less than 26). The latter is the case for ghc7.2.2, which successfully compiles my code with stack size 3. Best regards, Bogdan

If you think there's a bug here, could you open a ticket a repro case, please?
Many thanks
Simon
| -----Original Message-----
| From: glasgow-haskell-users-bounces@haskell.org [mailto:glasgow-haskell-
| users-bounces@haskell.org] On Behalf Of Bogdan Opanchuk
| Sent: 09 January 2012 13:00
| To: Christian Maeder
| Cc: glasgow-haskell-users@haskell.org
| Subject: Re: GHC 7.0.4 recursion while trying to derive type
|
| Hello Christian,
|
| On Mon, Jan 9, 2012 at 11:31 PM, Christian Maeder
|

Hello Simon,
On Tue, Jan 10, 2012 at 12:17 AM, Simon Peyton-Jones
If you think there's a bug here, could you open a ticket a repro case, please?
Sure, I just did not think it was sensible to file a bug on something that had been apparently fixed in the most recent stable version of GHC. Here's the bug: http://hackage.haskell.org/trac/ghc/ticket/5759 Best regards, Bogdan
participants (3)
-
Bogdan Opanchuk
-
Christian Maeder
-
Simon Peyton-Jones