On Vox: Длинное, про Хаскель - часть 1

[migmit]

   

В рассылке SPbHUG подняли тему, которую мы недообсуждали на очередном заседании - тему утечек памяти в монадических вычислениях. Поскольку тут надо писать приличное количество кода, выношу это всё в отдельный пост, точнее, в два.

Итак, собственно утечки памяти в монадах не слишком-то существенны. Точнее, я бы сказал, вообще не существенны - сборщик мусора подберёт, когда надо. Иное дело, если эта самая память находится там, куда сборщику хода нет.

Предположим, мы хотим вычислять некоторые значения, по ходу дела обращаясь к пользователю с вопросами и выслушивая его бредни ответы. Допустим, также, что обмен информацией с пользователем должен быть stateless - то есть, задав пользователю вопрос, мы тут же завершаемся, и в следующий раз запускаем функцию заново. При этом, конечно, некоторая информация - некий State - должна передаваться пользователю вместе с вопросом, и возвращаться назад неизменённой вместе с ответом. Придётся поверить пользователю в том, что он таки будет возвращать эту информацию без изменений. В реальности, конечно, пользователь будет пользоваться каким-то клиентом, который позаботится об этом сам - например, веб-браузером.

> {-# LANGUAGE Arrows #-}

В первой части мы не будем пользоваться стрелками, но, так как две части сделаны из одного файла, ставим прагму в начало.

> module Test where
> import Control.Arrow
> import Control.Monad
> import Data.Either
> import Data.Maybe

Пока ничего интересного.

Далее, заведём тип для передаваемой пользователю информации. Этот тип будет содержать а) задаваемый пользователю вопрос (строку) - или получаемый от него ответ (тоже строку), и б) кое-какую информацию о прошлых состояниях - эту информацию пользователь обязуется не изменять.

> data StateM = StateM String [Maybe StateM] deriving Show

Желающие сообщить мне, что тут я заново изобрёл Лисп, могут не трудиться. Я, типа, знаю.

Попробуем, для начала, уложить всё в монаду. Наше монадическое значение будет представлять собой функцию, которая на вход принимает последний ответ пользователя (если таковой вообще был), а на выход выдаёт новый вопрос для пользователя - или же результирующее значение.

> newtype M a = M (Maybe StateM -> Either StateM a)

Для удобства придумаем своего рода "клиента" для пользователя - функцию, которая возьмёт на себя задачу следить за сохранностью State.

> runM :: M a -> IO a
> runM mx = runM' Nothing where
>     runM' s =
>         case mx $: s of
>           Left (StateM str ss) ->
>               do putStrLn str
>                  putStrLn $ "debug: " ++ show ss -- эта строка здесь стоит исключительно в целях отладки. Её можно убрать, не нарушив основную функциональность "клиента".
>                  putStr ">>> "
>                  str' <- getLine
>                  runM' $ Just $ StateM str' ss
>           Right x -> return x

Для простоты, я введу оператор, аналогичный ($), работающий с нашими функциями.

> infixr 0 $:
> M t $: s = t s

Теперь объявим нашу монаду монадой.

> instance Monad M where

Ну, return x никакого обмена с пользователем не ведёт вообще, сразу возвращая x.

>     return x = M $ \Nothing -> Right x

Ситуация с bind интереснее. Выполняя mx >>= f, мы, конечно, должны сначала выполнить mx и получить x. Затем, мы должны выполнить f x. Но, выполняя f x, мы должны каждый раз запоминать значение x, чтобы в следующий раз, когда придёт ответ пользователя, дёрнуть именно f x, а не что-нибудь вроде f (_|_). Поэтому, мы должны запомнить последний State, после которого mx вернула значение, и использовать его для вычисления x снова и снова.

Конечно, если mx вообще никак с пользователем не связывается, мы можем всех этих "запоминаний" не делать.

>     mx >>= f = 
>         case mx $: Nothing of
>           Right x -> f x 
>           _ -> M t'
>         where

Функция handle выполняет основную работу. У неё есть два параметра (типа Maybe StateM). Первый из них передаётся в mx, второй - в (f x), если, конечно, mx завершила работу и вернула x. Заметим, что, если mx не вернула значение, handle запоминает этот факт, приписывая Nothing к стеку состояний - чтобы не перепутать в следующий раз. Если же mx вернула значение, handle приписывает к стеку состояний то состояние, которое было передано mx - чтобы в следующий раз его вспомнить.

>           handle toFirst toSecond =
>               case mx $: toFirst of
>                 Left (StateM str ss) -> Left $ StateM str $ Nothing:ss
>                 Right x ->
>                     case f x $: toSecond of
>                       Left (StateM str ss) -> Left $ StateM str $ toFirst:ss
>                       Right y -> Right y

