[Haskell-cafe] Re: [Haskell] GHC inferred type different for
pointed/point-free defs?
Neil Mitchell
ndmitchell at gmail.com
Fri Nov 3 17:03:23 EST 2006
Hi,
You probably want to read up on:
Monomorphism restriction (I don't think this applies here, but I'm
never too sure!):
http://www.haskell.org/hawiki/MonomorphismRestriction
Defaulting:
http://www.haskell.org/onlinereport/decls.html#sect4.3.4
I don't understand either to any great degree, but when points free
starts changing things, its usually one of those two kicking in.
And as a side note, haskell@ tends to be used more for announcements,
and haskell-cafe@ is used more for asking questions etc.
Thanks
Neil
On 11/3/06, Dan Weston <westondan at imageworks.com> wrote:
> Help! One of two things is going on:
>
> 1) I don't understand what I'm doing
> 2) GHC is inferring different types for pointed and
> point-free function definition.
>
> I wanted to define Haskell equivalents to the C ternary operator.
> Basically, predicate ??? doIfTrue ||| doIfFalse
>
> For some reason, though, in GHC 6.4 and 6.7, the types
> inferred for abs1 and ab2 (defined below) are different:
>
> *Main> :t abs1
> abs1 :: (Num a, Ord a) => a -> a
>
> *Main> :t abs2
> abs2 :: Integer -> Integer
>
> How is abs2 less general just because I use point-free
> notation instead of pointed notation? They should have the same
> type, no? I'm stumped...
>
> > import Control.Arrow
> > import Data.Either
> >
> > infix 1 ?, ??, ???, ????
> >
> > (?) True = Left
> > (?) False = Right
> >
> > (??) True = Left . fst
> > (??) False = Right . snd
> >
> > p ??? q = (p &&& arr id) >>> uncurry (?) >>> q
> > p ???? q = (p &&& arr id) >>> uncurry (??) >>> q
> >
> > abs1 x = (< 0) ??? negate ||| id $ x
> > abs2 = (< 0) ??? negate ||| id
> >
> > checks :: [Bool]
> > checks =
> > [
> > (True ? 3 ) == (Left 3),
> > (False ? 4 ) == (Right 4),
> > (True ?? (3,4)) == (Left 3),
> > (False ?? (3,4)) == (Right 4),
> > (even ??? (`div` 2) ||| (+1).(*3) $ 3 ) == ( 10),
> > (even ??? (`div` 2) ||| (+1).(*3) $ 4 ) == ( 2),
> > (uncurry (==) ???? (+1) ||| (*3) $ (3,3)) == ( 4),
> > (uncurry (==) ???? (+1) ||| (*3) $ (3,4)) == ( 12),
> > (uncurry (==) ???? (+1) +++ (*3) $ (3,3)) == (Left 4),
> > (uncurry (==) ???? (+1) +++ (*3) $ (3,4)) == (Right 12),
> > (abs1 5 ) == ( 5),
> > (abs1 (-5) ) == ( 5),
> > (abs2 5 ) == ( 5),
> > (abs2 (-5) ) == ( 5)
> > ]
> >
> > main = print (and checks)
>
> _______________________________________________
> Haskell mailing list
> Haskell at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
>
More information about the Haskell-Cafe
mailing list