On Vox: Длинное, про Хаскель - часть 1
May. 1st, 2008 08:14 pm
В рассылке 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
