[Haskell] Re: ANNOUNCE: fixpoint 0.1
apfelmus
apfelmus at quantentunnel.de
Tue Nov 20 08:50:15 EST 2007
Roman Leshchinskiy wrote:
>
> instance Fixpoint [a] where
> data Pre [a] s = Nil | Cons a s
>
> project [] = Nil
> project (x:xs) = Cons x xs
>
> inject Nil = []
> inject (Cons x xs) = x : xs
>
> With this, we can easily define things like catamorphisms:
>
> cata :: Fixpoint t => (Pre t s -> s) -> t -> s
> cata f = f . fmap (cata f) . project
>
> which can then be used for generic programming:
>
> size :: (Fixpoint t, Foldable (Pre t)) => t -> Int
> size = cata (F.foldr (+) 1)
Cool! The idea of putting "hard-coded" implementations of fixed points
into a type class is just great.
I wonder whether a multi parameter type class without fundeps/associated
types would be better.
class Fixpoint f t where
inject :: f t -> t
project :: t -> f t
since multiple fixed points per functor
newtype Mu f = In { out :: f (Mu f) }
instance Fixpoint (Mu f) f where
inject = In
project = out
iso :: (Fixpoint f t, Fixpoint f t') => t -> t'
iso = cata inject
and multiple functors per fixed point make sense. If /\t -> Maybe (a,t)
were a functor, the latter would give unfold with the usual types but
I can live without that.
Interestingly, this even gives slightly shorter type signatures
cata :: Fixpoint f t => (f s -> s) -> t -> s
size :: (Fixpoint f t, Foldable f) => t -> Int
Regards,
apfelmus
More information about the Haskell
mailing list