[Haskell-cafe] GHC 7.4: Expected behavior or bug?

2011-12-27 Thread Michael Snoyman
Thanks to Mark Wright for pointing this out[1].

We have the equivalent of the following code in persistent:

{-# LANGUAGE MultiParamTypeClasses #-}
data Key backend entity = Key

class Monad (b m) = Foo b m where
func :: b m (Key b m)

This code works fine with GHC 7.0, but I get the following message from GHC 7.4:

Expecting two more arguments to `b'
In the type `b m (Key b m)'
In the class declaration for `Foo'

Is this expected behavior, or a bug? If the former, what would be a
possible workaround?

Thanks,
Michael

[1] https://github.com/yesodweb/persistent/issues/31

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC 7.4: Expected behavior or bug?

2011-12-27 Thread Bas van Dijk
On 27 December 2011 17:38, Michael Snoyman mich...@snoyman.com wrote:
 Thanks to Mark Wright for pointing this out[1].

 We have the equivalent of the following code in persistent:

 {-# LANGUAGE MultiParamTypeClasses #-}
 data Key backend entity = Key

 class Monad (b m) = Foo b m where
    func :: b m (Key b m)

 This code works fine with GHC 7.0, but I get the following message from GHC 
 7.4:

    Expecting two more arguments to `b'
    In the type `b m (Key b m)'
    In the class declaration for `Foo'

 Is this expected behavior, or a bug? If the former, what would be a
 possible workaround?

 Thanks,
 Michael

 [1] https://github.com/yesodweb/persistent/issues/31

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

I fixed a similar breakage in the hmatrix library:

https://github.com/AlbertoRuiz/hmatrix/commit/a4f38eb196209436f72b938f6355f6e28474bef3

I don't know if it's a bug in GHC, but the workaround is to add an
explicit kind signature:

{-# LANGUAGE KindSignatures, MultiParamTypeClasses #-}
data Key (backend :: * - * - *) entity = Key

class Monad (b m) = Foo b m where
   func :: b m (Key b m)

Cheers,

Bas

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC 7.4: Expected behavior or bug?

2011-12-27 Thread Michael Snoyman
On Tue, Dec 27, 2011 at 6:47 PM, Bas van Dijk v.dijk@gmail.com wrote:
 On 27 December 2011 17:38, Michael Snoyman mich...@snoyman.com wrote:
 Thanks to Mark Wright for pointing this out[1].

 We have the equivalent of the following code in persistent:

 {-# LANGUAGE MultiParamTypeClasses #-}
 data Key backend entity = Key

 class Monad (b m) = Foo b m where
    func :: b m (Key b m)

 This code works fine with GHC 7.0, but I get the following message from GHC 
 7.4:

    Expecting two more arguments to `b'
    In the type `b m (Key b m)'
    In the class declaration for `Foo'

 Is this expected behavior, or a bug? If the former, what would be a
 possible workaround?

 Thanks,
 Michael

 [1] https://github.com/yesodweb/persistent/issues/31

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

 I fixed a similar breakage in the hmatrix library:

 https://github.com/AlbertoRuiz/hmatrix/commit/a4f38eb196209436f72b938f6355f6e28474bef3

 I don't know if it's a bug in GHC, but the workaround is to add an
 explicit kind signature:

 {-# LANGUAGE KindSignatures, MultiParamTypeClasses #-}
 data Key (backend :: * - * - *) entity = Key

 class Monad (b m) = Foo b m where
   func :: b m (Key b m)

 Cheers,

 Bas

Thanks Bas, that seems to solve the problem.

Michael

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC 7.4: Expected behavior or bug?

2011-12-27 Thread Bas van Dijk
On 27 December 2011 17:47, Bas van Dijk v.dijk@gmail.com wrote:
 I fixed a similar breakage in the hmatrix library:

 https://github.com/AlbertoRuiz/hmatrix/commit/a4f38eb196209436f72b938f6355f6e28474bef3

GHC-7.4.1-rc1 also reported another type error in code that was
accepted by GHC = 7.2.2. These were the type errors I got:

[24 of 36] Compiling Numeric.LinearAlgebra.Algorithms (
lib/Numeric/LinearAlgebra/Algorithms.hs,
dist/build/Numeric/LinearAlgebra/Algorithms.o )

lib/Numeric/LinearAlgebra/Algorithms.hs:576:23:
No instance for (RealFrac (RealOf t0))
  arising from a use of `floor'
Possible fix:
  add an instance declaration for (RealFrac (RealOf t0))
In the expression: floor
In the second argument of `($)', namely
  `floor $ logBase 2 $ pnorm Infinity m'
In the expression: max 0 $ floor $ logBase 2 $ pnorm Infinity m

lib/Numeric/LinearAlgebra/Algorithms.hs:576:31:
No instance for (Floating (RealOf t0))
  arising from a use of `logBase'
Possible fix:
  add an instance declaration for (Floating (RealOf t0))
In the expression: logBase 2
In the second argument of `($)', namely
  `logBase 2 $ pnorm Infinity m'
In the second argument of `($)', namely
  `floor $ logBase 2 $ pnorm Infinity m'

lib/Numeric/LinearAlgebra/Algorithms.hs:576:39:
No instance for (Num (RealOf t0))
  arising from the literal `2'
Possible fix: add an instance declaration for (Num (RealOf t0))
In the first argument of `logBase', namely `2'
In the expression: logBase 2
In the second argument of `($)', namely
  `logBase 2 $ pnorm Infinity m'

lib/Numeric/LinearAlgebra/Algorithms.hs:576:43:
No instance for (Normed Matrix t0)
  arising from a use of `pnorm'
Possible fix: add an instance declaration for (Normed Matrix t0)
In the second argument of `($)', namely `pnorm Infinity m'
In the second argument of `($)', namely
  `logBase 2 $ pnorm Infinity m'
In the second argument of `($)', namely
  `floor $ logBase 2 $ pnorm Infinity m'

lib/Numeric/LinearAlgebra/Algorithms.hs:593:19:
No instance for (Container Vector t0)
  arising from a use of `add'
Possible fix: add an instance declaration for (Container Vector t0)
In the expression: add
In an equation for `|+|': |+| = add
In an equation for `expGolub':
expGolub m
  = iterate msq f !! j
  where
  j = max 0 $ floor $ logBase 2 $ pnorm Infinity m
  a = m */ fromIntegral ((2 :: Int) ^ j)
  q = geps eps
  eye = ident (rows m)
  

lib/Numeric/LinearAlgebra/Algorithms.hs:599:1:
Couldn't match type `t0' with `t'
  because type variable `t' would escape its scope
This (rigid, skolem) type variable is bound by
  the type signature for expm :: Field t = Matrix t - Matrix t
The following variables have types that mention t0
  expGolub :: Matrix t0 - Matrix t0
(bound at lib/Numeric/LinearAlgebra/Algorithms.hs:575:1)

Note that RealOf is a type family:

type family RealOf x

type instance RealOf Double = Double
type instance RealOf (Complex Double) = Double

type instance RealOf Float = Float
type instance RealOf (Complex Float) = Float

Adding the following explicit type signature fixed it:

expGolub :: ( Fractional t, Element t, Field t
, Normed Matrix t
, RealFrac (RealOf t)
, Floating (RealOf t)
) = Matrix t - Matrix t

I have no idea if this should be considered a bug.

Regards,

Bas

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC 7.4: Expected behavior or bug?

2011-12-27 Thread José Pedro Magalhães
Hi,

This is a change in behavior. Previously GHC was more liberal than Haskell
98 prescribed, and would not default the kind of otherwise unconstrained
type variables to *. 7.4 does default to *, so you have to provide kind
signatures when you want another kind (particularly in phantom type
variables).


Cheers,
Pedro

On Tue, Dec 27, 2011 at 16:47, Bas van Dijk v.dijk@gmail.com wrote:

 On 27 December 2011 17:38, Michael Snoyman mich...@snoyman.com wrote:
  Thanks to Mark Wright for pointing this out[1].
 
  We have the equivalent of the following code in persistent:
 
  {-# LANGUAGE MultiParamTypeClasses #-}
  data Key backend entity = Key
 
  class Monad (b m) = Foo b m where
 func :: b m (Key b m)
 
  This code works fine with GHC 7.0, but I get the following message from
 GHC 7.4:
 
 Expecting two more arguments to `b'
 In the type `b m (Key b m)'
 In the class declaration for `Foo'
 
  Is this expected behavior, or a bug? If the former, what would be a
  possible workaround?
 
  Thanks,
  Michael
 
  [1] https://github.com/yesodweb/persistent/issues/31
 
  ___
  Haskell-Cafe mailing list
  Haskell-Cafe@haskell.org
  http://www.haskell.org/mailman/listinfo/haskell-cafe

 I fixed a similar breakage in the hmatrix library:


 https://github.com/AlbertoRuiz/hmatrix/commit/a4f38eb196209436f72b938f6355f6e28474bef3

 I don't know if it's a bug in GHC, but the workaround is to add an
 explicit kind signature:

 {-# LANGUAGE KindSignatures, MultiParamTypeClasses #-}
 data Key (backend :: * - * - *) entity = Key

 class Monad (b m) = Foo b m where
   func :: b m (Key b m)

 Cheers,

 Bas

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC 7.4: Expected behavior or bug?

2011-12-27 Thread Michael Snoyman
Thanks for the explanation.

2011/12/27 José Pedro Magalhães j...@cs.uu.nl:
 Hi,

 This is a change in behavior. Previously GHC was more liberal than Haskell
 98 prescribed, and would not default the kind of otherwise unconstrained
 type variables to *. 7.4 does default to *, so you have to provide kind
 signatures when you want another kind (particularly in phantom type
 variables).


 Cheers,
 Pedro


 On Tue, Dec 27, 2011 at 16:47, Bas van Dijk v.dijk@gmail.com wrote:

 On 27 December 2011 17:38, Michael Snoyman mich...@snoyman.com wrote:
  Thanks to Mark Wright for pointing this out[1].
 
  We have the equivalent of the following code in persistent:
 
  {-# LANGUAGE MultiParamTypeClasses #-}
  data Key backend entity = Key
 
  class Monad (b m) = Foo b m where
     func :: b m (Key b m)
 
  This code works fine with GHC 7.0, but I get the following message from
  GHC 7.4:
 
     Expecting two more arguments to `b'
     In the type `b m (Key b m)'
     In the class declaration for `Foo'
 
  Is this expected behavior, or a bug? If the former, what would be a
  possible workaround?
 
  Thanks,
  Michael
 
  [1] https://github.com/yesodweb/persistent/issues/31
 
  ___
  Haskell-Cafe mailing list
  Haskell-Cafe@haskell.org
  http://www.haskell.org/mailman/listinfo/haskell-cafe

 I fixed a similar breakage in the hmatrix library:


 https://github.com/AlbertoRuiz/hmatrix/commit/a4f38eb196209436f72b938f6355f6e28474bef3

 I don't know if it's a bug in GHC, but the workaround is to add an
 explicit kind signature:

 {-# LANGUAGE KindSignatures, MultiParamTypeClasses #-}
 data Key (backend :: * - * - *) entity = Key

 class Monad (b m) = Foo b m where
   func :: b m (Key b m)

 Cheers,

 Bas

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe