Стековая машина на моноидах15.11.2018 15:47

Не так давно на Хабре появилась отличная и вдохновляющая статья про компиляторы и стековые машины. В ней показывается путь от простой реализации исполнителя байт-кода ко всё более и более эффективным версиям. Мне захотелось показать на примере разработки стековой машины, как это можно сделать Haskell-way.

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

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

Материала получилось много, со множеством примеров в коде, и чтобы облегчить читателю понимание нужно ли ему в неё погружаться, приведу аннотированное содержание.

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

Поиск слова «моноид» по статьям на Хабре выдаёт не более четырёх десятков статей (про те же монады, например, их три сотни). Все они концептуально начинают с чего-то вроде: моноид это такое множество…, а потом, с вполне понятным восторгом, перечисляют что является моноидом — от строк до пальчиковых деревьев, от парсеров регулярных выражений до бог знает ещё чего! Но на практике мы мыслим в обратном порядке: у нас есть объект, который необходимо моделировать, мы анализируем его свойства и обнаружив, что он обладает признаками той или иной абстрактной структуры, решаем: нужны ли нам следствия из этого обстоятельства и как нам это использовать. Мы пройдём именно этим путём. А заодно добавим в коллекцию полезных моноидов ещё парочку интересных примеров.

Языки и программы для стековых машин

Стековые машины при изучении функционального программирования, обычно появляются в тот момент, когда подходят к концепции свёртки. При этом приводится крайне лаконичная реализация исполнителя простейшего стекового калькулятора, например, такая:

calc :: String -> [Int]
calc = interpretor . lexer
  where
    lexer = words
    interpretor = foldl (flip interprete) []
    interprete c = case c of
      "add" -> binary $ \(x:y:s) -> x + y:s
      "mul" -> binary $ \(x:y:s) -> x * y:s
      "sub" -> binary $ \(x:y:s) -> y - x:s
      "div" -> binary $ \(x:y:s) -> y `div` x:s
      "pop" -> unary  $ \(x:s) -> s
      "dup" -> unary  $ \(x:s) -> x:x:s
      x -> case readMaybe x of
        Just n -> \s -> n:s
        Nothing -> error $ "Error: unknown command " ++ c
      where
        unary f s = case s of
          x:_ -> f s
          _ -> error $ "Error: " ++ c ++ " expected an argument."
        binary f s = case s of
          x:y:_ -> f s
          _ -> error $ "Error: " ++ c ++ " expected two arguments."

Прекрасное начало для разговора! Далее, как правило, начинают навешивать эффекты: меняют свёртку foldl на foldM, обеспечивают тотальность через монаду Either String, потом добавляют логирование, оборачивая всё трасформером WriterT, внедряют с помощью StateT словарь для переменных, и так далее. Иногда, для демонстрации крутости монадических вычислений, реализуют неоднозначный калькулятор, возвращающий все возможные значения выражения . Это долгий, хороший и интересный разговор. Однако, свой рассказ мы сразу поведём по-другому, хотя и закончим его тем же результатом.

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

У свёрточной машины есть ряд ограничений, основное — программа всегда прочитывается от начала до конца и один раз. Ветвление, циклы и вызовы подпрограмм требуют концептуального изменения интерпретатора. Ничего сложного, конечно, но такая машина уже не может быть описана простой свёрткой.

Согласно гипотезе лингвистической относительности, свойства используемого нами языка напрямую влияют на свойства нашего мышления. Давайте обратим внимание не на машину, а на языки и программы, которыми она управляется.

Все стеково-ориентированные языки, как относительно низкоуровневые (байт-коды виртуальных машин Java и Python или .NET), так и языки уровнем повыше (PostScript, Forth или Joy), имеют одно фундаментальное общее свойство: если записать последовательно две корректные программы, то получится корректная программа. Правда, корректная не значит «правильная», эта программа может вылетать с ошибкой на любых данных или проваливаться в бесконечные циклы и вообще не иметь смысла, но главное — такая программа сможет быть выполнена машиной. В то же время, разбивая корректную программу на части мы легко можем эти части использовать повторно, именно в силу их корректности. Наконец, в любом стековом языке можно выделить подмножество команд, оперирующих только внутренним состоянием машины (стеком или регистрами), не использующих какую-либо внешнюю память. Это подмножество будет образовывать язык, обладающий свойством конкатенативности. В таком языке любая программа имеет смысл преобразователя состояния машины, а последовательное выполнение программ эквивалентно их композиции, а значит, тоже является преобразователем состояния.

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

