[Haskell] GHC inferred type different for pointed/point-free defs?
Dan Weston
westondan at imageworks.com
Fri Nov 3 16:56:31 EST 2006
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)
More information about the Haskell
mailing list