用catamorphisms链接值

Question

假设我的定义如下（其中cata是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

我想知道是否有某种方法可以修改cata的定义，以便我可以通过它链接一些对象，例如int，这样我就可以为其中的内容生成唯一的句柄alg功能，即“a0”，“a1”，“a2”，......等等。

编辑：为了更清楚，我希望能够有一些功能cata'，这样当我有类似于以下定义时

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

然后run评估为“a0＆amp;＆amp; a1”或类似的东西，即两个常数没有被标记为相同的东西。

Answer 1

将它们排序为monad。

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

据我所知，你想要像

这样的东西

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

这样您就可以在f a及其索引上进行操作。

如果这是真的，这是一个可能的解决方案。

相关Int

首先，我们定义一个代表Int的新类型 - 标记的仿函数：

{-# 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

现在我们可以使用cata'和cata定义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

注意：唯一Int分配给每个图层，而不是每个仿函数。例如。对于Fix []，最外面列表的每个子列表都将标有2。

线程效应

解决问题的另一种方法是使用cata来产生monadic值：

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

这只是cata的专用版本。有了它，我们可以将（几乎）cat'定义为

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))

请注意，现在需要Traversable个实例才能将f (m a)切换为m (f a)。

但是，您可能只想使用更专业的cata：

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