обобщённый тип, который обозначает рекурсивный тип:
newtype Fix f = Fix { unFix :: f (Fix f) }
В этой записи мы получаем уравнение неподвижной точки Fix f = f (Fix f), где f это некоторый тип
с параметром. Определим тип целых чисел:
240 | Глава 16: Категориальные типы
data N a = Zero | Succ a
type Nat = Fix N
Теперь создадим несколько конструкторов:
zero :: Nat
zero = Fix Zero
succ :: Nat -> Nat
succ = Fix . Succ
Сохраним эти определения в модуле Fix. hs и посмотрим в интерпретаторе на значения и их типы, ghc не
сможет вывести экземпляр Show для типа Fix, потому что он зависит от типа с параметром, а не от конкретно-
го типа. Для решения этой проблемы нам придётся определить экземпляры вручную и подключить несколько
расширений языка. Помните в главе о ленивых вычислениях мы подключали расширение BangPatterns? Нам
понадобятся:
{-# Language FlexibleContexts, UndecidableInstances #-}
Теперь определим экземпляры для Show и Eq:
instance Show (f (Fix f)) => Show (Fix f) where
show x = ”(” ++ show (unFix x) ++ ”)”
instance Eq (f (Fix f)) => Eq (Fix f) where
a == b = unFix a == unFix b
Определим списки-оригами:
data L a b = Nil | Cons a b
deriving (Show)
type List a = Fix (L a)
nil :: List a
nil = Fix Nil
infixr 5 ‘cons‘
cons :: a -> List a -> List a
cons a = Fix . Cons a
В типе L мы заменили рекурсивный тип на параметр. Затем в записи List a = Fix (L a) мы произ-
водим замыкание по параметру. Мы бесконечно вкладываем тип L a во второй параметр. Так получается
рекурсивный тип для списков. Составим какой-нибудь список:
*Fix> :r
[1 of 1] Compiling Fix
( Fix. hs, interpreted )
Ok, modules loaded: Fix.
*Fix> 1 ‘cons‘ 2 ‘cons‘ 3 ‘cons‘ nil
(Cons 1 (Cons 2 (Cons 3 (Nil))))
Спрашивается, зачем нам это нужно? Зачем нам записывать рекурсивные типы через тип Fix? Оказыва-
ется при такой записи мы можем построить универсальные функции fold и unfold, они будут работать для
любого рекурсивного типа.
Помните как мы составляли функции свёртки? Мы строили воображаемый класс, в котором сворачивае-
мый тип заменялся на параметр. Например для списка мы строили свёртку так:
class [a] b where
(:) :: a -> b -> b
[]
:: b
После этого мы легко получали тип для функции свёртки:
foldr :: (a -> b -> b) -> b -> ([a] -> b)
Программирование в стиле оригами | 241
Она принимает методы воображаемого класса, в котором тип записан с параметром, а возвращает функ-
цию из рекурсивного типа в тип параметра.
Сейчас мы выполняем эту процедуру замены рекурсивного типа на параметр в обратном порядке. Сначала
мы строим типы с параметром, а затем получаем из них рекурсивные типы с помощью конструкции Fix.
Теперь методы класса с параметром это наши конструкторы исходных классов, а рекурсивный тип записан
через Fix. Если мы сопоставим два способа, то мы сможем получить такой тип для функции свёртки:
fold :: (f b -> b) -> (Fix f -> b)
Смотрите функция свёртки по-прежнему принимает методы воображаемого класса с параметром, но те-
перь класс перестал быть воображаемым, он стал типом с параметром. Результатом функции свёртки будет
функция из рекурсивного типа Fix f в тип параметр.
Аналогично строится и функция unfold:
unfold :: (b -> f b) -> (b -> Fix f)
В первой функции мы указываем один шаг разворачивания рекурсивного типа, а функция развёртки
рекурсивно распространяет этот один шаг на потенциально бесконечную последовательность применений
этого одного шага.
Теперь давайте определим эти функции. Но для этого нам понадобится от типа f одно свойство. Он
должен быть функтором, опираясь на это свойство, мы будем рекурсивно обходить этот тип.
fold :: Functor f => (f a -> a) -> (Fix f -> a)
fold f = f . fmap (fold f) . unFix
Проверим эту функцию по типам. Для этого нарисуем схему композиции:
f
fmap (fold f)
f
Fix f
f (Fix f)
f a
a
Сначала мы разворачиваем обёртку Fix и получаем значение типа f (Fix f), затем с помощью fmap мы
внутри типа f рекурсивно вызываем функцию свёртки и в итоге получаем значение f a, на последнем шаге
мы выполняем свёртку на текущем уровне вызовом функции f.
Аналогично определяется и функция unfold. Только теперь мы сначала развернём первый уровень, затем
рекурсивно вызовем развёртку внутри типа f и только в самом конце завернём всё в тип Fix:
unfold :: Functor f => (a -> f a) -> (a -> Fix f)
unfold f = Fix . fmap (unfold f) . f
Схема композиции:
Fix
fmap (unold f)
f
Fix f
f (Fix f)
f a
a
Возможно вы уже догадались о том, что функция fold дуальна по отношению к функции unfold, это
особенно наглядно отражается на схеме композиции. При переходе от fold к unfold мы просто перевернули
все стрелки заменили разворачивание типа Fix на заворачивание в Fix.
Определим несколько функций для натуральных чисел и списков в стиле оригами. Для начала сделаем
L и N экземпляром класса Functor:
instance Functor N where
fmap f x = case x of
Zero
-> Zero
Succ a
-> Succ (f a)
instance Functor (L a) where
fmap f x = case x of
Nil
-> Nil
Cons a b
-> Cons a (f b)
Это всё что нам нужно для того чтобы начать пользоваться функциями свёртки и развёртки! Определим
экземпляр Num для натуральных чисел: