[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