[Haskell-cafe] Type Mismatch
Cetin Sert
cetin.sert at gmail.com
Mon Jan 7 07:56:37 EST 2008
Hi,
I'm new to Haskell programming and have the following problem.
-----------------------------------------------------
(|>) f g = g f
data Stream a where
S :: (s -> Step s a) -> s -> Stream a
data Step s a = Done | Yield a s | Skip a s
toStream :: [a] -> Stream a
toStream ax = S step ax where
step [] = Done
step (a:ax) = Yield a ax
fromStream :: Stream a -> [a]
fromStream (S step s) = loop s where
loop s = case step s of
Done -> []
Skip a s' -> loop s'
Yield a s' -> a : loop s'
filterStream :: (a -> Bool) -> Stream a -> Stream a filterStream p (S step s) = S filter s where
filter s = case step s of
Done -> Done
Skip a s' -> Skip a s'
Yield a s' -> if p a then Yield a s'
else Skip a s'
mapStream :: (a -> b) -> Stream a -> Stream b mapStream f (S step s) = S map s where
map s = case step s of
Done -> Done
Skip a s' -> Skip (f a) s'
Yield a s' -> Yield (f a) s'
class Streamable a where
to :: a -> Stream a
instance Streamable [a] where
to = toStream -- ERROR: see below
s f x = x |> toStream |> f |> fromStream
smap x = s (mapStream x)
sfilter x = s (filterStream x)
(%) a b = mod a b
main = do
print ([0..20] |> sfilter (\x -> x % 2 == 0))
---------------------------------------------------------
Error 1 Couldn't match expected type `a' (a rigid variable) against inferred type `[a]' `a' is bound by the instance declaration at C:\Users\Sert\Lab\Haskell\HaskellApp1\HaskellApp1\src/Main.hs:63:0 Expected type: [a] -> Stream [a] Inferred type: [[a]] -> Stream [a] In the expression: toStream In the definition of `to': to = toStream C:\Users\Sert\Lab\Haskell\HaskellApp1\HaskellApp1\src\Main.hs 64 8
How can I make the types match so that I can declare lists streamable? Is there something like in-place type annotations as in ML/OCaml/F#?
Best Regards,
Cetin Sert
corsis.de/blog
More information about the Haskell-Cafe
mailing list