composeList
David Feuer
dfeuer@cs.brown.edu
Sun, 12 May 2002 21:03:35 -0400
On Sun, May 12, 2002, Emre Tezel wrote:
> Hi all,
>
> I recently bought Simon Thompson's Haskell book. I have been doing the
> exercises while I read on. There are couple questions that I can not
> solve. Any help would be greatly appreciated.
>
> I got stuck on this question in Chapter 10.
>
> Define a function composeList which composes a list of functions into a
> single function. What is the type of composeList?
>
> I naively tried the following but the hugs compiler complained about the
> inferred type not being generic enough.
>
> composeList :: [(a -> b)] -> (c -> b)
> composeList [] = id
> composeList (x:xs) = x . (composeList xs)
The type signature is wrong. It indicates that for any a,b,c, and d,
composeList takes a list of (a->b) and produces a (c->b). So for
example, that would mean that if I gave it [(+3), (*4), (-5)] it would
be able to produce something of type (Maybe String -> Int). This is of
course totally wrong. You're going to have to restrict it some more . The first
thing to note is that a=c: if you give it a list of functions that take
Floats, it's going to give back a function that takes a float. So that
restricts it to [a -> b] -> (a -> b). Now look at the function itself:
composeList (x:xs) = x . (composeList xs)
Now in order for f . g to make any sense, f must take values of the type
that g returns! So if x has type p -> q, (composeList xs) must have
type r -> p. But since x is in xs, xs must have type [p -> q], so
(composeList xs) has type p -> q. So r -> p = p -> q. This implies
immediately that p = q = r. So the type of composeList is restricted
all the way down to [a -> a] -> (a -> a). This can also be written
[a -> a] -> a -> a. This may seem disappointing, but it is made
necessary by the type safety of Haskell, which requires that all the
elements of a list have the same type.
You can do a lot better in Glasgow Haskell:
data Fun a b = forall c . Comp (c -> b) (Fun a c) | End (a -> b)
compose :: Fun a b -> a -> b --GHC needs this type signature
--to compile the program, but
--I don't understand why.
--Any tips?
compose (End f) = f
compose (Comp f l) = f . compose l
f::Int -> Float
f x = fromIntegral x
g::String -> Int
g = read
h::Int -> String
h x = take x "123456789"
main = do
putStrLn "hello!"
print $ compose (End (\x -> "Foo!")) 3
print $ compose (Comp f (Comp g (End h))) 4
--
Night. An owl flies o'er rooftops. The moon sheds its soft light upon
the trees.
David Feuer