[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators,
enumeratees?
Heinrich Apfelmus
apfelmus at quantentunnel.de
Wed Aug 25 03:45:33 EDT 2010
Stephen Tetley wrote:
> John Lato wrote:
>
>> This is how I think of them. I particularly your description of them as a
>> foldl with a "pause" button.
>> Maybe it would be helpful to consider iteratees along with delimited
>> continuations?
>
> Aren't they closer - in implementation and by supported operations -
> to resumptions monads?
>
> See many papers by William Harrison here:
> http://www.cs.missouri.edu/~harrisonwl/abstracts.html
A general method to implement resumption monads, or, in fact, any monad,
is given in my "Operational Monad Tutorial":
http://apfelmus.nfshost.com/articles/operational-monad.html
Here a tiny toy implementation of Iteratees:
data IterateeI a where
Symbol :: IterateeI Char
EOF :: IterateeI Bool
type Iteratee = ProgramT IterateeI
symbol = singleton . Symbol
eof = singleton . EOF
runString :: Monad m => Iteratee m a -> String -> m a
runString m cs = go cs =<< viewT m
where
go _ (Return x) = return x
go [] (Symbol :>>= k) = error "Expecting input"
go (c:cs) (Symbol :>>= k) = runString (k c) cs
go cs (EOF :>>= k) = runString (k $ null cs) cs
-- an iteratee that counts the number of elements in the input
count :: Monad m => Iteratee m Int
count = go 0
where
go n = eof >>= \b -> case b of
True -> return n
False -> symbol >> go $! (n+1)
Regards,
Heinrich Apfelmus
--
http://apfelmus.nfshost.com
More information about the Haskell-Cafe
mailing list