[Haskell-cafe] catamorphisms and attribute grammars
Roman Cheplyaka
roma at ro-che.info
Sun Jan 27 01:20:25 CET 2013
* Petr P <petr.mvd at gmail.com> [2013-01-26 23:03:51+0100]
> Dear Haskellers,
>
> I read some stuff about attribute grammars recently [1] and how UUAGC [2]
> can be used for code generation. I felt like this should be possible inside
> Haskell too so I did some experiments and I realized that indeed
> catamorphisms can be represented in such a way that they can be combined
> together and all run in a single pass over a data structure. In fact, they
> form an applicative functor.
>
> ...
>
> My experiments together with the example are available at https://github
> .com/ppetr/recursion-attributes
Very nice! This can be generalized to arbitrary arrows:
{-# LANGUAGE ExistentialQuantification #-}
import Prelude hiding (id)
import Control.Arrow
import Control.Applicative
import Control.Category
data F from to b c = forall d . F (from b d) (to d c)
instance (Arrow from, Arrow to) => Functor (F from to b) where
fmap f x = pure f <*> x
instance (Arrow from, Arrow to) => Applicative (F from to b) where
pure x = F (arr $ const x) id
F from1 to1 <*> F from2 to2 =
F (from1 &&& from2) (to1 *** to2 >>> arr (uncurry id))
Now your construction is a special case where 'from' is the category of
f-algebras and 'to' is the usual (->) category.
I wonder what's a categorical interpretation of F itself.
Roman
More information about the Haskell-Cafe
mailing list