在Haskell中生成一个独特的值
为了生成x86汇编代码，我定义了一个名为X86的自定义类型：
data X86 a = X86 { code :: String, counter :: Integer, value :: (X86 a -> a) }
这种类型用于如下的符号。 这可以很容易地编写用于生成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，使标签独一无二？
这是我试过的：
State monad。 =>我已经看了很多例子，但不明白如何将它们集成到我现有的X86 monad中。 我们可以使用mtl类将X86代码描述为有效的程序。 我们想要：
Writer效果; State影响。 我们担心最后实例化这些效应，并且在我们使用MonadWriter和MonadState约束的程序描述中。
import Control.Monad.State -- mtl
import Control.Monad.Writer
分配一个新的标识符会增加计数器，而不会生成任何代码。 这只使用State效应。
type Id = Integer
allocateUniqueLabel :: MonadState Id m => m Id
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.
你可能想要使用这个monad堆栈：
type X86 a = StateT Integer (Writer String) a
既然你有一个国家和一个作家，你也可以考虑使用RWS （读写器状态一体化）：
type X86 a = RWS () String Integer a
让我们选择第一个为乐趣。 我首先定义一个辅助函数来增加计数器（monads不能合法地增加一个计数器“自动”）：
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--这样做可能很有教育意义，但我认为使用这个标准库可以获得更多的里程数。
由于您现在可能已经失去了其他答案，所以您的方法存在的问题是，即使您使用的是计数器，您仍然在本地生成标签。 尤其是
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 -> ma在其参数中并不严格。 效果不能取决于参数，否则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并使用UUID的Random实例生成标签。 就像WriterT String Rand a ，它也有一个MonadFix实例。
（从纯粹的学术角度来看，可能会构建一个箭头而不是monad，它会实现ArrowLoop ，但不允许依赖于值的状态修改，比如在evilReset 。但是X86封装达到了相同的目标，保持了很多友好的do语法。）