type signature error in a where clause

I'm writing a merge sort function, but I get type error under such implementation: mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp xs = mergeAll (map (\x -> [x]) xs) where mergeAll :: [[a]] -> [a] mergeAll [x] = x mergeAll xs = mergeAll (mergePairs xs) mergePairs :: [[a]] -> [[a]] mergePairs (a:b:xs) = merge a b : mergePairs xs mergePairs xs = xs merge :: [a] -> [a] -> [a] merge as@(a:as') bs@(b:bs') | cmp a b == GT = b : merge as bs' | otherwise = a : merge as' bs merge [] bs = bs merge as [] = as And ghc says: Couldn't match type `a1' with `a' `a1' is a rigid type variable bound by the type signature for merge :: [a1] -> [a1] -> [a1] at /home/ice/Study/Haskell/tutorials/99Questions/21to30.hs:135:7 `a' is a rigid type variable bound by the type signature for mergesort :: (a -> a -> Ordering) -> [a] -> [a] at /home/ice/Study/Haskell/tutorials/99Questions/21to30.hs:124:1 In the first argument of `cmp', namely `a' In the first argument of `(==)', namely `cmp a b' In the expression: cmp a b == GT But if I comment all type signatures, ghc works fine on it. I would really appreciate it if you can point out what causes this question? And how to fix it without changing the structure of the program (i.e. not adding function `cmp' as a parameter of `merge' etc.). Thx.

Basically your "a" in the signature in your where-clause is not the same as the "a" from the signature of your whole function so it like you're writing : mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp xs = mergeAll (map (\x -> [x]) xs) where mergeAll :: [[b]] -> [b] mergeAll [x] = x mergeAll xs = mergeAll (mergePairs xs) mergePairs :: [[c]] -> [[c]] mergePairs (a:b:xs) = merge a b : mergePairs xs mergePairs xs = xs merge :: [d] -> [d] -> [d] merge as@(a:as') bs@(b:bs') | cmp a b == GT = b : merge as bs' | otherwise = a : merge as' bs merge [] bs = bs merge as [] = as And since you use "cmp" in "merge" and "cmp" only works with the "a" from your whole function... There is a conflict : you're saying that merge can work for any type but cmp only work for the type with which this mergesort was called. Now I suppose you wanted your "a" in the where-clause to refer to the same "a" as the signature of mergesort, but to do that you'll have to explicitly introduce the "a" type variable with a forall so : mergesort :: forall a . (a -> a -> Ordering) -> [a] -> [a] Then the scope of the "a" type variable will extend to the whole function declaration (where-clause included) instead of being only the signature in which it appears as is the case by default. Note that you'll need to authorize the use of the forall keywords by adding : {-# LANGUAGE ExplicitForall #-} to the beginning of your file. -- Jedaï

On Sat, Nov 24, 2012 at 9:46 AM, Chaddaï Fouché
Note that you'll need to authorize the use of the forall keywords by adding :
{-# LANGUAGE ExplicitForall #-}
to the beginning of your file.
I think you forgot {-# LANGUAGE ScopedTypeVariables #-} ? -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix/linux, openafs, kerberos, infrastructure http://sinenomine.net

Right, sorry I should have tested :)
I guess ScopedTypeVariables allows the forall keyword too, like myriad
of other extensions ? (In my opinion, this extension should really be
part of the Haskell standard, it's pretty useful, though not
indispensable)
On Sat, Nov 24, 2012 at 4:00 PM, Brandon Allbery
On Sat, Nov 24, 2012 at 9:46 AM, Chaddaï Fouché
wrote: Note that you'll need to authorize the use of the forall keywords by adding :
{-# LANGUAGE ExplicitForall #-}
to the beginning of your file.
I think you forgot {-# LANGUAGE ScopedTypeVariables #-} ?
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix/linux, openafs, kerberos, infrastructure http://sinenomine.net

On Sat, Nov 24, 2012 at 10:07 AM, Chaddaï Fouché
Right, sorry I should have tested :)
I guess ScopedTypeVariables allows the forall keyword too, like myriad
Since it's a prerequisite, yes. (I think almost all uses of ScopedTypeVariables can be replaced by not specifying type signatures, possibly with `asTypeOf` to help type inference along, but is sometimes required if you want to write a type signature for such functions.) -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix/linux, openafs, kerberos, infrastructure http://sinenomine.net

On Samstag, 24. November 2012, 22:04:15, Mark Wallace wrote:
I'm writing a merge sort function, but I get type error under such implementation:
mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp xs = mergeAll (map (\x -> [x]) xs) where mergeAll :: [[a]] -> [a] mergeAll [x] = x mergeAll xs = mergeAll (mergePairs xs)
mergePairs :: [[a]] -> [[a]] mergePairs (a:b:xs) = merge a b : mergePairs xs mergePairs xs = xs
merge :: [a] -> [a] -> [a] merge as@(a:as') bs@(b:bs')
| cmp a b == GT = b : merge as bs' | otherwise = a : merge as' bs
merge [] bs = bs merge as [] = as
And ghc says:
Couldn't match type `a1' with `a' `a1' is a rigid type variable bound by the type signature for merge :: [a1] -> [a1] -> [a1] at /home/ice/Study/Haskell/tutorials/99Questions/21to30.hs:135:7 `a' is a rigid type variable bound by the type signature for mergesort :: (a -> a -> Ordering) -> [a] -> [a] at /home/ice/Study/Haskell/tutorials/99Questions/21to30.hs:124:1 In the first argument of `cmp', namely `a' In the first argument of `(==)', namely `cmp a b' In the expression: cmp a b == GT
But if I comment all type signatures, ghc works fine on it. I would really appreciate it if you can point out what causes this question?
Type variables are implicitly for all-quantified. Thus the type variable a in the signatures of the local functions is a fresh type variable and has nothing to do with the a from the top-level signature. It is equivalent to you writing merge :: [b] -> [b] -> [b] except there it is obvious that the type signature is wrong.
And how to fix it without changing the structure of the program (i.e. not adding function `cmp' as a parameter of `merge' etc.).
1. Just omit the type signatures, they can be inferred. That's the portable way. 2. Bring the type variable a into scope {-# LANGUAGE ScopedTypeVariables #-} mergesort :: forall a. (a-> a-> Ordering) -> [a] -> [a] then an (unquantified) a in a local type signature refers to the type from the top-level signature. That's a GHC-only (as far as I know) way.

On 11/24/2012 11:07 PM, Daniel Fischer wrote:
I'm writing a merge sort function, but I get type error under such implementation:
mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp xs = mergeAll (map (\x -> [x]) xs) where mergeAll :: [[a]] -> [a] mergeAll [x] = x mergeAll xs = mergeAll (mergePairs xs)
mergePairs :: [[a]] -> [[a]] mergePairs (a:b:xs) = merge a b : mergePairs xs mergePairs xs = xs
merge :: [a] -> [a] -> [a] merge as@(a:as') bs@(b:bs')
| cmp a b == GT = b : merge as bs' | otherwise = a : merge as' bs
merge [] bs = bs merge as [] = as
And ghc says:
Couldn't match type `a1' with `a' `a1' is a rigid type variable bound by the type signature for merge :: [a1] -> [a1] -> [a1] at /home/ice/Study/Haskell/tutorials/99Questions/21to30.hs:135:7 `a' is a rigid type variable bound by the type signature for mergesort :: (a -> a -> Ordering) -> [a] -> [a] at /home/ice/Study/Haskell/tutorials/99Questions/21to30.hs:124:1 In the first argument of `cmp', namely `a' In the first argument of `(==)', namely `cmp a b' In the expression: cmp a b == GT
But if I comment all type signatures, ghc works fine on it. I would really appreciate it if you can point out what causes this question? Type variables are implicitly for all-quantified. Thus the type variable a in
On Samstag, 24. November 2012, 22:04:15, Mark Wallace wrote: the signatures of the local functions is a fresh type variable and has nothing to do with the a from the top-level signature.
It is equivalent to you writing
merge :: [b] -> [b] -> [b]
except there it is obvious that the type signature is wrong.
And how to fix it without changing the structure of the program (i.e. not adding function `cmp' as a parameter of `merge' etc.).
1. Just omit the type signatures, they can be inferred.
That's the portable way.
2. Bring the type variable a into scope
{-# LANGUAGE ScopedTypeVariables #-}
mergesort :: forall a. (a-> a-> Ordering) -> [a] -> [a]
then an (unquantified) a in a local type signature refers to the type from the top-level signature.
That's a GHC-only (as far as I know) way. Thanks for answering so fast. And all of your answers are very helpful. I've tested these two solutions, all works fine. Now I understand how type signature works in such condition.
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?

On Sat, Nov 24, 2012 at 10:32 AM, Mark Wallace
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?
Sometimes, sometimes not. Type signatures can help localize type errors, as otherwise ghc can infer an unexpected type and then report it to you at a different place, making it difficult to untangle where it got the weird type from. -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix/linux, openafs, kerberos, infrastructure http://sinenomine.net

On Samstag, 24. November 2012, 23:32:58, Mark Wallace wrote:
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature.
Definitely, type signatures are a good and unfortunately underused thing.
I'll try just omitting the signatures, it's easier and more handy isn't it?
You can also just comment them out, so they are there to guide you, but hidden from the compiler, so that doesn't complain. That could be a bit irritating, though, if you forget that the type variables in the commented-out signatures refer to the type variables in the top-level signature.

On Sat, Nov 24, 2012 at 4:32 PM, Mark Wallace
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?
As said, type signature are sometimes very useful to catch a mistake earlier (if your code _can_ be typed, but don't do what you want it to) and they're also a bit of automatically checked documentation (always invaluable). A reasonable compromise is to only put type signatures on the top-level, that's usually sufficient. -- Jedaï

On Sat, Nov 24, 2012 at 7:32 AM, Mark Wallace
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?
Writing down type signatures can be very helpful. I would recommend that, in a complex situation like this, you move your helper functions to the top level. That way, you can test and debug each individual helper in ghci. -Karl

On Sat, Nov 24, 2012 at 10:32 PM, Mark Wallace
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?
The unspoken wisdom goes something like this: the classic top-down FP way
of coding has you sketch out most if not all of your function signatures.
So when you hit the keyboard, a very natural thing to do is to key in all
those signatures stubbing out definitions using "undefined". You proceed
from there.
Sometimes people just use haskell as a calculator on steroids, especially
when solving project-euler-type problems. In which case, anything goes.
Needless to say, if all the practice a beginner gets is project euler,
they're missing out a lot.
-- Kim-Ee
On Sat, Nov 24, 2012 at 10:32 PM, Mark Wallace
On 11/24/2012 11:07 PM, Daniel Fischer wrote:
On Samstag, 24. November 2012, 22:04:15, Mark Wallace wrote:
I'm writing a merge sort function, but I get type error under such implementation:
mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp xs = mergeAll (map (\x -> [x]) xs) where mergeAll :: [[a]] -> [a] mergeAll [x] = x mergeAll xs = mergeAll (mergePairs xs)
mergePairs :: [[a]] -> [[a]] mergePairs (a:b:xs) = merge a b : mergePairs xs mergePairs xs = xs
merge :: [a] -> [a] -> [a] merge as@(a:as') bs@(b:bs')
| cmp a b == GT = b : merge as bs' | otherwise = a : merge as' bs
merge [] bs = bs merge as [] = as
And ghc says:
Couldn't match type `a1' with `a' `a1' is a rigid type variable bound by the type signature for merge :: [a1] -> [a1] -> [a1] at /home/ice/Study/Haskell/**tutorials/99Questions/21to30.**hs:135:7 `a' is a rigid type variable bound by the type signature for mergesort :: (a -> a -> Ordering) -> [a] -> [a] at /home/ice/Study/Haskell/**tutorials/99Questions/21to30.**hs:124:1 In the first argument of `cmp', namely `a' In the first argument of `(==)', namely `cmp a b' In the expression: cmp a b == GT
But if I comment all type signatures, ghc works fine on it. I would really appreciate it if you can point out what causes this question?
Type variables are implicitly for all-quantified. Thus the type variable a in the signatures of the local functions is a fresh type variable and has nothing to do with the a from the top-level signature.
It is equivalent to you writing
merge :: [b] -> [b] -> [b]
except there it is obvious that the type signature is wrong.
And how to fix it without changing the structure of the program (i.e. not
adding function `cmp' as a parameter of `merge' etc.).
1. Just omit the type signatures, they can be inferred.
That's the portable way.
2. Bring the type variable a into scope
{-# LANGUAGE ScopedTypeVariables #-}
mergesort :: forall a. (a-> a-> Ordering) -> [a] -> [a]
then an (unquantified) a in a local type signature refers to the type from the top-level signature.
That's a GHC-only (as far as I know) way.
Thanks for answering so fast. And all of your answers are very helpful. I've tested these two solutions, all works fine. Now I understand how type signature works in such condition.
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?
______________________________**_________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/**mailman/listinfo/beginnershttp://www.haskell.org/mailman/listinfo/beginners

The unspoken wisdom goes something like this: the classic top-down FP way of coding has you sketch out most if not all of your function signatures. So when you hit the keyboard, a very natural thing to do is to key in all those signatures stubbing out definitions using "undefined". You proceed from there.
Sometimes people just use haskell as a calculator on steroids, especially when solving project-euler-type problems. In which case, anything goes. Needless to say, if all the practice a beginner gets is project euler, they're missing out a lot.
Thanks very much for the tips and thought. Nowadays I'm working with the Haskell 99 Questions, and my next target would be Project Euler. Someone have suggested to implement Prelude by myself. But still can't find the 'right' thing to do. Would you mind sharing with us your experience of learning haskell? What would you recommend or what have you done in order to improve? On 11/25/2012 05:34 PM, Kim-Ee Yeoh wrote:
On Sat, Nov 24, 2012 at 10:32 PM, Mark Wallace
wrote: Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?
The unspoken wisdom goes something like this: the classic top-down FP way of coding has you sketch out most if not all of your function signatures. So when you hit the keyboard, a very natural thing to do is to key in all those signatures stubbing out definitions using "undefined". You proceed from there.
Sometimes people just use haskell as a calculator on steroids, especially when solving project-euler-type problems. In which case, anything goes. Needless to say, if all the practice a beginner gets is project euler, they're missing out a lot.
-- Kim-Ee
On Sat, Nov 24, 2012 at 10:32 PM, Mark Wallace
wrote: On 11/24/2012 11:07 PM, Daniel Fischer wrote:
On Samstag, 24. November 2012, 22:04:15, Mark Wallace wrote:
I'm writing a merge sort function, but I get type error under such implementation:
mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp xs = mergeAll (map (\x -> [x]) xs) where mergeAll :: [[a]] -> [a] mergeAll [x] = x mergeAll xs = mergeAll (mergePairs xs)
mergePairs :: [[a]] -> [[a]] mergePairs (a:b:xs) = merge a b : mergePairs xs mergePairs xs = xs
merge :: [a] -> [a] -> [a] merge as@(a:as') bs@(b:bs')
| cmp a b == GT = b : merge as bs' | otherwise = a : merge as' bs
merge [] bs = bs merge as [] = as
And ghc says:
Couldn't match type `a1' with `a' `a1' is a rigid type variable bound by the type signature for merge :: [a1] -> [a1] -> [a1] at /home/ice/Study/Haskell/**tutorials/99Questions/21to30.**hs:135:7 `a' is a rigid type variable bound by the type signature for mergesort :: (a -> a -> Ordering) -> [a] -> [a] at /home/ice/Study/Haskell/**tutorials/99Questions/21to30.**hs:124:1 In the first argument of `cmp', namely `a' In the first argument of `(==)', namely `cmp a b' In the expression: cmp a b == GT
But if I comment all type signatures, ghc works fine on it. I would really appreciate it if you can point out what causes this question?
Type variables are implicitly for all-quantified. Thus the type variable a in the signatures of the local functions is a fresh type variable and has nothing to do with the a from the top-level signature.
It is equivalent to you writing
merge :: [b] -> [b] -> [b]
except there it is obvious that the type signature is wrong.
And how to fix it without changing the structure of the program (i.e. not adding function `cmp' as a parameter of `merge' etc.).
1. Just omit the type signatures, they can be inferred.
That's the portable way.
2. Bring the type variable a into scope
{-# LANGUAGE ScopedTypeVariables #-}
mergesort :: forall a. (a-> a-> Ordering) -> [a] -> [a]
then an (unquantified) a in a local type signature refers to the type from the top-level signature.
That's a GHC-only (as far as I know) way.
Thanks for answering so fast. And all of your answers are very helpful. I've tested these two solutions, all works fine. Now I understand how type signature works in such condition.
Somehow it might seem a bit easier to me to grasp the function of a function with the help of type signature. I'll try just omitting the signatures, it's easier and more handy isn't it?
______________________________**_________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/**mailman/listinfo/beginnershttp://www.haskell.org/mailman/listinfo/beginners
participants (6)
-
Brandon Allbery
-
Chaddaï Fouché
-
Daniel Fischer
-
Karl Voelker
-
Kim-Ee Yeoh
-
Mark Wallace