用 Haskell 的整除调试 C

Posted 2021-04-25 OSC开源社区

扫描二维码或点击图片进入西安源创会报名

协作翻译

原文：Debugging C with Haskell's Divisible

链接：http://www.michaelburge.us/2017/09/27/delta-debugging-in-haskell.html

译者：Tocy, Tony, 亚林瓜子

好的类型系统涵盖了很多小的错误。单元测试、精心设计和健全的头脑可以让你通过更大的测试。但是，有时候，在大型代码库中的复杂错误需要重型调试工具。

这样一类的工具之一是 Delta Debugging ，它反复压减递归数据结构，以找到仍然复现该 bug 的最小测试集。如果你曾经使用过 git bisect 来查找大型代码库中的一个小小的破坏性改动，那么你将会非常欢迎该技术。

本文包括：

• Delta 调试技术简介

• 实现一个通用的增量调试工具

• 使用 Haskell 的 FFI 来控制 C 象棋引擎

• 定位导致该棋牌引擎的错误的原因

设置

在我的上一篇文章中，我用C实现了象棋引擎。我在其移动生成器中引入了一个错误。回想一下移动生成器涉及5个函数：

typedef ... gamestate;

typedef ... iterator;

typedef ... move;

// Move generation

iterator mkIterator(gamestate g);

iterator advance_iterator(gamestate g, iterator i);

gamestate apply_move(gamestate g, move m);

bool is_iterator_finished(iterator x);

move dereference_iterator(iterator i);

void print_fen(gamestate g, char *buffer);

gamestate new_game();

// The actual function used to define the bug

uint64_t perft(gamestate g, int depth);

用于测试象棋引擎的“黄金标准”是将上述仿版功能的输出与已发布的参考值进行比较。我们发现的错误从看板的开始状态很容易看到，所以new_game将是引擎中我所暴露的唯一的gamestate值。

在FFI部分中，我将为所有内容定义Haskell封装器：

data Gamestate

data Iterator

data Move

newGame             :: Gamestate

printFen            :: Gamestate -> String

mkIterator          :: Gamestate -> Iterator

advanceIterator     :: Gamestate -> Iterator -> Iterator

perft               :: Gamestate -> Int32    -> Word64

applyMove           :: Gamestate -> Move     -> Gamestate

isIteratorFinished  :: Iterator  -> Bool

dereferenceIterator :: Iterator  -> Move

为了检测错误，我们需要一个perft的参考版本来与我们的做对比。我会使用Roce象棋做对比，所以我们的Haskell将会逐字地调用roce38进程，设置棋盘状态，并要求它计算一个perft值。

type Move' = String

reference_perft :: Gamestate -> Int32 -> Word64

reference_moves :: Gamestate -> [Move']

我已经使用unsafePerformIO的形式删除了对IO的约束，以简化文章的进度，但是最终的解决方案对于IO而言将是足够通用的。

可简化的(Reducible)

以下是在QuickCheck的Arbitrary类型类的一个变体:

-- | Gives all of the single-step reductions for a type.

-- | It is recommended to put the largest reductions first.

class Reducible a where

  reductions :: a -> [a]

minimize :: Reducible a => (a -> Bool) -> a -> a

minimize f x = case find f $ reductions x of

  Nothing -> x

  Just y -> minimize f y

如果你有一个可以使web浏览器崩溃的HTML文件，minimize将删除标签或字符，直到它是一个最小的引起崩溃的文件。此变体将一次只删除单个标记或字符，而Arbitrary会出于性能考虑而移除整个批次。

回想一下，perft需要Gamestate和Depth值。 “最小可能”则意味着Depth是最小的。

instance Reducible Gamestate where

  reductions :: Gamestate -> [Gamestate]

  reductions g =

    let loop i =

          if isIteratorFinished i

          then []

          else

            let m = dereferenceIterator i

                g' = applyMove g m

                i' = advanceIterator g i

            in g' : loop i'

    in loop $ mkIterator g

type Depth = Int32

newtype PerftTest = PerftTest (Gamestate, Depth) deriving (Show)

instance Reducible PerftTest where

  reductions :: PerftTest -> [PerftTest]

  reductions (PerftTest (g, depth)) =

    if depth == 1

    then []

    else map (\g' -> PerftTest (g', depth-1)) $ reductions g

这里是如何应用此方法在两个不同引擎之间来找到具体位置的移动：

module Main where

import Chess

import Reducible

checkBug :: PerftTest -> Bool

checkBug (PerftTest (g, depth)) =

  perft g depth /= reference_perft g depth

