[Haskell-cafe] Specifying a function type in a where clause.
Ryan Ingram
ryani.spam at gmail.com
Thu Sep 18 19:09:14 EDT 2008
The Haskell98 solution is to use "asTypeOf" to document types in
helper functions
combs' acc x = let sl = delete (x `asTypeOf` head l) l in ...
Using ScopedTypeVariables is much nicer, though.
-- ryan
On Thu, Sep 18, 2008 at 3:55 PM, Daniel Fischer
<daniel.is.fischer at web.de> wrote:
> Am Freitag, 19. September 2008 00:33 schrieb Rob deFriesse:
>> I would like to know why I'm getting a particular compile time error
>> message.
>>
>> In this program, I am specifying a function type on /combs'/ in the
>> where clause:
>>
>> --------
>> module Main where
>>
>> import List (delete)
>>
>> combs :: Eq a => [a] -> Int -> [[a]]
>> combs l 1 = map (\x -> [x]) l
>> combs l n = foldl combs' [] l
>> where combs' :: Eq a => [[a]] -> a -> [[a]]
>> combs' acc x = let sl = delete x l in (map (\i -> x:i) $ combs
>> sl (n-1)) ++ acc
>>
>> main = do
>> print $ combs ["a","b","c","d"] 3
>> --------
>>
>> I get this error message from GHC 6.8.3:
>>
>> cafe1.hs:9:43:
>> Couldn't match expected type `a1' against inferred type `a'
>> `a1' is a rigid type variable bound by
>> the type signature for `combs'' at cafe1.hs:8:23
>> `a' is a rigid type variable bound by
>> the type signature for `combs' at cafe1.hs:5:12
>> Expected type: [a1]
>> Inferred type: [a]
>> In the second argument of `delete', namely `l'
>> In the expression: delete x l
>>
>> I don't understand why I'm seeing this. The type /a/ is the same type
>> in /combs/ and /combs'/.
>
> Not quite. As it is, the type signature of combs' promises that for all types
> b which belong to Eq, combs' has type [[b]] -> b -> [[b]], because the a from
> the top level type signature is not in scope. Therefore, ghc complains about
> the use of l in the definition of combs', since l has a specific type.
> You can either remove the signature for combs' or bring the type variable a
> into scope by the pragma {-# LANGUAGE ScopedTypeVariables #-} at the top of
> your file or the flag -XScopedTypeVariables on the command line and changing
> the signature of combs to
> combs :: forall a. (Eq a) => [a] -> Int -> [[a]],
> I think then you must leave off the (Eq a) from the signature of combs'.
>
>> I realize I can remove the type specification
>> from /combs'/, and the code will compile. However, I'd like to get a
>> better understanding of why GHC objects to this.
>>
>> Thank you,
>> Rob.
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
More information about the Haskell-Cafe
mailing list