如何为一般递归方案构建的数据类型提供Functor实例？

Question

我有一个递归数据类型,它有一个Functor实例:

data Expr1 a
  = Val1 a
  | Add1 (Expr1 a) (Expr1 a)
  deriving (Eq, Show, Functor)

现在,我有兴趣修改此数据类型以支持一般递归方案,因为本教程和此Hackage包中对它们进行了描述.我设法让catamorphism工作:

newtype Fix f = Fix {unFix :: f (Fix f)}

data ExprF a r
  = Val a
  | Add r r
  deriving (Eq, Show, Functor)

type Expr2 a = Fix (ExprF a)

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

eval :: Expr2 Int -> Int
eval = cata $ \case
  Val n -> n
  Add x y -> x + y

main :: IO ()
main =
  print $ eval
    (Fix (Add (Fix (Val 1)) (Fix (Val 2))))

但现在我无法弄清楚如何给出Expr2与原版相同的仿函数实例Expr.在尝试定义仿函数实例时,似乎存在一种不匹配:

instance Functor (Fix (ExprF a)) where
    fmap = undefined

Kind mis-match
    The first argument of `Functor' should have kind `* -> *',
    but `Fix (ExprF a)' has kind `*'
    In the instance declaration for `Functor (Fix (ExprF a))'

如何编写Functor实例Expr2？

我想将Expr2包装在一个新类型中,newtype Expr2 a = Expr2 (Fix (ExprF a))但是这个新类型需要被解包传递给cata我,我不太喜欢.我也不知道是否可以Expr2像我一样自动派生仿函数实例Expr1.

Answer 1

这对我来说是一个老问题.关键的一点是,你的两个参数ExprF都很有趣.所以,如果我们有

class Bifunctor b where
  bimap :: (x1 -> y1) -> (x2 -> y2) -> b x1 x2 -> b y1 y2

然后你可以定义(或想象一个为你定义的机器)

instance Bifunctor ExprF where
  bimap k1 k2 (Val a)    = Val (k1 a)
  bimap k1 k2 (Add x y)  = Add (k2 x) (k2 y)

现在你可以拥有

newtype Fix2 b a = MkFix2 (b a (Fix2 b a))

伴随着

map1cata2 :: Bifunctor b => (a -> a') -> (b a' t -> t) -> Fix2 b a -> t
map1cata2 e f (MkFix2 bar) = f (bimap e (map1cata2 e f) bar)

这反过来又为你提供了当你在其中一个参数中取一个固定点时,剩下的东西仍然是另一个参考

instance Bifunctor b => Functor (Fix2 b) where
  fmap k = map1cata2 k MkFix2

而你有点得到你想要的东西.但是你的Bifunctor实例不是由魔法构建的.你需要一个不同的fixpoint操作符和一个全新的仿函数,这有点烦人.麻烦的是你现在有两种子结构:"值"和"子表达式".

轮到这里了.有一个仿函数的概念,它在固定点下关闭.打开厨房水槽(特别是DataKinds)和

type s :-> t = forall x. s x -> t x

class FunctorIx (f :: (i -> *) -> (o -> *)) where
  mapIx :: (s :-> t) -> f s :-> f t

请注意,"元素"是一种索引的类型,i而"结构"是指向其他类型的索引o.我们i在元素上采用-preserving函数来o保留结构上的函数.重要的是,i和o可以是不同的.

神奇的词是"1,2,4,8,指数的时间!".一种类型*可以很容易地变成一种简单的GADT类型() -> *.并且可以将两种类型组合在一起以形成GADT类型Either () () -> *.这意味着我们可以将两种子结构一起滚动.一般来说,我们有一种类型级别either.

data Case :: (a -> *) -> (b -> *) -> Either a b -> * where
  CL :: f a -> Case f g (Left a)
  CR :: g b -> Case f g (Right b)

配备了"地图"的概念

mapCase :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g'
mapCase ff gg (CL fx) = CL (ff fx)
mapCase ff gg (CR gx) = CR (gg gx)

因此,我们可以将我们的bifactors作为Either索引FunctorIx实例重新存档.

现在我们可以获取任何节点结构的固定点,该结构f具有元素p或子节点的位置.这与我们上面的交易完全相同.

newtype FixIx (f :: (Either i o -> *) -> (o -> *))
              (p :: i -> *)
              (b :: o)
  = MkFixIx (f (Case p (FixIx f p)) b)

mapCata :: forall f p q t. FunctorIx f =>
  (p :-> q) -> (f (Case q t) :-> t) -> FixIx f p :-> t
mapCata e f (MkFixIx node) = f (mapIx (mapCase e (mapCata e f)) node)

但是现在,我们得到了FunctorIx关闭的事实FixIx.

instance FunctorIx f => FunctorIx (FixIx f) where
  mapIx f = mapCata f MkFixIx

索引集上的函数(具有改变索引的额外自由度)可以非常精确且非常强大.他们享受比Functors 更方便的封闭性能.我不认为他们会流行起来.

Answer 2

我想知道你是否可以更好地使用这种Free类型:

data Free f a
  = Pure a
  | Wrap (f (Free f a))
deriving Functor

data ExprF r
  = Add r r
deriving Functor

这有一个额外的好处,就是有很多库已经在免费monad上工作,所以也许他们会省你一些工作.

Answer 3

对于pigworker的答案没有错,但也许你可以使用一个更简单的作为踏脚石:

{-# LANGUAGE DeriveFunctor, ScopedTypeVariables #-}

import Prelude hiding (map)

newtype Fix f = Fix { unFix :: f (Fix f) }

-- This is the catamorphism function you hopefully know and love
-- already.  Generalizes 'foldr'.
cata :: Functor f => (f r -> r) -> Fix f -> r
cata phi = phi . fmap (cata phi) . unFix

-- The 'Bifunctor' class.  You can find this in Hackage, so if you
-- want to use this just use it from there.
--
-- Minimal definition: either 'bimap' or both 'first' and 'second'.
class Bifunctor f where
    bimap :: (a -> c) -> (b -> d) -> f a b -> f c d
    bimap f g = first f . second g

    first :: (a -> c) -> f a b -> f c b
    first f = bimap f id

    second :: (b -> d) -> f a b -> f a d
    second g = bimap id g

-- The generic map function.  I wrote this out with
-- ScopedTypeVariables to make it easier to read...
map :: forall f a b. (Functor (f a), Bifunctor f) => 
       (a -> b) -> Fix (f a) -> Fix (f b)
map f = cata phi 
    where phi :: f a (Fix (f b)) -> Fix (f b)
          phi = Fix . first f

现在你的表达式语言是这样的:

-- This is the base (bi)functor for your expression type.
data ExprF a r = Val a 
               | Add r r
               deriving (Eq, Show, Functor)

instance Bifunctor ExprF where
    bimap f g (Val a) = Val (f a)
    bimap f g (Add l r) = Add (g l) (g r)

newtype Expr a = Expr (Fix (ExprF a))

instance Functor Expr where
    fmap f (Expr exprF) = Expr (map f exprF)

编辑:这是bifunctorsHackage中包的链接.