[博客翻译]Haskell中一个使用Escard√≥-Oliva函数的x86汇编程序

使用Escardó-Oliva函数式编程在Haskell中编写一个合适的X86汇编器

编写一个汇编器是一个有趣的例子：需要计算跳转指令与其目标标签之间的距离，而目标标签可能出现在跳转指令之后。事实证明，可以使用tardis单子或在Curry中编写一个单遍汇编器，利用逻辑编程。

然而，基于tardis的汇编器不适用于X86——跳转指令本身可能占用2或5字节，具体取决于跳转目标是否在-128到127字节范围内。因此，在知道所有跳转指令的编码大小之前，我们无法计算跳转指令及其目标的偏移量，而这些编码大小是根据距离选择的。

这为我们展示函数式编程中的“大锤”——Escardó-Oliva函数式提供了一个机会。

Escardó-Oliva函数式[1]的类型为：

bigotimes :: [[x] -> (x -> r) -> x] -> ([x] -> r) -> [x]

它计算游戏的最优移动（这里是[x]），游戏的结果类型为r，从类型为(x -> r) -> x的选择函数（我们必须提供）中，并且可以访问移动历史（类型为[x]）。

例如，这个接口可以用来编写类似SAT求解器的东西，当可能时，它会选择满足谓词的n个布尔变量：

solve :: Int -> ([Bool] -> Bool) -> [Bool]
solve n = bigotimes (replicate n (\_ -> ε))
 where ε = \p -> p True

ghci> solve 3 (\[a,b,c] -> a && b && not c)
[True,True,False]

这可能看起来晦涩，但并不难使用。在我们的例子中，问题可以被视为一个单人游戏；结果是汇编代码所需的字节数，我们希望最小化这个值。每个移动是使用2或5字节编码的跳转指令。将跳转到250字节远的标签编码为短跳转（例如）的移动被游戏规则禁止。

简化的X86汇编：

type Label = Int
type JIx = Int
data X86 a = J a !Label
      | L !Label
      | Xor -- 3字节
ij :: [X86 a] -> [X86 JIx]
ij = go 0 where
  go _ []      = []
  go i (J _ l:isns) = J i l:go (i+1) isns
  go i (L l:isns)  = L l:go i isns
  go i (Xor:isns)  = Xor:go i isns
data Enc = Short | Near deriving (Show, Eq)
bytes :: Enc -> Int
bytes Short = 2
bytes Near = 5

ij为每个跳转指令标记以便查找。
游戏：

type R = Int
type Move = (JIx, Enc)

最优玩法（这里是指导致最小代码的跳转编码分配）由以下提供：

optimalPlay :: [Move]
optimalPlay = bigotimes εs p

其中

p :: [Move] -> R

是定义结果（在我们的例子中是所需的字节数）的谓词，而

εs :: [[Move] -> J R Move]

是给定过去移动的选择函数列表。J是选择单子，即

type J r x = (x -> r) -> x

对于试图最小化R的玩家，Escardó和Oliva提供了以下辅助函数：

arginf :: [x] -> J R x
arginf []    = \ -> undefined
arginf [x]   = \ -> x
arginf (x:y:zs) = \p -> if p x < p y then arginf (x:zs) p else arginf (y:zs) p

它返回给定潜在移动的适当选择函数。我们的问题是单人游戏，因此这将足以定义εs。
At是机器代码在内存中的偏移量。

type At = Int
assembly :: [X86 ()]
assembly = [J () 1, J () 0] ++ replicate 40 Xor ++ [L 1, L 0]
assemblyj :: [X86 JIx]
assemblyj = ij assembly

下一部分相当标准——我们收集标签的偏移量——微妙之处在于，如果尚未指定跳转，我们可以假设所有跳转都是短跳转；无效的分配将在稍后被修剪。