compareMoves :: Gamestate -> ([Move'], [Move'])

compareMoves g =

  let lefts = map printMove $ moves g

      rights = reference_moves g

  in (lefts \\ rights, rights \\ lefts)

instance Show Gamestate where

  show g = printFen g

main :: IO ()

main = do

  let g = newGame

      i = mkIterator g

  let (PerftTest (g', depth)) = minimize checkBug $ PerftTest (g, 3)

  putStrLn $ show $ g'

  putStrLn $ show $ compareMoves g'

  

{- Prints:

r1bqkbnr/pppppppp/n7/8/8/4P3/PPPP1PPP/RNBQKBNR w KQkq - 0 1

([],["e1e2"])

-}

FEN字符串可以直接粘贴到像XBoard这样的程序中，以方便位置的可视化，“e1e2”是Rocechess发出的而自身的引擎没有发出的动作。

在这一点上，你必须深入探究C语言中，看看为什么在e1的King是不被允许向北移动到e2的。我会通过展示我所做的改动来破坏它：

private uint64_t valid_king_moves(gamestate g, int idx)

{

  uint64_t ret =

    bit(move_direction(idx, DIRECTION_EAST)) |

    bit(move_direction(idx, DIRECTION_WEST)) |

    // bit(move_direction(idx, DIRECTION_NORTH)) |

    bit(move_direction(idx, DIRECTION_SOUTH)) |

    bit(move_direction(idx, DIRECTION_NORTHEAST)) |

    bit(move_direction(idx, DIRECTION_SOUTHEAST)) |

    bit(move_direction(idx, DIRECTION_NORTHWEST)) |

    bit(move_direction(idx, DIRECTION_SOUTHWEST))

    ;

  ...

  return ret;

}

我在许多不同软件项目中的经验是，调试中的大部分工作是在创建一个小型的独立的测试用例来验证问题，而不是实际的修复。

整除

整除性是我写这篇文章的主要原因，并且允许我们来 概括以上的 minimize。由于上下文是调试一个 国际象棋引擎，我将使用演绎逻辑的语言来描述我们将如何使用它。 

这个想法是为了证明 perft g 6的价值是正确的，你需要两个组成部分： 

一种将 perft g 6分解为子问题的方法 perft g' 5。 

一种证明基本情况 用例的方法正确： perft g 0 == 1

由于我们正在调试，这样的证明是不可能的，因为我们手头有一个失败的测试用例。但是，我们可以在上下文中定义“proof”是什么意思，因此我们将使用“正确的或者产生具体的最小反例”：

-- 测试用例a可以分解成较小的小问题。

-- 反例查找器扫描a并产生：

-- 1.没有：A证明所有的子问题都是正确的

-- 2.只是b：有些子问题是错误，相对与b来说

newtype Cx b a = Cx { unCx :: a -> Maybe b }

实际上有3种不同的类型，对应于3种不同的验证技术：

Contravariant 小节 概括了 否定后件。

整除性 小节 概括了 合取引入。

Decidable 小节 概括了 析取消去。

可判定的(Decidable)

contramap对应于逻辑上的逆否，而divide对应于逻辑与。另一个主要工具是逻辑或，由choose提供。

class Divisible f => Decidable f where

  lose   :: (a -> Void) -> f a

  choose :: (a -> Either b c) -> f b -> f c -> f a

lose 是在你知道你所选择的一个分支是不可能的，但被要求提供证明时的占位符。 只有3种可能的实现：

一个例外，使用未定义或荒谬。

• 使用undefined或absurd定义的异常。

• const conquer

• 不同于conquer的常量

我在contravariant包中没有看到任何第三种类型的例子，但是我设想它可以用来回写反向跟踪，类似于使用MonadPlus中的guard :: Bool -> [()]来修剪分支。

在我们的上下文中choose意味着，如果你尝试在类型a的值中定位错误，则可以将其拆分为两个子问题之一，并且可以在两个子问题中找到错误，然后可以通过找出哪些子问题更适合a并重用该证据。这是实现：

instance Decidable (Cx b) where

  lose _ = conquer

  choose split left right = Cx $ \x ->

    -- Both branches must produce a counterexample

    case split x of

      Left l -> unCx left l

      Right r -> unCx right r

Decidable和Divisible的主要区别是Decidable精确分支到子系统中的一个，而Divisible把所有子问题结合起来。

在我们继续探讨重新实现minimize之前，我实现了decideList来说明下Decidable在实际中是如何工作的。

decideList :: forall a b f. Decidable f => (a -> (Integer, b)) -> [f b] -> f a

decideList f (xp:xps) = choose caseConstructor xp (decideList nextF xps)

  where

    caseConstructor :: a -> Either b a

    caseConstructor x =

      let (c, w) = f x

      in case c of

        0 -> Left w

        n -> Right x

    nextF :: a -> (Integer, b)

    nextF x = let (c, w) = f x

              in (c-1, w)

这里的想法是(Integer, b)是由分支选择符和值b组成的。对于Either，Left将是分支0，而Rightt将是分支1. caseConstructor或者选择当前分支，或者将a值传递到下一个线程。

与divideList一样，decideList并不是完全通用的，因为它要求每个子问题都是相同的类型。

minimize

我们开始泛化我们最初的minimize函数。这是其实现：

minimize :: Reducible a => (a -> Bool) -> a -> a

minimize f x = case find f $ reductions x of

  Nothing -> x

  Just y -> minimize f y

我们用3步泛化它：

• 首先，我们的Cx类型包含一个 a -> Maybe a，可以同时表示minimize的a -> Bool和a -> a部分。因此minimize就变成了Reducible a => Cx a a -> Cx a a。

• 其次，我已经将Cx泛化为Decidable f限制，使得其签名变为(Decidable f, Reducible a) => f a -> f a。

• 第三，minimize调用了find :: (a -> Bool) -> [a] -> Maybe a.。因此我将其泛化为findD :: Decidable f => f a -> f [a]。

import Data.List (uncons)

import Control.Arrow ((&&&))

minimizeD :: (Decidable f, Reducible a) => f a -> f a

minimizeD pred = divide (reductions &&& id) (findD $ minimizeD pred) pred

findD :: Decidable f => f a -> f [a]

findD p = chooseMaybe uncons conquer (divided p (findD p))

chooseMaybe :: Decidable f => (a -> Maybe b) -> f () -> f b -> f a

chooseMaybe p nothing just = choose (maybe (Left ()) Right . p) nothing just

uncons :: [a] -> Maybe (a, [a])

(&&&) :: (a -> b) -> (a -> c) -> (a -> (b,c))

在我们特定的上下文上，下面是你可能如何在英语中理解它的描述：

• minimizeD: minimal错误或是来自当前节点的reductions之一，或是来自当前节点本身(id)。

• findD: minimal错误或因为列表为空（conquer）、当前元素(p)或列表中的剩余值（findD p）而变得不存在的。

下面是一个使用简单类型的函数，可以被简单地应用：

minimizeD'' :: PerftTest -> Maybe PerftTest

minimizeD'' x = unCx (minimizeD (Cx $ liftPred checkBug)) x

  where

    liftPred :: (a -> Bool) -> (a -> Maybe a)

    liftPred pred = \x ->

      if pred x

      then Just x

      else Nothing

testCase :: Int -> PerftTest

testCase n = PerftTest (newGame, n)

exampleInvocation = minimizeD'' $ testCase 3

FFI

最后一个组件是 C ++ 引擎和 Haskell 控件代码之间的接口。 首先，这里是我将展示的 C ++ 函数：

#include "chess.cpp"

extern "C" {

  void new_game_w(gamestate *g)

  { *g = new_game(); }

  void print_move_w(move *m, char *buffer)

  { print_move(*m, buffer); }

  

  void print_fen_w(gamestate *g, char *buffer)

  { print_fen(*g, buffer); }

  void mkIterator_w(gamestate *g, iterator *i)

  { *i = mkIterator(*g); }

  void advance_iterator_w(gamestate *g, iterator *i, iterator *result)

  { *result = advance_iterator(*g, *i); }

  uint64_t perft_w(gamestate *g, int depth)

  { return perft(*g, depth); }

  void apply_move_w(gamestate *g, move *m, gamestate *result)

  { *result = apply_move(*g, *m); }

  int is_iterator_finished_w(iterator *i)

  { return is_iterator_finished(*i) ? 1 : 0; }

  void dereference_iterator_w(iterator *i, move *m)

  { *m = dereference_iterator(*i); }

  

};

由于 GHC 不支持在堆栈上传递 struct 值，所以我分配临时内存并传递一个 C ++ 代码写入的指针。

newtype Gamestate = Gamestate BS.ByteString

newtype Iterator = Iterator BS.ByteString

newtype Move = Move BS.ByteString

instance Show Gamestate where

  show g = printFen g

instance Show Move where

  show m = printMove m

pokeBs :: Ptr a -> BS.ByteString -> IO ()

pokeBs ptr bs = BS.useAsCStringLen bs $ \(src, len) ->

  copyBytes (castPtr ptr) src len

instance Storable Gamestate where

  sizeOf _ = 80

  alignment _ = 8

  peek ptr = Gamestate <$> BS.packCStringLen (castPtr ptr, sizeOf (undefined :: Gamestate))

  poke ptr (Gamestate bs) = pokeBs ptr bs

instance Storable Move where

  sizeOf _ = 16

  alignment _ = 8

  peek ptr = Move <$> BS.packCStringLen (castPtr ptr, sizeOf (undefined :: Move))

  poke ptr (Move bs) = pokeBs ptr bs

instance Storable Iterator where

  sizeOf _ = 80

  alignment _ = 8

  peek ptr = Iterator <$> BS.packCStringLen (castPtr ptr, sizeOf (undefined :: Iterator))

  poke ptr (Iterator bs) = pokeBs ptr bs

每个封装的函数都遵循一个分配内存的规则模式，写入参数，调用函数和读取结果。 为了简洁起见，我只显示一个：

applyMove :: Gamestate -> Move -> Gamestate

applyMove g m = unsafePerformIO $

  alloca $ \g_ptr ->

  alloca $ \m_ptr ->

  alloca $ \g'_ptr -> do

    poke g_ptr g

    poke m_ptr m

    applyMove_w g_ptr m_ptr g'_ptr

    peek g'_ptr

这涵盖了我自己的系统引擎。 我们还需要调用 Rocechess 作为参考。 这个函数就是这样的：

{- Standard output from the "roce38" process looks like:

Roce version: 0.0380 - Roman's Own Chess Engine

Copyright (C) 2003-2007 Roman Hartmann, Switzerland. All rights reserved.

warning: couldn't open Roce.cfg

roce: 

roce: 

Perft (3): 8902, Time: 0.001 s

-}

runRoceCommands :: [String] -> ([String] -> a) -> IO a

runRoceCommands commands parseOutput = do

    (Just hin, Just hout, _, ph) <- createProcess $ (proc "./roce38" []) {

      std_in = CreatePipe,

      std_out = CreatePipe,

      std_err = Inherit

      }

    hSetBuffering hout NoBuffering

    hSetBuffering hin NoBuffering

    forM_ commands $ \command -> do

      hPutStr hin command

      hPutChar hin '\n'

    output <- hGetContents hout

    tickCounter

    return $ parseOutput $ drop 6 $ lines output

reference_perft_w :: Gamestate -> Int32 -> IO Word64

reference_perft_w g d =

  let commands = [

        "setboard " ++ printFen g,

        "perft " ++ show d,

        "quit"

        ]

      parseOutput (perft_line : _) =

        let perft_word = splitOneOf " ," perft_line !! 2

            perft = read perft_word

        in perft

        

  in runRoceCommands commands parseOutput

reference_perft g d = unsafePerformIO $ reference_perft_w g d

请注意，使用 tickCounter 来测量我们调用此高耗费命令的次数。

为什么不使用Arbitrary?

我在这篇文章中主要使用了 Reducible，因为相比 Arbitrary 它是一种更简单的类型。关于象棋的例子，没有理由使用 Reducible 而不使用 Arbitrary。这是因为 perft 测试是失败的：成功的测试意味着所有相关的子测试都是成功的。我曾遇到过的不成功的例子是编译器要跳转到一个不存在的标签：

label1:

  goto label2

  goto label1

在这种情况下，我们希望最小化到仅返回 label2，因为这是演示该错误的最小的语句。然而，QuickCheck 包中的shrinkList采用了一个优化，从性能考虑从列表中移除了按指数级百分比增长的元素，这意味着它可以删除 label1 和 goto label2：

goto label1

这仍然是跳到一个不存在的标签，但只是因为我们的代码删除了它。通过足够详细地定义错误条件，可以完全恢复其单调属性; 但也可以直接通过减少子任务来恢复该属性。因为goto label1依赖它，相对于检查是否可以安全地删除整组语句,检查label1是否可以从直接的子任务中排除可能更加简单。

结论

我们已经泛化了将失败测试用例减少到最小状态的函数。特别地，有一个 Compose 的实例允许生成的算法在任意 Monad 或 Applicative 上运行。这样可以通过基准化信息来增强缩减流程，实现经过清晰定义的优化，并对简单的纯值测试新的简化算法，从而自动将其推广到完整的应用上。

本文的代码可在 Github 上获得。

未来的文章可能涵盖：

• 进一步优化测试用例缩减的工具

• 使用抽象类型类泛化其他常用的实用程序

• 更多的调试程序技巧

推荐阅读

点击“阅读原文”查看更多精彩内容