При склеивании важен порядок. Например, эти две программы, несомненно, разные:

Зато нам неважно где программу разрезать, если тут же её в этом месте склеить:

Это простое обстоятельство отражает ассоциативность операции конкатенации и поднимает структуру, которую образуют стековые программы, на новый уровень, мы понимаем что это полугруппа.

И что это нам даёт, как программистам? Ассоциативность позволяет выполнять прекомпиляцию, оптимизацию и даже распараллеливание произвольных пригодных для этого отрезков программы, а потом объединять их в эквивалентную программу. Мы можем позволить себе провести статический анализ любого отрезка программы и использовать его в анализе всей программы именно потому, что нам всё равно, где ставить скобки. Это очень важные и серьёзные возможности для языка низкого уровня или промежуточного языка, на котором пишет не человек, а транслятор. А с точки зрения математика и матёрого функциональщика, это делает программы-преобразователи состояния машины полноценными эндоморфизмами. Эндоморфизмы тоже образуют полугруппу с операцией композиции. В алгебре такие эндоморфизмы называются полугруппами трансформации по отношению к какому-либо множеству. Например, конечные автоматы образуют полугруппу трансформации множества состояний.

«Полугруппа» звучит половинчато, как-то неполноценно. Может быть, стековые программы образуют группу? Э… нет, большинство программ необратимо, то есть, по результату выполнения не выйдет однозначно восстановить исходные данные. А вот нейтральный элемент у нас есть. В языках ассемблера он обозначается и ничего не делает. Если в стековом языке такого оператора явно не определили, то его можно легко получить комбинируя некоторые команды, например: , или . Такие пары можно безболезненно вырезать из программ или, напротив, вставлять куда угодно в произвольном количестве. Поскольку единица имеется, наши программы образуют полугруппу с единицей или моноид. Значит, можно программно реализовать их в виде моноидов — эндоморфизмов над состоянием стековой машины. Это позволит определить небольшой набор базовых операций для машины, а потом создавать программы с помощью их композиции, получив стековый язык в форме встроенного предметно-ориентированного языка (EDSL).

В языке Haskell полугруппы и моноиды описаны с помощью классов Semigroup и Monoid. Их определения просты и отражают только базовую структуру, требования ассоциативности и нейтральности приходится проверять программисту:

class Semigroup a where
  (<>) :: a -> a -> a

class Semigroup a => Monoid a where
  mempty :: a

Строим машину

