Control.Monad.Fix

Описание

Монадические неподвижные точки, используемые для устранения синтаксического сахара {-# LANGUAGE RecursiveDo #-}.

Рассмотрим обобщённую версию так называемой задачи repmin (заменить на минимум): накапливать элементы контейнера в Monoid и изменять каждый элемент, используя итоговый аккумулятор.

repmin
  :: (Functor t, Foldable t, Monoid b)
  => (a -> b) -> (a -> b -> c) -> t a -> t c
repmin f g as = fmap (`g` foldMap f as) as

Наивная реализация, приведённая выше, выполняет два обхода. Можно ли сделать лучше и достичь цели за один проход? На первый взгляд это невозможно, поскольку нам нужно было бы знать будущее, но на помощь приходит ленивое вычисление:

import Data.Traversable (mapAccumR)

repmin
  :: (Traversable t, Monoid b)
  => (a -> b) -> (a -> b -> c) -> t a -> t c
repmin f g as =
  let (b, cs) = mapAccumR (\acc a -> (f a <> acc, g a b)) mempty as in cs

Как проверить, что repmin действительно выполняет только один обход? Запустим её на бесконечном входе:

>>> import Data.Monoid (All(..))
>>> take 3 $ repmin All (const id) ([True, True, False] ++ undefined)
[All {getAll = False},All {getAll = False},All {getAll = False}]

Пока всё хорошо, но можно ли обобщить g, чтобы возвращать монадическое значение a -> b -> m c? Следующий вариант не работает: он сообщает, что b не находится в области видимости:

import Data.Traversable (mapAccumM)

repminM
  :: (Traversable t, Monoid b, Monad m)
  => (a -> b) -> (a -> b -> m c) -> t a -> m (t c)
repminM f g as = do
  (b, cs) <- mapAccumM (\acc a -> (f a <> acc,) <$> g a b) mempty as
  pure cs

Чтобы разгадать эту загадку, перепишем repmin через fix:

repmin
  :: (Traversable t, Monoid b)
  => (a -> b) -> (a -> b -> c) -> t a -> t c
repmin f g as = snd $ fix $
  \(b, cs) -> mapAccumR (\acc a -> (f a <> acc, g a b)) mempty as

Теперь можно заменить fix на mfix и получить решение:

repminM
  :: (Traversable t, Monoid b, MonadFix m)
  => (a -> b) -> (a -> b -> m c) -> t a -> m (t c)
repminM f g as = fmap snd $ mfix $
  \(~(b, cs)) -> mapAccumM (\acc a -> (f a <> acc,) <$> g a b) mempty as

Например:

>>> import Data.Monoid (Sum(..))
>>> repminM Sum (\a b -> print a >> pure (a + getSum b)) [3, 5, 2]
3
5
2
[13,15,12]

Удивительно, но GHC способен выполнить это преобразование автоматически, если включён {-# LANGUAGE RecursiveDo #-}. В частности, работает следующая реализация repminM (обратите внимание: используется mdo вместо do):

{-# LANGUAGE RecursiveDo #-}

repminM
  :: (Traversable t, Monoid b, MonadFix m)
  => (a -> b) -> (a -> b -> m c) -> t a -> m (t c)
repminM f g as = mdo
  (b, cs) <- mapAccumM (\acc a -> (f a <> acc,) <$> g a b) mempty as
  pure cs

Дополнительная литература:

• Руководство пользователя GHC, рекурсивная do-нотация.
• Вики Haskell, MonadFix.
• Levent Erkök, Рекурсия по значениям в монадических вычислениях, Oregon Graduate Institute, 2002.
• Levent Erkök, John Launchbury, Рекурсивный do для Haskell, Haskell '02, 29–37, 2002.
• Richard S. Bird, Использование циклических программ для устранения многократных обходов данных, Acta Informatica 21, 239–250, 1984.
• Jasper Van der Jeugt, Ленивая раскладка, 2023.