Наконец, mx >>= f, начав работу, передаёт сигнал начать работу mx, а затем, если надо, и f x (это на случай, если mx завершится, а не потребует задать пользователю вопрос). Приняв ответ от пользователя, она для начала определяет, был ли вопрос задан внутри mx или внутри f x. Для этого, она смотрит на первый элемент в стеке состояний. Если этот первый элемент - Nothing, значит, вопрос был задан внутри mx, и надо запустить её заново, сообщив ей ответ пользователя, а в f x передать сигнал начала работы (если mx завершится и выдаст значение x). Если же первый элемент - некоторое состояние, значит, вопрос был задан внутри f x. Поэтому, нужно по этому первому элементу определить x - для чего придётся снова запустить mx - а затем снова запустить f x, передав этой функции ответ пользователя.

>           t' Nothing = handle Nothing Nothing
>           t' (Just (StateM str (Nothing:ss))) = handle (Just $ StateM str ss) Nothing
>           t' (Just (StateM str (s:ss))) = handle s $ Just $ StateM str ss

Не помешает и строительный кирпичик - функция, задающая вопрос пользователю, и возвращающая ответ.

> askM s = M ask' where
>     ask' Nothing = Left $ StateM s []
>     ask' (Just (StateM str [])) = Right str

Напишем тестовую функцию, в духе того, что предлагалось в SPbHUG:

> testM =
>     do a1 <- askM "1?"
>        a2 <- askM $ "You said: " ++ a1 ++ "; 2?"
>        a3 <- askM $ "You said: " ++ a2 ++ "; 3?"
>        a4 <- askM $ "You said: " ++ a3 ++ "; 4?"
>        a5 <- askM $ "You said: " ++ a4 ++ "; 5?"
>        askM $ "You said: " ++ a5
>        return ()

Думаю, смысл этой функции всем понятен. Запускаем:

*Test> runM testM
1?
debug: [Nothing]
>>> a
You said: a; 2?
debug: [Just (StateM "a" []),Nothing]
>>> b
You said: b; 3?
debug: [Just (StateM "a" []),Just (StateM "b" []),Nothing]
>>> c
You said: c; 4?
debug: [Just (StateM "a" []),Just (StateM "b" []),Just (StateM "c" []),Nothing]
>>> d
You said: d; 5?
debug: [Just (StateM "a" []),Just (StateM "b" []),Just (StateM "c" []),Just (StateM "d" []),Nothing]
>>> e
You said: e
debug: [Just (StateM "a" []),Just (StateM "b" []),Just (StateM "c" []),Just (StateM "d" []),Just (StateM "e" []),Nothing]
>>> 

Получается вот что. Работает-то наша монада хорошо, но вот отладочная печать показывает, что, чем дальше мы идём, тем больше информации передаём пользователю. Фактически, мы передаём ему снова и снова все ответы, которые он уже дал - и заставляем повторять их заново. Хотя, заметим, уже не нуждаемся в них - ну на фиг, скажите, знать ответ на первый вопрос, когда мы задаём пятый? Таким образом, получается та самая утечка - информация, идущая пользователю и не нужная ему, оказывается недоступной сборщику мусора (поскольку он никаким образом не может ручаться, что эта информация таки не нужна - это знает программист, но не компилятор и не рантайм). Соответственно, мусорная куча всё растёт и растёт.

Можно переписать этот пример в соответствии с тем, что предлагалось в SPbHUG.

> testM' =
>     do a5 <- do a4 <- do a3 <- do a2 <- do a1 <- askM "1?"
>                                            askM $ "You said: " ++ a1 ++ "; 2?"
>                                   askM $ "You said: " ++ a2 ++ "; 3?"
>                          askM $ "You said: " ++ a3 ++ "; 4?"
>                 askM $ "You said: " ++ a4 ++ "; 5?"
>        askM $ "You said: " ++ a5
>        return ()

Запустив этот чрезвычайно ясный код, видим, что положение отнюдь не становится лучше. На самом деле, оно становится немного хуже.

*Test> runM testM'
1?
debug: [Nothing,Nothing,Nothing,Nothing,Nothing]
>>> a
You said: a; 2?
debug: [Nothing,Nothing,Nothing,Nothing,Just (StateM "a" [])]
>>> b
You said: b; 3?
debug: [Nothing,Nothing,Nothing,Just (StateM "b" [Just (StateM "a" [])])]
>>> c
You said: c; 4?
debug: [Nothing,Nothing,Just (StateM "c" [Just (StateM "b" [Just (StateM "a" [])])])]
>>> d
You said: d; 5?
debug: [Nothing,Just (StateM "d" [Just (StateM "c" [Just (StateM "b" [Just (StateM "a" [])])])])]
>>> e
You said: e
debug: [Just (StateM "e" [Just (StateM "d" [Just (StateM "c" [Just (StateM "b" [Just (StateM "a" [])])])])]),Nothing]
>>> 

Продолжение следует.

Originally posted on migmit.vox.com