
I'm just starting to learn Haskell, and I'm having some confusion (I think) with how the type inference is working. Can someone explain why, in ghc 6.8.2 this works: *Main> (1/3)^3 3.7037037037037035e-2 But this doesn't *Main> (\k -> (1/k) ^ k) 3 <interactive>:1:8: Ambiguous type variable `t' in the constraints: `Fractional t' arising from a use of `/' at <interactive>:1:8-10 `Integral t' arising from a use of `^' at <interactive>:1:7-15 Probable fix: add a type signature that fixes these type variable(s) TIA, Ben

On Mon, 25 Feb 2008, Ben wrote:
<interactive>:1:8: Ambiguous type variable `t' in the constraints: `Fractional t' arising from a use of `/' at <interactive>:1:8-10 `Integral t' arising from a use of `^' at <interactive>:1:7-15 Probable fix: add a type signature that fixes these type variable(s)
/ doesn't do integer division, so from there it concludes that you're working with a Fractional type - Haskell never coerces behind your back, so not only the result of / but also its parameters are Fractional. ^ only works for Integral types. You might consider that a little arbitrary, but hey - it's mostly like that because it's much easier to raise something to an integer power. There's no default it can pick that's both Fractional and Integral, so it doesn't know what type the expression should have and it's asking you to tell it ("add a type signature that fixes these type variable(s)"). In practice you won't be able to unless you've got a broken number type handy, but that's the way things go. -- flippa@flippac.org Sometimes you gotta fight fire with fire. Most of the time you just get burnt worse though.

On Feb 25, 2008, at 4:11 PM, Philippa Cowderoy wrote:
On Mon, 25 Feb 2008, Ben wrote:
<interactive>:1:8: Ambiguous type variable `t' in the constraints: `Fractional t' arising from a use of `/' at <interactive>:1:8-10 `Integral t' arising from a use of `^' at <interactive>:1:7-15 Probable fix: add a type signature that fixes these type variable(s)
/ doesn't do integer division, so from there it concludes that you're working with a Fractional type - Haskell never coerces behind your back, so not only the result of / but also its parameters are Fractional.
^ only works for Integral types. You might consider that a little arbitrary, but hey - it's mostly like that because it's much easier to raise something to an integer power.
There's no default it can pick that's both Fractional and Integral, so it doesn't know what type the expression should have and it's asking you to tell it ("add a type signature that fixes these type variable(s)"). In practice you won't be able to unless you've got a broken number type handy, but that's the way things go.
Ok, that makes sense. There's no num k that's both Fractional and Integral, where as in the case where I had the number literals, those were two different instances. What's the usual way of working around this? Something like (\k -> (1/ fromInteger k) ^ k) 3 ?

Am Dienstag, 26. Februar 2008 01:32 schrieb Ben:
Ok, that makes sense. There's no num k that's both Fractional and Integral, where as in the case where I had the number literals, those were two different instances. What's the usual way of working around this? Something like
(\k -> (1/ fromInteger k) ^ k) 3
?
Or use another exponentiation operator, in this case (**), (\k -> (1/k)**k) :: (Floating t) => t -> t, so in (\k -> (1/k)**k) 3, fromInteger 3 will have type (Floating t) => t and that will be defaulted to Double Cheers, Daniel

On Tue, 26 Feb 2008, Daniel Fischer wrote:
Am Dienstag, 26. Februar 2008 01:32 schrieb Ben:
Ok, that makes sense. There's no num k that's both Fractional and Integral, where as in the case where I had the number literals, those were two different instances. What's the usual way of working around this? Something like
(\k -> (1/ fromInteger k) ^ k) 3
?
Or use another exponentiation operator, in this case (**),
If the exponent is integral it's best to tell the compiler about it, thus prefer (^)! x^3 never raises problems, whereas (-1)**3 may fail, say if the 3 is actually 3.000000001 due to rounding errors.

