How can I make a counter without Monad?
Nicolas Oury
Nicolas.Oury at lri.fr
Wed Mar 16 04:51:08 EST 2005
Thanks for your help.
>> Are there other ways to implement a counter in Haskell?
>
> Using a State monad?
>
If I use your example on :
test = let Node x l = enumeratedTree ( Node 'a' [undefined, Node 'b'
[]])
in tail l
GHCI answers
[Node (*** Exception: Prelude.undefined
A monadic counter imposes an order of evaluation.
In my program, I don't care about the order of the numbers.
I only want them to be all different.
I think a monad is too restrictive for what I need.
>> From some of my code:
>
> let enumeratedTree =
> (`evalState` (0::Int)) $ (`mapTreeM` t) $
> \x -> do n <- next
> return (n, x)
> next = do a <- get; put $! succ a; return a
>
> where
>
> mapTreeM :: Monad m => (a -> m b) -> Tree a -> m (Tree b)
> mapTreeM f (Node a ts) = do
> b <- f a
> ts' <- mapM (mapTreeM f) ts
> return (Node b ts')
>
> (which could also be an instance of a popular non-standard FunctorM
> class)
>
> Best regards
> Tomasz
>
More information about the Glasgow-haskell-users
mailing list