[Haskell-cafe] typeclass constraints

Ivan Lazar Miljenovic ivan.miljenovic at gmail.com
Fri Aug 23 11:36:17 CEST 2013


On 23 August 2013 19:23, TP <paratribulations at free.fr> wrote:
> Hi everybody,
>
>
> There is something I do not understand in the way typeclass constraints are
> inferred.
>
>
> 1/ Take the following function definition:
>
> sum' [] = []
> sum' (x:xs) = x + sum' xs

You haven't specified a type signature here, so GHC will derive the
most generic one possible.

>
> GHCI correctly gives:
>
>> :t sum'
> sum' :: Num [a] => [[a]] -> [a]
>
> So it has inferred that the type list has to be an instance of Num for sum'
> to be able to work. It will give an error if we try to use sum' without
> implementing the instance.
>
>
> 2/ Now, take the following definition:
>
> ------------------------
> {-# LANGUAGE TemplateHaskell #-}
>
> import Language.Haskell.TH
> import Language.Haskell.TH.Syntax
>
> p :: a -> ExpQ
> p n = [| show n |]

You have defined a type signature here, so GHC will try to use it...
except (as you've noted) GHC will then complain that it's wrong.

If GHC auto-magically fixed incorrect type signatures, then one of the
major advantages of the type system (i.e. "specify a type for a
function and then use that to guarantee that the function matches the
specification of what we wanted") will no longer be valid.

> ------------------------
>
> We obtain an error if we try to load it in GHCI:
>
>     No instance for (Lift a) arising from a use of `n'
>     Possible fix:
>       add (Lift a) to the context of
>         the type signature for p :: a -> ExpQ
>     In the first argument of `show', namely `n'
>     In the Template Haskell quotation [| show n |]
>     In the expression: [| show n |]
>
> And indeed, if we use instead:
>
> ------------------------
> {-# LANGUAGE TemplateHaskell #-}
>
> import Language.Haskell.TH
> import Language.Haskell.TH.Syntax
>
> p :: Lift a => a -> ExpQ
> p n = [| show n |]
> ------------------------
>
> it works correctly.
>
>
> Why GHC is able to infer the typeclass constraint (Num a) in 1/, but not
> (Lift a) in 2/?
>
>
> Thanks in advance,
>
> TP
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



-- 
Ivan Lazar Miljenovic
Ivan.Miljenovic at gmail.com
http://IvanMiljenovic.wordpress.com




More information about the Haskell-Cafe mailing list