haskell - Hoopl: 到達不能ブロックのグラフ構築と自動削除

Question

私は Hoopl ライブラリを使用するプロジェクトに取り組んでいますが、内部で何が起こっているのか完全に理解していないことを示す障害に遭遇しました。一言で言えば、Hoopl は私のグラフ内のいくつかのブロックを到達不能と見なしているようです (IMO) すべきではありません。私はまばらな条件付き定数の伝播を実装しているので、一部のブロックが到達不能になると予想していますが、すべてのブロックではありません! 以下は、プロトタイプ作成に使用している HUnit テスト スイートからの例です。この例では、ここで定義されていないいくつかの関数を使用していますが、それらが単独で動作すること、特に期待どおりに動作することなどを確認するために、個別の単体テストを用意していfromHoopl . toHoopl xます。

私が期待しているblock_cprop_outのは、このパスを実行した結果であるはずですが、実際の結果は の const 折り畳みバージョンにすぎませんblock_cprop_in_0。 true ブランチと false ブランチの両方が削除されています。HUnit テストからの出力は、コード スニペットの下にあります。

私が行っていることを大まかに要約すると、ブロックごとに閉じた/閉じた Hoopl グラフを作成し、これらのグラフを とマージしますHoopl.|*><*|。シンプルな を使用してData.Map、Hoopl がユーザー ラベルに割り当てる一意のラベルを追跡します。これにより、 を書き直すときにBranch userlabel、Hoopl の後継ラベルを正しい Hoopl に変更できますLabel。ただし、この前方分析を実行して書き直した後、エントリ ブロックのみを含むグラフが返されるため、Hoopl は true 分岐ブロックと false 分岐ブロックの両方がここでは到達不能であると見なしているようです。

block_cprop_outここでは少し奇妙です。なぜなら、私のfromHoopl関数は単純にHoopl.foldGraphNodesHoopl 全体Graph aを単純な[a]検査用に変えるために呼び出しているからです。

別のテストでは、同じグラフ構築方法 (閉じたブロックと閉じたブロックを連結する) を使用してこのブロックのリストをラウンドトリップすることが期待どおりに機能することが確認されています。到達不能ブロックの除去は、特にによってトリガーされるようHoopl.analyzeAndRewrite{Fwd,Bwd}です。

私がここでやっているように、閉じた/閉じたブロックのリストをつなぎ合わせることは正しいですか? もしそうなら、Hoopl にブロックが到達不能であると信じ込ませている可能性がある、他に何か疑わしいものを見つけることができますか?

block_cprop_in_0 = [ --test for constprop
                     L $ Label "entry",
                     O $ Sub (Reg "r0") (Reg "r0"),
                     T $ CondBranch (Reg "r0") (Label "tb") (Label "fb")
                   ]

block_cprop_in_1 = [ -- test for constprop
                     L $ Label "tb",
                     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 "fb",
                     O $ Sub (Reg "r2") (Reg "r0"), --should get rewritten as a SubI
                     T $ Halt
                   ]