You can also do something like this (assuming -fglasgow-exts or
LANGUAGE Rank2Types):
f :: forall b. Fractional b => (forall a. Num a => a) -> b
f x = (1/x)^x
This says that the argument to f has to be able to be instantiated at
any numeric type, such as the result of a call to "fromInteger". Now,
the compiler is free to instantiate the first x at Double and the
second at Integer. Here's what it looks like in GHCi:
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
Loading package base ... linking ... done.
Prelude> :set -XRank2Types -XPatternSignatures
Prelude> let f (x :: forall a. Num a => a) = (1 / x)^x
Prelude> :t f
f :: (Fractional t) => (forall a. (Num a) => a) -> t
Prelude> f 3
3.7037037037037035e-2
Higher rank types don't have inference, so you need to annotate your
function for them to work.
-- ryan
On 2/25/08, Ben
On Feb 25, 2008, at 4:11 PM, Philippa Cowderoy wrote: On Mon, 25 Feb 2008, Ben wrote:
<interactive>:1:8: Ambiguous type variable `t' in the constraints: `Fractional t' arising from a use of `/' at <interactive>:1:8-10 `Integral t' arising from a use of `^' at <interactive>:1:7-15 Probable fix: add a type signature that fixes these type variable(s)
/ doesn't do integer division, so from there it concludes that you're working with a Fractional type - Haskell never coerces behind your back, so not only the result of / but also its parameters are Fractional.
^ only works for Integral types. You might consider that a little arbitrary, but hey - it's mostly like that because it's much easier to raise something to an integer power.
There's no default it can pick that's both Fractional and Integral, so it doesn't know what type the expression should have and it's asking you to tell it ("add a type signature that fixes these type variable(s)"). In practice you won't be able to unless you've got a broken number type handy, but that's the way things go.
Ok, that makes sense. There's no num k that's both Fractional and Integral, where as in the case where I had the number literals, those were two different instances. What's the usual way of working around this? Something like
(\k -> (1/ fromInteger k) ^ k) 3
? _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Tue, 26 Feb 2008, Philippa Cowderoy wrote:
On Mon, 25 Feb 2008, Ben wrote:
<interactive>:1:8: Ambiguous type variable `t' in the constraints: `Fractional t' arising from a use of `/' at <interactive>:1:8-10 `Integral t' arising from a use of `^' at <interactive>:1:7-15 Probable fix: add a type signature that fixes these type variable(s)
/ doesn't do integer division, so from there it concludes that you're working with a Fractional type - Haskell never coerces behind your back, so not only the result of / but also its parameters are Fractional.
^ only works for Integral types. You might consider that a little arbitrary, but hey - it's mostly like that because it's much easier to raise something to an integer power.

To elaborate on what Philippa said, the thing that probably is at the basis of your confusion is the fact that integer *literals* are overloaded (actually, the literal 3 means "fromInteger 3", where the result type of different fromInteger calls in the same expression need not be the same). So if you write 3, that can have any type belonging to the Num class, and in (1/3)^3 the two 3s are instantiated to different types, first, in (1/3), both literals are defaulted to Double, because by the use of (/), you need a type belonging to the Fractional class. Now (^) has type (^) :: (Integral b, Num a) => a -> b -> a, so the second 3 must have a type belonging to the Integral class, that is defaulted to Integer. Thus (1/3)^3 is in fact interpreted as ((1 :: Double) / (3 :: Double)) ^ (3 :: Integer). In the lambda expression (\k -> (1/k)^k), k is one value, belonging to one type t. The occurence of k in (1/k) demands that t belong to Fractional and the second occurence of k, ^k, demands that t belong to Integral. None of the standard types belongs to both these classes. And in (\k -> (1/k)^k) 3 fromInteger 3 must have type (Fractional t, Integral t) => t. HTH, Daniel Am Dienstag, 26. Februar 2008 01:01 schrieb Ben:
I'm just starting to learn Haskell, and I'm having some confusion (I think) with how the type inference is working. Can someone explain why, in ghc 6.8.2 this works:
*Main> (1/3)^3 3.7037037037037035e-2
But this doesn't
*Main> (\k -> (1/k) ^ k) 3
<interactive>:1:8: Ambiguous type variable `t' in the constraints: `Fractional t' arising from a use of `/' at <interactive>:1:8-10 `Integral t' arising from a use of `^' at <interactive>:1:7-15 Probable fix: add a type signature that fixes these type variable(s)
TIA, Ben

thefunkslists:
I'm just starting to learn Haskell, and I'm having some confusion (I think) with how the type inference is working. Can someone explain why, in ghc 6.8.2 this works: *Main> (1/3)^3 3.7037037037037035e-2 But this doesn't *Main> (\k -> (1/k) ^ k) 3 <interactive>:1:8: Ambiguous type variable `t' in the constraints: `Fractional t' arising from a use of `/' at <interactive>:1:8-10 `Integral t' arising from a use of `^' at <interactive>:1:7-15 Probable fix: add a type signature that fixes these type variable(s)
Oh, this is just that the / constrains the type to be of class Fractional, while ^ only works on Integral values. Try: Prelude> (\k -> (1/k) ** k) 3 3.703703703703703e-2 Because: Prelude> :t (^) (^) :: (Integral b, Num a) => a -> b -> a Prelude> :t (**) (**) :: (Floating a) => a -> a -> a Cheers, Don
participants (6)
-
Ben
-
Daniel Fischer
-
Don Stewart
-
Henning Thielemann
-
Philippa Cowderoy
-
Ryan Ingram