[Haskell-cafe] pair (f,g) x = (f x, g x)?

wenduan xuwenduan2010 at gmail.com
Sat Jul 2 03:18:18 EDT 2005


Marc A. Ziegert wrote:

>'.' is not always a namespace-separator like '::','.','->' in c++ or '.' in java.
>it is used as an operator, too.
> (.) :: (b->c) -> (a->b) -> (a->c)
> (f . g) x = f (g x)
>
>remember the types of fst and snd:
> fst :: (a,b)->a
> snd :: (a,b)->b
>so the function (.) combines
> square :: Int -> Int
>with fst to
> (square . fst) :: (Int,b) -> Int
> 
>the same with toUpper:
> (Char.toUpper . snd) :: (a,Char) -> Char
>
>so you have with 'pair (f,g) x = (f x,g x)':
>
> pair (square . fst,Char.toUpper . snd) (2,'a')
>==>
> ((square . fst) (2,'a'), (Char.toUpper . snd) (2,'a')) 
>==>
> ( square (fst(2,'a')), Char.toUpper (snd(2,'a')) )
>==>
> ( square 2 , Char.toUpper 'a' )
>==>
> (4,'A')
>
>
>- marc
>
>
>
>Am Samstag, 2. Juli 2005 08:32 schrieb wenduan:
>  
>
>>I came across a haskell function on a book defined as following:
>>
>>pair :: (a -> b,a -> c) -> a -> (b,c)
>>pair (f,g) x = (f x,g x)
>>
>>I thought x would only math a single argument like 'a', 1, etc....,but 
>>it turned out that it would match something else, for example, a pair as 
>>below:
>>
>>square x = x*x
>>
>>pair (square.fst,Char.toUpper.snd) (2,'a')
>>(4,'A')
>>
>>The type declaration of  pair is what confused me,
>>pair :: (a -> b,a -> c) -> a -> (b,c),it says this function will take a 
>>pair of functions which have types of a->b,a->c,which I would take as 
>>these two functions must have argument of the same type, which is a,and 
>>I didn't think it would work on pairs as in the above instance,but 
>>surprisingly it did,can anybody enlighten me?
>>
>>-- 
>>X.W.D
>>
>>_______________________________________________
>>Haskell-Cafe mailing list
>>Haskell-Cafe at haskell.org
>>http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>>
>>    
>>
>
>  
>
you are correct,but as in the following,

> (square . fst) :: (Int,b) -> Int
> 
>
> (Char.toUpper . snd) :: (a,Char) -> Char

you get a Int and Char out of the two composed functions, namely square.fst, Char.toUpper.snd.But in the type declaration of
pair, which appeared to me,it meant its arguments must be two functions which are of the same type namely a,whereas Int and
Char passed to as arguments are of different types here, and that's the reason I thought it wouldn't work.

Thank you,
regards.





-- 
X.W.D



More information about the Haskell-Cafe mailing list