Haskell Hoopl：图形构造和不可达块的自动删除

我正在使用Hoopl库进行一个项目，我遇到了一个障碍，它向我表明我不完全了解引擎盖下发生了什么。简而言之，Hoopl似乎认为我的图中的一些块是不可到达的，IMO不应该达到。我正在实现一个稀疏条件常量传播，所以我确实希望某些块变得不可访问，但不是所有的块！下面是一个来自HUnit测试套件的示例，我正在使用它来制作原型。这个例子使用了几个没有在这里定义的函数，但是我对这些函数进行了单独的单元测试，以确认它们是独立工作的，特别是来自Hoopl的。TohooplX按预期工作，以此类推

我期望发生的是block_cprop_out应该是运行此过程的结果，但实际结果只是block_cprop_in_0的const-fold版本：真分支和假分支都被消除。HUnit测试的输出在代码段下面

---

为了概括我在高层所做的工作，我为每个块创建了一个闭合/闭合环图，然后将这些图与环图合并。事实证明，问题确实不在这段代码中

我没有在顶层输入标签映射monad，而是在转换的左边分别调用了runLabelMap，这意味着我无意中为程序中的每个用户标签分配了唯一的环标签，而不是在程序重用用户标签时重用环标签

当然，这意味着goto L3和匹配的L3：在后续代码中被映射到不同的环标签，而不是相同的环标签；真分支块和假分支块是绝对不可接近的，因为在Hoopl看来，它们似乎是我写的：

block_cprop_in_0 = [ --test for constprop
                     L $ Label "1",
                     O $ Sub (Reg "r0") (Reg "r0"),
                     T $ CondBranch (Reg "r0") (Label "2") (Label "3")
                   ]

block_cprop_in_1 = [ -- test for constprop
                     L $ Label "4",
                     O $ Sub (Reg "r1") (Reg "r0"),
                     T $ Halt
                   ] -- this block is unreachable from the CondBranch in block_cprop_in_0

block_cprop_in_2 = [ -- test for constprop
                     L $ Label "5",
                     O $ Sub (Reg "r2") (Reg "r0"), --should get rewritten as a SubI
                     T $ Halt
                   ]

只不过是一个单子，我终于抓住你了

对于后代来说，下面是正确的代码：我只需要将runhoopllabelmap提升到toHoopl函数之外的顶层

test_hoopl_6 =
  let p = [block_cprop_in_0, block_cprop_in_1, block_cprop_in_2]
      p' :: (H.Graph (Node Instruction) H.C H.C) = H.runSimpleUniqueMonad $ H.runWithFuel H.infiniteFuel $ ((transform p) :: H.SimpleFuelMonad (H.Graph (Node Instruction) H.C H.C))
      unP' :: [Instruction] = fromHoopl p'
  in unP' @?= block_cprop_out
  where
    convert prog = do
      ps <- forM prog (toHoopl @[] @Instruction @Label)
      let p = foldl (H.|*><*|) H.emptyClosedGraph ps
      return p

    transform :: (H.CheckpointMonad m, H.FuelMonad m, H.UniqueMonad m) => [[Instruction]] -> m (H.Graph (Node Instruction) H.C H.C)
    transform p = do
      (hlm, prog) <- runHooplLabelMapM Map.empty $ convert p
      let registers = ["r0", "r1", "r2", "r3"]
      let hooplLabelFor = fromJust . flip Map.lookup hlm
      let eLabel = hooplLabelFor $ Label "entry"
      p' <- runConstProp registers hooplLabelFor eLabel prog
      return p'

...

---

我忘了提到，如果我只是注释掉重写中的所有代码，正确和错误的分支仍然会被消除，这让我相信我构建图形的方式有问题，而不是我在重写中所做的！

block_cprop_in_0 = [ --test for constprop
                     L $ Label "1",
                     O $ Sub (Reg "r0") (Reg "r0"),
                     T $ CondBranch (Reg "r0") (Label "2") (Label "3")
                   ]

block_cprop_in_1 = [ -- test for constprop
                     L $ Label "4",
                     O $ Sub (Reg "r1") (Reg "r0"),
                     T $ Halt
                   ] -- this block is unreachable from the CondBranch in block_cprop_in_0

block_cprop_in_2 = [ -- test for constprop
                     L $ Label "5",
                     O $ Sub (Reg "r2") (Reg "r0"), --should get rewritten as a SubI
                     T $ Halt
                   ]

test_hoopl_6 =
  let p = [block_cprop_in_0, block_cprop_in_1, block_cprop_in_2]
      p' :: (H.Graph (Node Instruction) H.C H.C) = H.runSimpleUniqueMonad $ H.runWithFuel H.infiniteFuel $ ((transform p) :: H.SimpleFuelMonad (H.Graph (Node Instruction) H.C H.C))
      unP' :: [Instruction] = fromHoopl p'
  in unP' @?= block_cprop_out
  where
    convert prog = do
      ps <- forM prog (toHoopl @[] @Instruction @Label)
      let p = foldl (H.|*><*|) H.emptyClosedGraph ps
      return p

    transform :: (H.CheckpointMonad m, H.FuelMonad m, H.UniqueMonad m) => [[Instruction]] -> m (H.Graph (Node Instruction) H.C H.C)
    transform p = do
      (hlm, prog) <- runHooplLabelMapM Map.empty $ convert p
      let registers = ["r0", "r1", "r2", "r3"]
      let hooplLabelFor = fromJust . flip Map.lookup hlm
      let eLabel = hooplLabelFor $ Label "entry"
      p' <- runConstProp registers hooplLabelFor eLabel prog
      return p'

...