[Haskell-cafe] tree with labeled edges as a monad
Ross Paterson
ross at soi.city.ac.uk
Wed Jan 19 06:32:13 EST 2005
On Wed, Jan 19, 2005 at 01:40:06AM -0800, Andrew Pimlott wrote:
> This is a "have you seen this monad?" post. I was trying to construct a
> search tree, and decided I wanted to do it in a monad (so I could apply
> StateT and keep state as I explored the space). I discovered that a
> tree with labeled leaves is a monad, but I wanted to label internal
> nodes, and such a tree (eg, Data.Tree.Tree) is not a monad (because it
> can only have one result type). Finally, I realized I could get a
> similar effect by labeling the edges and the leaves with different
> types:
>
> data Tree l a = Leaf a | Branch [(l, Tree l a)]
>
> instance Monad (Tree l) where
> return = Leaf
> Leaf a >>= f = f a
> Branch c >>= f = Branch [(l, t >>= f) | (l, t) <- c]
>
> You might use it as
>
> turn = do
> board <- getBoard
> move <- lift (Branch [(move, return move) | move <- findMoves board])
> applyMove move
> turn
>
> I found this quite pleasing, though I hadn't run across trees as monads
> before. Has anyone else found this useful? Is it in a library
> somewhere?
More generally:
data Resumptions f a = Val a | Resume (f (Resumptions f a))
instance Functor f => Monad (Resumptions f) where
return = Val
Leaf a >>= f = f a
Resume t >>= f = Resume (fmap (>>= f) t)
An example is a model of the IO monad, with f instantiated to
data SysCall a
= GetChar (Char -> a)
| PutChar Char a
| ...
This monad in turn is a special case of the monad transformer
newtype GR f m a = GR (m (Either a (f (GR f m a))))
unGR (GR x) = x
instance (Functor f, Monad m) => Monad (GR f m) where
return = GR . return . Left
GR r >>= f = GR (r >>= either (unGR . f)
(return . Right . fmap (>>= f)))
which Moggi calls generalized resumptions in "A syntactic approach
to modularity in denotational semantics", section 2.3. This paper is
available on
http://www.disi.unige.it/person/MoggiE/publications.html
(It has some nice general monads, but is mostly impenetrable.)
More information about the Haskell-Cafe
mailing list