Генерация уникального значения в нотации Haskell

Мы можем использовать классы mtl для описания кода X86 как эффективных программ. Мы хотим:

• для генерации кода это Writer эффект;
• для поддержания счетчика, это эффект State.

Мы беспокоимся о том, чтобы реализовать эти эффекты в последнюю очередь, и в описании программ мы используем ограничения MonadWriter и MonadState.

import Control.Monad.State  -- mtl
import Control.Monad.Writer

Выделение нового идентификатора увеличивает значение счетчика без создания какого-либо кода. Здесь используется только эффект State.

type Id = Integer

allocateUniqueLabel :: MonadState Id m => m String
allocateUniqueLabel = do
  i <- get
  put (i+1)  -- increment
  return ("Label" ++ show (i+1))

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

jmp :: MonadWriter String m => String -> m ()
jmp l = tell ("jmp " ++ l ++ ";\n")

label :: MonadWriter String m => String -> m ()
label l = tell (l ++ ":\n")

Фактическая программа выглядит так же, как оригинал, но с более общими типами.

generateCode :: (MonadState Id m, MonadWriter String m) => m ()
generateCode = do
  label1 <- allocateUniqueLabel
  label2 <- allocateUniqueLabel
  jmp label1
  label label1
  jmp label2
  label label2

Эффекты создаются, когда мы запускаем эту программу, здесь используются runWriterT/runWriter и runStateT/runState (порядок не имеет большого значения, эти два эффекта коммутируют).

type X86 = WriterT String (State Id)

runX86 :: X86 () -> String
runX86 gen = evalState (execWriterT gen) 1 -- start counting from 1
-- evalState and execWriterT are wrappers around `runStateT` and `runWriterT`:
-- - execWriterT: discards the result (of type ()), only keeping the generated code.
-- - evalState: discards the final state, only keeping the generated code,
--   and does some unwrapping after there are no effects to handle.

Вероятно, вы захотите использовать этот стек монад:

type X86 a = StateT Integer (Writer String) a

Поскольку у вас есть состояние и средство записи, вы также можете рассмотреть возможность использования RWS (состояние чтения-записи в одном):

type X86 a = RWS () String Integer a

Давайте выберем первый для удовольствия. Сначала я бы определил вспомогательную функцию для увеличения счетчика (монады не могут законно увеличить счетчик "автоматически"):

instr :: X86 a -> X86 a
instr i = do
    x <- i
    modify (+1)
    return x

Затем вы можете определить jmp как:

jmp :: String -> X86 ()
jmp l = instr $ do
    lift (tell ("jmp " ++ l ++ ";\n"))
       -- 'tell' is one of Writer's operations, and then we 'lift'
       -- it into StateT

(Там do лишнее, однако я подозреваю, что будет шаблон запуска определений инструкций с instr $ do)

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

Как вы, вероятно, теперь поняли из других ответов, проблема с вашим подходом заключалась в том, что, хотя вы использовали счетчик, вы все равно генерировали свои метки локально. Особенно

label1 <- allocateUniqueLabel
label label1

был эквивалентен

X86 { code = "Label1:\n", counter = 1, value = const () }    

Нам нужно сначала собрать весь код, сгенерировать метки и только потом (в каком-то смысле) сгенерировать реальный код с использованием меток. И это то, что предлагают другие ответы, если счетчик хранится в монаде State (или RWS).

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

На самом деле можно использовать нотацию to do с "обратной" привязкой, используя MonadFix, который определяет эту монадическую операцию:

mfix :: (a -> m a) -> m a

Поскольку и State, и RWS имеют MonadFix экземпляров, мы действительно можем написать такой код:

{-# LANGUAGE GeneralizedNewtypeDeriving, RecursiveDo #-}
module X86
    ( X86()
    , runX86
    , label
    , jmp
    ) where

import Control.Monad.RWS

-- In production code it'll be much faster if we replace String with
-- ByteString.
newtype X86 a = X86 (RWS () String Int a)
    deriving (Functor, Applicative, Monad, MonadFix)

runX86 :: X86 a -> String
runX86 (X86 k) = snd (execRWS k () 1)

newtype Label = Label { getLabel :: String }

label :: X86 Label
label = X86 $ do
    counter <- get
    let l = "Label" ++ show counter
    tell (l ++ ":\n")
    modify (+1)
    return (Label l)

jmp :: Label -> X86 ()
jmp (Label l) = X86 . tell $ "jmp " ++ l ++ ";\n"

И используйте это так:

example :: X86 ()
example = do
    rec l1 <- label
        jmp l2
        l2 <- label
    jmp l1

Есть несколько замечаний:

• Нам нужно использовать расширение RecursiveDo, чтобы включить ключевое слово rec.
• Ключевое слово rec ограничивает блок взаимно рекурсивных определений. В нашем случае он также может начинаться на одну строку позже (rec jmp l2). Затем GHC переводит его на внутреннее использование mfix. (Использование устаревшего ключевого слова mdo вместо rec сделало бы код несколько более естественным.)

• Мы оборачиваем внутренности в новый тип X86. Во-первых, всегда хорошо скрыть внутреннюю реализацию, это позволяет позже легко провести рефакторинг. Во-вторых, mfix требует, чтобы переданная ей a -> m a функция не была строгой в своих аргументах. Эффект не должен зависеть от аргумента, иначе mfix расходится. Это условие выполняется для наших функций, но если внутренности открыты, кто-то может определить надуманную функцию следующим образом:

  -- | Reset the counter to the specified label.
  evilReset :: Label -> X86 ()
  evilReset = X86 . put . read . drop 5 . getLabel
  

  Это не только нарушает уникальность меток, но и приводит к зависанию следующего кода:

  diverge :: X86 ()
  diverge = do
      rec evilReset l2
          l2 <- label
      return ()
  

Другой очень похожей альтернативой может быть использование Rand и сгенерировать метки с Random экземпляр UUID. Что-то вроде WriterT String Rand a, у которого также есть экземпляр MonadFix.

(С чисто академической точки зрения можно построить стрелку вместо монады, которая реализует ArrowLoop, но запрещает изменения состояния, которые зависят от значений, например, в evilReset. Но инкапсуляция X86 достигает той же цели, сохраняя гораздо более удобный синтаксис do. )