Chaining values with catamorphisms

Question

Suppose I have definitions as follows (where cata is the catamorphism):

type Algebra f a = f a -> a

newtype Fix f = Fx (f (Fix f)) 

unFix :: Fix f -> f (Fix f)
unFix (Fx x) = x 

cata :: Functor f => (f a -> a) -> Fix f -> a
cata alg = alg . fmap (cata alg) . unFix

I was wondering if there would be some way to modify the definition of cata so that I could chain some object such as an int through it such that I could generate unique handles for things within the alg function, i.e. "a0", "a1", "a2", ..., etc.

Edit: To make this more clear, I'd like to be able to have some function cata' such that when I have something similar to the following definitions

data IntF a 
    = Const Int
    | Add a a

instance Functor IntF where
    fmap eval (Const i) = Const i
    fmap eval (x `Add` y) = eval x `Add` eval y

alg :: Int -> Algebra IntF String
alg n (Const i) = "a" ++ show n
alg n (s1 `Add` s2) = s1 ++ " && " ++ s2

eval = cata' alg

addExpr = Fx $ (Fx $ Const 5) `Add` (Fx $ Const 4)

run = eval addExpr

then run evaluates to "a0 && a1" or something similar, i.e. the two constants don't get labeled the same thing.

Answer 1

Just sequence them as monads.

newtype Ctr a = Ctr { runCtr :: Int -> (a, Int) } -- is State Int

instance Functor Ctr
instance Applicative Ctr
instance Monad Ctr

type MAlgebra m f a = f (m a) -> m a

fresh :: Ctr Int
fresh = Ctr (\i -> (i, i+1))

data IntF a 
  = Val
  | Add a a

malg :: IntF (Ctr String) -> Ctr String
malg Val = (\x -> "a" ++ show x) <$> fresh
malg (Add x y) = (\a b -> a ++ " && " ++ b) <$> x <*> y

go = cata malg

Answer 2

As I understand, you want something like

cata' :: Functor f => (Int -> f a -> a) -> Fix f -> a

so that you can operate both on f a and it's index.

If that's true, here's a possible solution.

Associated Int

First we define a new type which will represent Int-labelled functor:

{-# LANGUAGE DeriveFunctor #-}

data IntLabel f a = IntLabel Int (f a) deriving (Functor)    

-- This acts pretty much like `zip`.
labelFix :: Functor f => [Int] -> Fix f -> Fix (IntLabel f)
labelFix (x:xs) (Fx f) = Fx . IntLabel x $ fmap (labelFix xs) f

Now we can define cata' using cata and labelFix:

cata' :: Functor f => (Int -> f a -> a) -> Fix f -> a
cata' alg = cata alg' . labelFix [1..]
  where
    alg' (IntLabel n f) = alg n f

NOTE: unique Ints are assigned to each layer, not each functor. E.g. for Fix [] each sublist of the outermost list will be labelled with 2.

Threading effects

A different approach to the problem would be to use cata to produce monadic value:

cata :: Functor f => (f (m a) -> m a) -> Fix f -> m a

This is just a specialized version of cata. With it we can define (almost) cat' as

cata'' :: Traversable f => (Int -> f a -> a) -> Fix f -> a
cata'' alg = flip evalState [1..] . cata alg'
  where
    alg' f = alg <$> newLabel <*> sequenceA f

newLabel :: State [a] a
newLabel = state (\(x:xs) -> (x, xs))

Note that Traversable instance now is needed in order to switch f (m a) to m (f a).

However, you might want to use just a bit more specialized cata:

cata :: (Functor f, MonadReader Int m) => (f (m a) -> m a) -> Fix f -> m a