block_cprop_out = [ --test for constprop
                    L $ Label "entry",
                    O $ Sub (Reg "r0") (Reg "r0"),
                    T $ Branch (Label "fb"),
                    L $ Label "fb",
                    O $ SubI 0 (Reg "r2"),
                    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
    transform :: (H.CheckpointMonad m, H.FuelMonad m, H.UniqueMonad m) => [[Instruction]] -> m (H.Graph (Node Instruction) H.C H.C)
    transform prog = do
      (hlms, ps) <- liftM unzip $ forM prog toHoopl
      let hlm = Map.unions hlms
      let p = foldl (H.|*><*|) H.emptyClosedGraph ps
      let hooplLabelFor = fromJust . flip Map.lookup hlm
      let eLabel = hooplLabelFor $ Label "entry"
      let registers = ["r0", "r1", "r2", "r3"]
      p' <- runConstProp registers hooplLabelFor eLabel p
      return p'

    constLattice :: H.DataflowLattice ConstFact
    constLattice = H.DataflowLattice
     { H.fact_name = "Register Contents"
     , H.fact_bot  = Map.empty
     , H.fact_join = H.joinMaps (H.extendJoinDomain constFactAdd)
     }
     where
       constFactAdd _ (H.OldFact old) (H.NewFact new)
           = if new == old then (H.NoChange, H.PElem new)
             else               (H.SomeChange, H.Top)

    -- initially all registers have unknown contents
    initFact :: [Register] -> ConstFact
    initFact regs = Map.fromList $ [(r, H.Top) | r <- regs]

    -- transfer function: register value is a constant
    regIsConstant :: (Label -> H.Label) -> H.FwdTransfer (Node Instruction) ConstFact
    regIsConstant hooplLabelFor = H.mkFTransfer rc
     where
      rc :: Node Instruction e x -> ConstFact -> H.Fact x ConstFact
      rc (NodeInit _ _) f = f

      -- subtracting a register from itself yields zero
      rc (NodeCont (O (Sub (Reg a) (Reg b)))) f
        = if a == b then Map.insert a (H.PElem 0) f else f

      rc (NodeCont (O (Sub _ (Reg x)))) f   = Map.insert x H.Top f
      rc (NodeCont (O (SubI _ (Reg x)))) f  = Map.insert x H.Top f
      rc (NodeCont (O (SubM _ (Reg x)))) f  = Map.insert x H.Top f
      rc (NodeCont (O (Load _ (Reg x)))) f  = Map.insert x H.Top f
      rc (NodeCont (O (Store _ (Reg x)))) f = Map.insert x H.Top f
      rc (NodeCont (O (CmpEq _ (Reg x)))) f = Map.insert x H.Top f
      rc (NodeCont (O (CmpLt _ (Reg x)))) f = Map.insert x H.Top f
      rc (NodeCont (O _)) f = f

      rc (NodeTerm (T Halt) _) f = H.mkFactBase constLattice []
      rc (NodeTerm (T (Branch l)) _) f = H.mapSingleton (hooplLabelFor l) f

      -- if we take the false branch of a CondBranch then the condition register contains zero
      rc (NodeTerm (T (CondBranch (Reg x) tl fl)) _) f
        = H.mkFactBase constLattice
               [(hooplLabelFor tl, f),
                (hooplLabelFor fl, Map.insert x (H.PElem 0) f)]

    -- rewrite function: replace use of reg with constant contents
    constProp :: forall m. H.FuelMonad m => (Label -> H.Label) -> H.FwdRewrite m (Node Instruction) ConstFact
    constProp hooplLabelFor = H.mkFRewrite cp
     where
       cp :: Node Instruction e x -> ConstFact -> m (Maybe (H.Graph (Node Instruction) e x))
       cp node f
         = return $ rw hooplLabelFor (lookup f) node

       rw :: (Label -> H.Label) -> (Register -> Maybe Integer) -> Node Instruction e x -> (Maybe (H.Graph (Node Instruction) e x))
       rw hooplLabelFor valueOf inst =
         case inst of
           -- if we see a subtract with constant, turn it into a SubI
           (NodeCont (O (Sub (Reg x) (Reg y)))) ->
             case (valueOf x, valueOf y) of
               (Just xi, _) -> Just $ H.mkMiddle $ NodeCont $ O $ SubI xi (Reg y)
               (_, Just yi) -> Just $ H.mkMiddle $ NodeCont $ O $ SubI yi (Reg x)
               _            -> Nothing

           -- if we see a CondBranch on a constant, turn it into a Branch
           (NodeTerm (T (CondBranch (Reg x) tl fl)) _) ->
             case (valueOf x) of
              (Just xi) ->
                if 0 == xi then
                  Just $ H.mkLast $ NodeTerm (T $ Branch fl) [hooplLabelFor fl]
                else
                  Just $ H.mkLast $ NodeTerm (T $ Branch tl) [hooplLabelFor tl]
              _ -> Nothing
           _ -> Nothing

       lookup :: ConstFact -> Register -> Maybe Integer
       lookup f x = case Map.lookup x f of
                      Just (H.PElem v) -> Just v
                      _                -> Nothing

    constPropPass :: H.FuelMonad m => (Label -> H.Label) -> H.FwdPass m (Node Instruction) ConstFact
    constPropPass hooplLabelFor = H.FwdPass
      { H.fp_lattice  = constLattice
      , H.fp_transfer = regIsConstant hooplLabelFor
      , H.fp_rewrite  = constProp hooplLabelFor
      }

    runConstProp :: (H.CheckpointMonad m, H.FuelMonad m) => [Register] -> (Label -> H.Label) -> H.Label -> (H.Graph (Node Instruction) H.C H.C) -> m (H.Graph (Node Instruction) H.C H.C)
    runConstProp registers hooplLabelFor entry graph = do
      (graph', _, _) <- H.analyzeAndRewriteFwd (constPropPass hooplLabelFor) (H.JustC [entry]) graph (H.mapSingleton entry $ initFact registers)
      return graph'

HUnit の出力は次のとおりです。

hoopl_6: [Failed]
  expected: [L (Label "entry"),O (Sub (Reg "r0") (Reg "r0")),T (Branch (Label "fb")),L (Label "fb"),O (SubI 0 (Reg "r2")),T Halt]
  but got: [L (Label "entry"),O (Sub (Reg "r0") (Reg "r0")),T (Branch (Label "fb"))]