在 Haskell do-notation 中生成唯一值答案

【问题标题】：Generating a unique value in Haskell do-notation在 Haskell do-notation 中生成唯一值
【发布时间】：2018-09-05 07:08:19
【问题描述】：

为了生成 x86 汇编代码，我定义了一个名为 X86 的自定义类型：

data X86 a = X86 { code :: String, counter :: Integer, value :: (X86 a -> a) }

这种类型在 do-notation 中使用，如下所示。这使得编写用于生成 if 语句、for 循环等的模板变得很容易......

generateCode :: X86 ()
generateCode = do
  label1 <- allocateUniqueLabel
  label2 <- allocateUniqueLabel
  jmp label1
  label label1
  jmp label2
  label label2

指令定义如下：

jmp :: String -> X86 ()
jmp l = X86 { code = "jmp " ++ l ++ ";\n", counter = 0, value = const () }

label :: String -> X86 ()
label l = X86 { code = l ++ ":\n", counter = 0, value = const () }

完成的汇编文件打印如下：

printAsm :: X86 a -> String
printAsm X86{code=code} = code

main = do
  putStrLn (printAsm generateCode)

我以以下方式实现了X86 monad。本质上，序列运算符按顺序连接汇编代码块并确保计数器递增。

instance Monad X86 where
  x >> y = X86 { code = code x ++ code y, counter = counter x + counter y, value = value y }
  x >>= f = x >> y
    where y = f (value x x)

问题是标签没有正确递增，所以它们不是唯一的！以下是输出：

jmp Label1;
Label1:
jmp Label1;
Label1:

我希望输出对每个标签都有一个唯一的值：

jmp Label1;
Label1:
jmp Label2;
Label2:

为了完成这个例子，这里是allocatedUniqueLabel函数的实现：

allocateUniqueId :: X86 Integer
allocateUniqueId = X86 { code = "", counter = 1, value = counter }

allocateUniqueLabel :: X86 String
allocateUniqueLabel = do
  id <- allocateUniqueId
  return ("Label" ++ show id)

如何修复我的 X86 monad 以便标签是唯一的？

这是我尝试过的：

递增全局计数器。 => Haskell 不安全地允许 IO monad 之外的全局状态。
使用State monad。 => 我研究了一些示例，但不明白如何将它们集成到我现有的 X86 monad 中。
跟踪单子外的计数器。 => 我宁愿计数器在“幕后”更新；否则，很多不使用标签的代码模板将需要手动传播计数器。

【问题讨论】：

您只是为了方便使用Monad 类还是有某种合法的实例？
@Li-yaoXia 主要用于通过do-notation创建DSL。该实例是否合法，我不完全确定，但它一直在成功运行，直到需要唯一标签为止。
好吧，我不确定我是否遗漏了什么，但X86 实际上甚至不是Functor（Monad 必须是）。
您可以尝试自己实现 State，以了解更多信息。基本上，它的counter 的类型应该是Integer -> Integer
一个小建议：我会为allocateUniqueLabel 的结果创建一个专用的Label 类型。这将使您的代码更安全一些，确保您只跳转到标签，而不是任意字符串。

标签： haskell monads state-monad do-notation

【解决方案1】：

我们可以使用mtl classes 将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.

【讨论】：

【解决方案2】：

您可能想要使用这个 monad 堆栈：

type X86 a = StateT Integer (Writer String) a

既然你有一个 state 和一个 writer，你也可以考虑使用RWS（reader-writer-state all in one）：

type X86 a = RWS () String Integer a

让我们选择第一个好玩。我首先定义一个辅助函数来增加计数器（monads cannot lawfully increment a counter "automatically"）：

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 开头的指令定义模式）

我不会为此推出我自己的 monad —— 这样做可能很有启发性，但我认为使用标准库会更有用。

【讨论】：

为什么我们需要增加jmp 的标签计数器？我想说只有在生成新标签时才需要这样做（除非我们想为一段代码中的每条指令分配一个唯一标识符，这将是一个不同的问题）。

【解决方案3】：

您现在可能从其他答案中了解到，您的问题方法是即使你使用计数器，你仍然在本地生成标签。特别是

label1 <- allocateUniqueLabel
label label1

相当于

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

我们需要先组装整个代码，生成标签，然后只之后（在某种意义上）使用标签生成实际代码。这就是其他答案通过存储计数器所暗示的在State（或RWS）单子中。

还有一个我们可以解决的问题：您希望能够同时跳转向前和向后。这很可能是您分开的原因 allocateUniqueLabel 和 label 函数。但这允许设置相同的标记两次。

实际上可以使用带有“向后”绑定的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 monad 并使用 Random 的实例 UUID。类似于WriterT String Rand a，它也有一个MonadFix 实例。

（从纯粹的学术角度来看，可能可以构建一个箭头而不是一个单子，这将实现 ArrowLoop, 但不允许依赖于值的状态修改，例如evilReset。但是X86 的封装实现了相同的目标，保持了更友好的do 语法。）

【讨论】：