{-# LANGUAGE LambdaCase, GeneralizedNewtypeDeriving #-}

import Data.Semigroup (Max(..),stimes)
import Data.Monoid
import Data.Vector ((//),(!),Vector)
import qualified Data.Vector as V (replicate)

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

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

type Stack = [Int]
type Memory = Vector Int
type Processor = VM -> VM

memSize = 4

data VM = VM { stack :: Stack
             , status :: Maybe String
             , memory :: Memory }
          deriving Show

emptyVM = VM mempty mempty (V.replicate memSize 0)

setStack :: Stack -> Processor
setStack  x (VM _ s m) = VM x s m

setStatus :: Maybe String -> Processor
setStatus x (VM s _ m) = VM s x m

setMemory :: Memory -> Processor
setMemory x (VM s st _) = VM s st x

Сеттеры нужны для того, чтобы сделать явной семантику программы. Под процессором (тип Processor) мы будем понимать преобразователь VM -> VM.

Теперь определим типы-обёртки для моноида трансформации и для программы:

instance Semigroup (Action a) where
  Action f <> Action g = Action (g . f)

instance Monoid (Action a) where
  mempty = Action id

newtype Program = Program { getProgram :: Action VM }
  deriving (Semigroup, Monoid)

Типы-обёртки определяют принцип комбинирования программ: это эндоморфизмы с обратным порядком композиции (слева направо). Использование обёрток позволяет компилятору самостоятельно определить каким образом тип Program реализует требования классов Semigroup и Monoid.

Исполнитель программ тривиален:

run :: Program -> Processor
run = runAction . getProgram

exec :: Program -> VM
exec prog = run prog emptyVM

Сообщение об ошибке будет формировать функция err:

err :: String -> Processor
err = setStatus . Just $ "Error! " ++ m

Мы используем тип Maybe не так как он используется обычно: пустое значение Nothing в статусе означает, что ничего опасного не происходит, и вычисления можно продолжать, в свою очередь, строковое значение знаменует проблемы. Для удобства, определим два умных конструктора: один — для программ, работающих только со стеком, другой — для тех, которым нужна память.

program :: (Stack -> Processor) -> Program
program f = Program . Action $
  \vm -> case status vm of
    Nothing -> f (stack vm) vm
    _ -> vm

programM :: ((Memory, Stack) -> Processor) -> Program
programM f = Program . Action $
  \vm -> case status vm of
    Nothing -> f (memory vm, stack vm) vm
    _ -> vm

Теперь можно определять базовые команды языка для работы со стеком и памятью, целочисленную арифметику, а также отношения эквивалентности и порядка.

pop = program $ 
  \case x:s -> setStack s
        _ -> err "pop expected an argument."

push x = program $ \s -> setStack (x:s)

dup = program $ 
  \case x:s -> setStack (x:x:s)
        _ -> err "dup expected an argument."

swap = program $ 
  \case x:y:s -> setStack (y:x:s)
        _ -> err "swap expected two arguments."

exch = program $ 
  \case x:y:s -> setStack (y:x:y:s)
        _ -> err "exch expected two arguments."

-- конструктор для функций с ограниченным индексом
indexed i f = programM $ if (i < 0 || i >= memSize)
                         then const $ err $ "expected index in within 0 and " ++ show memSize
                         else f

put i = indexed i $
    \case (m, x:s) -> setStack s . setMemory (m // [(i,x)])
          _ -> err "put expected an argument"

get i = indexed i $ \(m, s) -> setStack ((m ! i) : s)

unary n f = program $
  \case x:s -> setStack (f x:s)
        _ -> err $ "operation " ++ show n ++ " expected an argument"

binary n f = program $
  \case x:y:s -> setStack (f x y:s)
        _ -> err $ "operation " ++ show n ++ " expected two arguments"

add = binary "add" (+)
sub = binary "sub" (flip (-))
mul = binary "mul" (*)
frac = binary "frac" (flip div)
modulo = binary "modulo" (flip mod)
neg = unary "neg" (\x -> -x)
inc = unary "inc" (\x -> x+1)
dec = unary "dec" (\x -> x-1)
eq = binary "eq" (\x -> \y -> if (x == y) then 1 else 0)
neq = binary "neq" (\x -> \y -> if (x /= y) then 1 else 0)
lt = binary "lt" (\x -> \y -> if (x > y) then 1 else 0)
gt = binary "gt" (\x -> \y -> if (x < y) then 1 else 0)

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

branch :: Program -> Program -> Program
branch br1 br2 = program go
   where go (x:s) = proceed (if (x /= 0) then br1 else br2) s
         go _ = err "branch expected an argument."

while :: Program -> Program -> Program
while test body = program (const go) 
  where go vm = let res = proceed test (stack vm) vm
          in case (stack res) of
               0:s -> proceed mempty s res
               _:s -> go $ proceed body s res
               _ -> err "while expected an argument." vm

rep :: Program -> Program
rep body = program go
  where go (n:s) = proceed (stimes n body) s
        go _ = err "rep expected an argument."

proceed :: Program -> Stack -> Processor
proceed prog s = run prog . setStack s

Типы функций branch и while говорят о том, что это не самостоятельные программы, а комбинаторы программ: типичный подход при создании EDSL в Haskell. Функция stimes определена для всех полугрупп, она возвращает композицию указанного числа элементов.

Наконец, напишем несколько программ, для опытов.

-- рекурсивный факториал
fact = dup <> push 2 <> lt <>
       branch (push 1) (dup <> dec <> fact) <>
       mul

-- итеративный факториал
fact1 = push 1 <> swap <>
        while (dup <> push 1 <> gt) 
        (
         swap <> exch <> mul <> swap <> dec
        ) <> 
        pop

-- заполняет стек последовательностью чисел
-- в указанном диапазоне
range = exch <> sub <> rep (dup <> inc)

-- ещё один итеративный факториал,
-- записанный через свёртку списка команд
fact2 = mconcat [ dec, push 2, swap, range, push 3, sub, rep mul]

-- итеративный факториал с использованием памяти
fact3 = dup <> put 0 <> dup <> dec <>
        rep (dec <> dup <> get 0 <> mul <> put 0) <>
        get 0 <> swap <> pop

-- копирует два верхних элемента стека
copy2 = exch <> exch

-- вычисляет наибольший общий делитель 
-- по простейшему алгоритму Евклида
gcd1 = while (copy2 <> neq) 
       (
         copy2 <> lt <> branch mempty (swap) <> exch <> sub
       ) <>
       pop

-- возведение в степень методом русского крестьянина
pow = swap <> put 0 <> push 1 <> put 1 <>
      while (dup <> push 0 <> gt)
      (
        dup <> push 2 <> modulo <>
        branch (dec <> get 0 <> dup <> get 1 <> mul <> put 1) (get 0) <>
        dup <> mul <> put 0 <>
        push 2 <> frac
      ) <>
      pop <> get 1

Получилось 120 строк кода с комментариями и аннотациями типов, которые определяют машину, оперирующую 18 командами с тремя комбинаторами. Вот как наша машина работает .

λ> exec (push 6 <> fact)
VM {stack = [720], status = Nothing, memory = [0,0,0,0]}

λ> exec (push 6 <> fact3)
VM {stack = [720], status = Nothing, memory = [720,0,0,0]}

λ> exec (push 2 <> push 6 <> range)
VM {stack = [6,5,4,3,2], status = Nothing, memory = [0,0,0,0]}

λ> exec (push 6 <> push 9 <> gcd1)
VM {stack = [3], status = Nothing, memory = [0,0,0,0]}

λ> exec (push 3 <> push 15 <> pow)
VM {stack = [14348907], status = Nothing,  memory = [43046721,14348907,0,0]}

λ> exec (push 9 <> add)
VM {stack = [9], status = Just "Error! add expected two arguments", memory = [0,0,0,0]}

На самом деле, мы ничего нового не сделали — комбинируя преобразователи-эндоморфизмы, мы, по существу, вернулись к свёртке, но она стала неявной. Напомним, свёртка даёт абстракцию последовательной обработки индуктивных данных. Данные, в нашем случае, образуются индуктивным образом при склеивании программ оператором , и «хранятся» они в эндоморфизме в виде цепочки композиций функций-преобразователей машины до момента применения этой цепочки к исходному состоянию. В случае применения комбинаторов branch и while цепочка начинает превращаться в дерево или в цикл. В общем случае, мы получаем граф, отражающий работу автомата с магазинной памятью, то есть, стековой машины. Именно эту структуру мы «сворачиваем» при выполнении программы.

Насколько эффективна такая реализация? Композиция функций — это самое лучшее, что умеет делать компилятор языка Haskell. Он, буквально, рождён для этого! Когда речь заходит о преимуществах использования знания о моноидах, часто приводят пример разностных списков diffList — реализации связного списка в виде композиции эндоморфизмов. Разностные списки принципиально ускоряют формирование списков из множества кусочков благодаря ассоциативности композиции функций. Возня с типами-обёртками не приводит к увеличению накладных расходов, они «растворяются» на этапе компиляции. Из лишней работы остаётся только проверка состояния на каждом шаге выполнения программы.

Комбинируем моноиды

Думаю, к этому моменту скептики и случайные читатели уже нас покинули, можно позволить себе расслабиться и перейти на следующий уровень абстракции.

Концепция полугрупп и моноидов не была бы столь полезной и универсальной, если бы не ряд свойств, присущих всем полугруппам и моноидам без исключения, которые позволяют из простых структур строить сложные точно таким же образом, каким мы строим сложные программы из простых. Эти свойства относятся уже не к объектам, а к типам и их лучше записать не в математической нотации, а в виде программ на Haskell, которые в силу изоморфизма Карри-Ховарда, являются их доказательствами.

1) Моноиды и полугруппы можно «перемножать». Здесь имеется в виду произведение типов, абстракцией которого в Haskell является кортеж или пара.

instance (Semigroup a, Semigroup b) => Semigroup (a,b) where
    (a1, b1) <> (a2, b2) = (a1 <> a2, b1 <> b2)
instance (Monoid a, Monoid b) => Monoid (a,b) where
    mempty = (mempty, mempty )

2) Существует единичный моноид, он представлен единичным типом ():

instance Semigroup () where
    () <> () = ()
instance Monoid () where
    mempty = ()

С операцией перемножения полугруппы сами образуют полугруппу, а принимая во внимание единичный тип, можно сказать, что моноиды образуют моноид! Ассоциативность и нейтральность единицы при этом выполняется с точностью до изоморфизма, но это не принципиально.

3) Отображения в полугруппу или моноид образуют, соответственно, полугруппу или моноид. И тут тоже проще записать это утверждение на Haskell:

instance Semigroup a => Semigroup (r -> a) where
  f <> g = \r -> f r <> g r
instance Monoid a => Monoid (r -> a) where
  mempty = const mempty

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

(command1 <> command2) r   ==  command1 r <> command2 r

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

Мы введём в структуру машины журнал, но не будем привязывать его к какому-то определённому типу, а выведем его в параметр типа. Писать в журнал будем с помощью обобщённой моноидальной операции.

data VM a = VM { stack :: Stack
               , status :: Maybe String
               , memory :: Memory
               , journal :: a }
            deriving Show

mkVM = VM mempty mempty (V.replicate memSize 0)

setStack  x (VM _ st m l) = VM x st m l
setStatus st (VM s _ m l) = VM s st m l
setMemory m (VM s st _ l) = VM s st m l
addRecord x (VM s st m j) = VM s st m (x<>j)

newtype Program a = Program { getProgram :: Action (VM a) }
  deriving (Semigroup, Monoid)

type Program' a = (VM a -> VM a) -> Program a

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

program f p = Program . Action $
  \vm -> case status vm of
    Nothing -> p . (f (stack vm)) $ vm
    m -> vm

programM f p = Program . Action $
  \vm -> case status vm of
    Nothing -> p . (f (memory vm, stack vm)) $ vm
    m -> vm

proceed p prog s = run (prog p) . setStack s

rep body p = program go id
  where go (n:s) = proceed p (stimes n body) s
        go _ = err "rep expected an argument."

branch br1 br2 p = program go id
   where go (x:s) = proceed p (if (x /= 0) then br1 else br2) s
         go _ = err "branch expected an argument."

while test body p = program (const go) id
  where go vm = let res = proceed p test (stack vm) vm
          in case (stack res) of
               0:s -> proceed p mempty s res
               _:s -> go $ proceed p body s res
               _ -> err "while expected an argument." vm

Осталось научить вводить внешнюю информацию в исполнитель программ. Это очень просто сделать, создавая различные исполнители с различной стратегией ведения журнала. Первый исполнитель будет самым простым, молчаливым, не тратящим сил на ведение журнала:

exec prog = run (prog id) (mkVM ())

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

execLog p prog = run (prog $ \vm -> addRecord (p vm) vm) (mkVM mempty)

Информация может быть, например, такая:

logStack vm   = [stack vm]
logStackUsed  = Max . length . stack
logSteps      = const (Sum 1)
logMemoryUsed = Max . getSum . count . memory
  where count = foldMap (\x -> if x == 0 then 0 else 1)

Проверяем работу:

λ> exec (push 4 <> fact2)
VM {stack = [24], status = Nothing, memory = [0,0,0,0], journal = ()}

λ> journal $ execLog logSteps (push 4 <> fact2)
Sum {getSum = 14}

λ> mapM_ print $ reverse $ journal $ execLog logStack (push 4 <> fact2)
[4]
[3]
[2,3]
[3,2]
[2,2]
[3,2]
[3,3,2]
[4,3,2]
[4,4,3,2]
[5,4,3,2]
[3,5,4,3,2]
[2,4,3,2]
[12,2]
[24]

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

f &&& g = \r -> (f r, g r)

Так можно провести сравнение четырёх реализаций факториала по числу шагов и максимальной длине стека

λ> let report p = journal $ execLog (logSteps &&& logStackUsed) p

λ> report (push 8 <> fact)
(Sum {getSum = 48},Max {getMax = 10})

λ> report (push 8 <> fact1)
(Sum {getSum = 63},Max {getMax = 4})

λ> report (push 8 <> fact2)
(Sum {getSum = 26},Max {getMax = 9})

λ> report (push 8 <> fact3)
(Sum {getSum = 43},Max {getMax = 3})

Логгеры можно было бы объявить моноидом с операцией &&&, если бы они все возвращали одинаковый тип. Но так как они разные, Haskell это сделать не позволяет. Так что не всё, что комбинируется является работающим моноидом.

Программы и их коды

Полноценная отладка подразумевает информацию о выполняемых командах. Но наши команды — это настоящие функции, у них нет имени вне пространства имён Haskell. И тут мы приходим к красивому рассуждению.

Можно сопоставить каждой базовой команде уникальный код, в то же время, можно сопоставить коду — команду. Оба соответствия однозначные, а значит: множества команд и имён изоморфны. Программы (комбинации команд) образуют моноид, и тексты программ (последовательность кодов) образуют моноид. Мы и начинали разговор с того, что разрезали и склеивали именно тексты программ, записанные на лентах. Значит между программами и их кодами можно построить пару взаимно-обратных гомоморфизмов.

Давайте же построим эти отображения! Определим сначала тип для кодов нашего языка:

data Code = IF [Code] [Code]
          | REP [Code]
          | WHILE [Code] [Code]
          | PUT Int | GET Int
          | PUSH Int | POP | DUP | SWAP | EXCH
          | INC | DEC | NEG
          | ADD | MUL | SUB | DIV
          | EQL | LTH | GTH | NEQ
          deriving (Read, Show)

Теперь построим гомоморфизм код программа:

fromCode :: [Code] -> Program' a
fromCode = hom
  where
    hom = foldMap $ \case
      IF b1 b2 -> branch (hom b1) (hom b2)
      REP p -> rep (hom p)
      WHILE t b -> while (hom t) (hom b)
      PUT i -> put i
      GET i -> get i
      PUSH i -> push i
      POP -> pop
      DUP -> dup
      SWAP -> swap
      EXCH -> exch
      INC -> inc
      DEC -> dec
      ADD -> add
      MUL -> mul
      SUB -> sub
      DIV -> frac
      EQL -> eq
      LTH -> lt
      GTH -> gt
      NEQ -> neq
      NEG -> neg

Здесь мы используем то, что программы являются моноидами. foldMap это эффективная свёртка, рассчитанная на моноиды и использующая ассоциативность моноидальных операций. Гомоморфизм fromCode является транслятором программы, записанной в кодах, он уже позволяет транслировать программы, записанные в виде кодов и даже в виде текcта:

λ> stack $ exec (fromCode [PUSH 2, PUSH 5, EXCH, SUB, REP [DUP, INC]])
[5,4,3,2]

λ> stack $ exec (fromCode $ read "[PUSH 2, PUSH 5, EXCH, SUB, REP [DUP, INC]]")
[5,4,3,2]

Обратный гомоморфизм программа код построить таким же образом не выйдет, поскольку мы не можем перебирать в case функции. Но можно снова воспользоваться двумя замечательными обстоятельствами: тем что программы образуют моноид и тем что моноиды образуют полугруппу! Перемножим в определении типа Program код программы и соответствующий ему трансформер:

newtype Program a = Program { getProgram :: ([Code], Action (VM a)) }
  deriving (Semigroup, Monoid)

run = runAction . snd . getProgram

Наряду с исполняющей функцией run появляется возможность получить код программы и вот он второй гомоморфизм, обратный fromCode:

toCode :: Program' a -> [Code]
toCode prog = fst . getProgram $ prog id

Теперь остаётся переписать выражения для умных конструкторов так, чтобы каждой базовой программе можно было бы указать её код. Впрочем, конструкторы и определения команд языка изменятся не существенно:

type Program' a = (Code -> VM a -> VM a) -> Program a

program c f p = Program . ([c],) . Action $
  \vm -> case status vm of
    Nothing -> p c . f (stack vm) $ vm
    _ -> vm

programM c f p = Program . ([c],) . Action $
  \vm -> case status vm of
    Nothing -> p c . f (memory vm, stack vm) $ vm
    _ -> vm

Как видно, функция, которую мы передаём для ведения журнала стала бинарной, поскольку она теперь располагает кодом программы. Значит надо немного поменять логгеры, а за одно создать логгер для кода и говорливый логгер-отладчик:

none = const id
exec prog = run (prog none) (mkVM ())

execLog p prog = run (prog $ \c -> \vm -> addRecord (p c vm) vm) (mkVM mempty)

logStack _ vm = [stack vm]
logStackUsed _ = Max . length . stack
logSteps _ = const (Sum 1)

-- новые логгеры
logCode c _ = [c]
logRun com vm = [pad 10 c ++ "| " ++ pad 20 s ++ "| " ++ m]
  where c = show com
        m = unwords $ show <$> toList (memory vm)
        s = unwords $ show <$> stack vm
        pad n x = take n (x ++ repeat ' ')

debug :: Program' [String] -> String
debug = unlines . reverse . journal . execLog logRun

pop = program POP $ 
  \case x:s -> setStack s
        _ -> err "POP expected an argument."

push x = program (PUSH x) $ \s -> setStack (x:s)

dup = program DUP $ 
  \case x:s -> setStack (x:x:s)
        _ -> err "DUP expected an argument."

swap = program SWAP $ 
  \case x:y:s -> setStack (y:x:s)
        _ -> err "SWAP expected two arguments."

exch = program EXCH $ 
  \case x:y:s -> setStack (y:x:y:s)
        _ -> err "EXCH expected two arguments."

app1 c f = program c $
  \case x:s -> setStack (f x:s)
        _ -> err $ "operation " ++ show c ++ " expected an argument"

app2 c f = program c $
  \case x:y:s -> setStack (f x y:s)
        _ -> err $ "operation " ++ show c ++ " expected two arguments"

add = app2 ADD (+)
sub = app2 SUB (flip (-))
mul = app2 MUL (*)
frac = app2 DIV (flip div)
neg = app1 NEG (\x -> -x)
inc = app1 INC (\x -> x+1)
dec = app1 DEC (\x -> x-1)
eq = app2 EQL (\x -> \y -> if (x == y) then 1 else 0)
neq = app2 NEQ (\x -> \y -> if (x /= y) then 1 else 0)
lt = app2 LTH (\x -> \y -> if (x > y) then 1 else 0)
gt = app2 GTH (\x -> \y -> if (x < y) then 1 else 0)

proceed p prog s = run (prog p) . setStack s

rep body p = program (REP (toCode body)) go none
  where go (n:s) = if n >= 0
                   then proceed p (stimes n body) s
                   else err "REP expected positive argument."
        go _ = err "REP expected an argument."

branch br1 br2 p = program (IF (toCode br1) (toCode br2)) go none
   where go (x:s) = proceed p (if (x /= 0) then br1 else br2) s
         go _ = err "IF expected an argument."

while test body p = program (WHILE (toCode test) (toCode body)) (const go) none
  where go vm = let res = proceed p test (stack vm) vm
          in case (stack res) of
               0:s -> proceed p mempty s res
               _:s -> go $ proceed p body s res
               _ -> err "WHILE expected an argument." vm

put i = indexed (PUT i) i $
    \case (m, x:s) -> setStack s . setMemory (m // [(i,x)])
          _ -> err "PUT expected an argument"

get i = indexed (GET i) i $ \(m, s) -> setStack ((m ! i) : s)

indexed c i f = programM c $ if (i < 0 || i >= memSize)
                             then const $ err "index in [0,16]"
                             else f

Всё, изоморфизм между программами и их кодами установлен! Давайте посмотрим, как он работает.

Во-первых, мы можем получить код любой программы:

λ>  toCode fact1
[PUSH 1,SWAP,WHILE [DUP,PUSH 1,GTH] [SWAP,EXCH,MUL,SWAP,DEC],POP]

Теперь программы можно создавать с помощью EDSL, записывать их в файл и считывать из него.

Во-вторых, можем убедиться в том, что два гомоморфизма toCode и fromCode являются взаимо-обратными.

λ> toCode $ fromCode [PUSH 5, PUSH 6, ADD]
[PUSH 5, PUSH 6, ADD]

λ> exec (fromCode $ toCode (push 5 <> push 6 <> add))
VM {stack = [11], status = Nothing, memory = [0,0,0,0], journal = ()}

Правда, наш изоморфизм имеет один существенный недостаток: он не позволяет превратить в конечный код программы, определённые с помощью явной рекурсии. Попробуйте в ghci посмотреть код программы fact, только держите пальцы на готове, чтобы поскорее нажать Ctrl+C. Приходится признать, что гомоморфизм toCode существует, но вычислим частично.

Наконец, давайте запустим полноценный отладчик, причём, он-то как раз хорошо работает и с рекурсивными функциями тоже:

λ> putStrLn $ debug (push 3 <> fact)
PUSH 3    | 3                   | 0 0 0 0
DUP       | 3 3                 | 0 0 0 0
PUSH 2    | 2 3 3               | 0 0 0 0
LTH       | 0 3                 | 0 0 0 0
DUP       | 3 3                 | 0 0 0 0
DEC       | 2 3                 | 0 0 0 0
DUP       | 2 2 3               | 0 0 0 0
PUSH 2    | 2 2 2 3             | 0 0 0 0
LTH       | 0 2 3               | 0 0 0 0
DUP       | 2 2 3               | 0 0 0 0
DEC       | 1 2 3               | 0 0 0 0
DUP       | 1 1 2 3             | 0 0 0 0
PUSH 2    | 2 1 1 2 3           | 0 0 0 0
LTH       | 1 1 2 3             | 0 0 0 0
PUSH 1    | 1 1 2 3             | 0 0 0 0
MUL       | 1 2 3               | 0 0 0 0
MUL       | 2 3                 | 0 0 0 0
MUL       | 6                   | 0 0 0 0

Освобождение моноида

Код программы имеет вид дерева и он представляет собой чистую информацию о программе. Мы получили свободную алгебру программ для нашей стековой машины. Более того, и сами программы являются свободными структурами, так как мы построили изоморфизм между кодом программы и исполнителем!

Кроме возможностей сериализации и десериализации, свободные структуры предоставляют свободу интерпретации. Мы построили пока только один способ интерпретации свободной программы — в виде трансформаций состояния стековой машины. Но имея программу в свободной форме можно делать с ней что угодно, например обеспечивать форматированный вывод, проводить оптимизацию или статический анализ.

Обычно, на этом замечательном пассаже статья про свободные структуры обрывается: можно и можно, правда сложно и в одном разделе не рассказать. Но так вышло, что наш язык чрезвычайно прост и чрезвычайно моноидален, а это позволяет делать некоторые вещи очень изящно. Грех этим не воспользоваться и не поделиться!

Вот, например, как просто написать форматированный листинг программы:

listing :: Program' a -> String
listing = unlines . hom 0 . toCode
  where
    hom n = foldMap f
      where
        f = \case
          IF b1 b2 -> ouput "IF" <> indent b1 <> ouput ":" <> indent b2
          REP p -> ouput "REP" <> indent p
          WHILE t b -> ouput "WHILE" <> indent t <> indent b
          c -> ouput $ show c

        ouput x = [stimes n "  " ++ x]
        indent = hom (n+1)

И снова строится гомоморфизм: теперь командам ставятся в соответствие строки с отступом, которые, опять же, образуют моноид.

λ> putStrLn . listing $ fact2
INC
PUSH 1
SWAP
EXCH
SUB
DUP
PUSH 0
GTH
IF
  REP
    DUP
    INC
:
  NEG
  REP
    DUP
    DEC
DEC
DEC
REP
  MUL

λ> putStrLn . listing $ gcd1
WHILE
  EXCH
  EXCH
  NEQ
  EXCH
  EXCH
  LTH
  IF
  :
    SWAP
  EXCH
  SUB
POP

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

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

Приведём валентности некоторых других операторов:

Почему мы всё время оговариваемся: минимальное число, максимальные требования…? Дело в том, что все базовые операторы имеют точно определённую валентность, но при ветвлении разные ветви могут иметь разные т

© Habrahabr.ru