5

假设我有如下定义（cata变质在哪里）：

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 && a1”或类似的东西，即这两个常量不会被标记为相同的东西。

4

2 回答 2

4

只需将它们排序为单子。

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
于 2014-05-16T02:27:47.053 回答
2

据我了解，您想要类似的东西

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

这样您就可以同时操作f a它的索引。

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

联系Int

首先我们定义一个新的类型来表示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

现在我们可以cata'使用cataand定义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的 s 被分配给每一层，而不是每个函子。例如，对于Fix []最外层列表的每个子列表，将标有2。

穿线效果

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

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
于 2014-05-15T22:54:18.507 回答