ixes :: [Move] -> ([(Label, At)], [(JIx, At)])
ixes ms = mkIx ms 0 assemblyj
-- 给定假定的跳转编码，每个指令的位置
mkIx :: [Move] -> At -> [X86 JIx] -> ([(Label, At)], [(JIx, At)])
mkIx ms ix (isn@Xor:isns) = mkIx ms (ix+3) isns
mkIx ms ix (isn@(L l):isns) =
  let (ls, isns') = mkIx ms ix isns
  in ((l,ix):ls, isns')
mkIx ms ix (isn@(J j l):isns) =
  let enc = lookup j ms
    -- 如果编码不在移动历史中，我们乐观地假设它是短跳转
    -- 如果这导致后续矛盾，它将被修剪
    (ls, isns') = mkIx ms (ix+maybe 2 bytes enc) isns
  in (ls, (j, ix):isns')

在历史的任何时刻，以下将区分不一致的编码：

valid :: [Move] -> Bool
valid ms = all g assemblyj
 where g Xor{}  = True
    g L{}   = True
    g (J j l) =
      let enc = lookup j ms
      in case enc of
        Just Short -> within j l (\i -> i >= -128 && i < 127)
        Just Near -> within j l (const True)
        -- 在历史的这一点尚未指定，目前没问题
        Nothing  -> True
  within j l clamp =
    let Just at0 = lookup j jAt
      Just at1 = lookup l lAt
    in clamp (at1-at0)
  (lAt, jAt) = ixes ms

将这与Escardó和Oliva提供的框架结合起来：

εs :: [[Move] -> J R Move]
εs = replicate n ε
 where ε h = let o = allj `setMinus` map fst h
       in arginf ([(j, Short) | j <- o , valid ((j, Short):h)] ++ [(j, Near) | j <- o])
    allj = collectj (assemblyj)
    n = length allj
p :: [Move] -> R
p ms = sum [ bytes e | (_, e) <- ms ]
optimalPlay :: [Move]
optimalPlay = bigotimes εs p

其中

setMinus :: Ord a => [a] -> [a] -> [a]

适用于没有重复的有序列表。
replicate n为每个跳转创建一个选择函数。
现在我们有了跳转指令的最优编码。看看当我们改变内部循环的大小时会发生什么：

assembly :: [X86 ()]
assembly = [J () 1, J () 0] ++ replicate 40 Xor ++ [L 0, L 1]
ghci> optimalPlay
[(1,Short),(0,Short)]

assembly :: [X86 ()]
assembly = [J () 1, J () 0] ++ replicate 41 Xor ++ [L 0, L 1]
ghci> optimalPlay
[(0,Near),(1,Short)]

assembly :: [X86 ()]
assembly = [J () 1, J () 0] ++ replicate 42 Xor ++ [L 0, L 1]
ghci> optimalPlay
[(1,Near),(0,Near)]

也就是说，当可能时（这取决于内部跳转是否以2字节编码），它会为内部和外部循环选择2字节编码，并拒绝无效编码。
供参考：

type K r x = (x -> r) -> r
overline :: J r x -> K r x
overline e = \p -> p (e p)
bigotimes :: [[x] -> J r x] -> J r [x]
bigotimes []   = \_ -> []
bigotimes (m:ms) = m [] . (\x -> bigotimes [ \xs -> d (x:xs) | d <- ms ])
 where
(*.*) :: J r x -> (x -> J r [x]) -> J r [x]
(*.*) m ind = \p ->
 let x = m (\x0 -> overline (ind x0) (\xs0 -> p (x0:xs0)))
   xs = ind x (\xs0 -> p (x:xs0))
 in x:xs

-- 没有重复的有序列表
delete :: Ord a => a -> [a] -> [a]
delete x [] = []
delete x (vs@(y:ys))
  | x == y = ys
  | x < y = vs
  | otherwise = y : delete x ys
setMinus :: Ord a => [a] -> [a] -> [a]
setMinus xs []   = xs
setMinus xs (y:ys) = setMinus (delete y xs) ys

代码可在此处获取：这里
[1] 这是历史依赖版本。