10

我有一个具有 Functor 实例的递归数据类型：

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

现在，我有兴趣修改此数据类型以支持通用递归方案，如本教程和本 Hackage 包中所述。我设法让变态起作用：

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 中，newtype Expr2 a = Expr2 (Fix (ExprF a))但是这个 newtype 需要被解包才能传递给cata，我不太喜欢。我也不知道是否可以Expr2像我一样自动派生仿函数实例Expr1。

4

4 回答 4

11

这对我来说是一个老痛处。关键点是你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实例不会靠魔法构建。你需要一个不同的定点运算符和一种全新的仿函数，这有点烦人。问题是你现在有两种子结构：“值”和“子表达式”。

轮到了。有一个函子的概念，它在固定点下是封闭的。打开厨房水槽（尤其是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元素上的o保留函数转换为结构上的保留函数。至关重要的是，i并且o可能会有所不同。

神奇的词是“1、2、4、8，求幂的时间！”。一种类型的 kind*可以很容易地转换为 kind 的普通索引 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)

所以我们可以将我们的双因子重构为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 更方便的封闭特性。我不认为他们会赶上。

于 2014-11-19T23:23:03.183 回答
6

我想知道您是否最好使用以下Free类型：

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

data ExprF r
  = Add r r
deriving Functor

这还有一个额外的好处，那就是已经有很多库可以在免费的 monad 上工作，所以也许它们会为您节省一些工作。

于 2014-11-20T03:46:46.653 回答
5

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 中包的链接。

于 2014-11-20T00:59:10.523 回答
0

关键字类型仅用作现有类型的同义词，也许这就是您正在寻找的

newtype Expr2 a r = In { out :: (ExprF a r)} deriving Functor
于 2014-11-19T23:06:25.503 回答