Как я могу привести экземпляр Functor к типу данных, созданному для общих схем рекурсии?

У меня есть рекурсивный тип данных, который имеет экземпляр 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. Кажется, существует некоторая несоответствие при попытке определить экземпляр functor:

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)), но затем этот новый тип должен быть распакован для передачи в cata, что мне не очень нравится. Я также не знаю, можно ли автоматически получить экземпляр функтора Expr2, как я сделал с Expr1.

Ответ 1

Интересно, может быть, вам лучше использовать тип Free:

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

data ExprF r
  = Add r r
deriving Functor

У этого есть дополнительное преимущество, что есть уже несколько библиотек, которые уже работают на свободных монадах, так что, возможно, они сэкономит вам некоторую работу.

Ответ 2

Это старая болячка для меня. Решающим моментом является то, что ваш 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, время для возведения в степень!". Тип вида * можно легко превратить в тривиально индексированный 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 -indexed FunctorIx.

И теперь мы можем взять фиксированную точку любой структуры node 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

Функторы на индексированных наборах (с дополнительной свободой для изменения индекса) могут быть очень точными и очень мощными. Они обладают гораздо более удобными свойствами закрытия, чем Functor do. Я не думаю, что они поймают.

Ответ 3

Нет ничего плохого в ответе свиней, но, возможно, вы можете использовать более простой в качестве шага:

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

EDIT: Здесь ссылка на bifunctors пакет в Hackage.

Ответ 4

Тип ключевого слова используется только как синоним существующего типа, возможно, это то, что вы ищете

newtype Expr2 a r = In { out :: (ExprF a r)} deriving Functor