能否让GHC优化（消除）通用函数例如折叠函数(catamorphisms)？

Question

我很喜欢以一种通用的方式使用折叠/展开函数来处理范畴学中的catamorphisms/anamorphisms的想法，但我认为它有一个显著的性能缺陷：

假设我们想以范畴化的方式处理树形结构——使用通用的catamorphism function来描述不同的折叠过程：

newtype Fix f = Fix { unfix :: f (Fix f) }

data TreeT r = Leaf | Tree r r
instance Functor TreeT where
    fmap f Leaf         = Leaf
    fmap f (Tree l r)   = Tree (f l) (f r)

type Tree = Fix TreeT

catam :: (Functor f) => (f a -> a) -> (Fix f -> a)
catam f = f . fmap (catam f) . unfix

现在我们可以编写如下的函数：

depth1 :: Tree -> Int
depth1 = catam g
  where
    g Leaf       = 0
    g (Tree l r) = max l r

很不幸，这种方法有一个显著的缺点：在计算过程中，fmap 的每个级别都会创建新的 TreeT Int 实例，以便立即被 g 消耗。与经典定义相比，这种方法效率低下。

depth2 :: Tree -> Int
depth2 (Fix Leaf) = 0
depth2 (Fix (Tree l r)) = max (depth1 l) (depth1 r)

我们的depth1总是会变慢，对GC造成不必要的负担。一个解决方案是使用hylomorphisms将创建和折叠树结合在一起。但通常我们不想这样做，我们可能希望在一个地方创建树，然后将其传递到其他地方以便稍后折叠。或者，用不同的catamorphisms多次折叠。

有没有办法让GHC优化depth1？类似于内联catam g，然后在内部fusing/deforesting g . fmap ...？

- Petr

---

我来晚了，但是在计算树的深度函数g（或depth2）的Tree情况中，应该有一个+1吧？否则，我看不出depth1或depth2除了零以外还能返回什么。 - Arek' Fu

另外，我认为depth1在depth2的定义中实际上应该是depth2。 - Arek' Fu

Answer 1

我相信我找到了答案。我记得阅读为什么GHC使得fix如此棘手？，并且那启示了我一个解决方案。

catam的先前定义的问题在于它是递归的，所以任何 INLINE 它的尝试都会被忽略。 使用 -ddump-simpl -ddump-to-file 编译原始版本并阅读 core：

Main.depth1 = Main.catam_$scatam @ GHC.Types.Int Main.depth3

Main.depth3 =
  \ (ds_dyI :: Main.TreeT GHC.Types.Int) ->
    case ds_dyI of _ {
      Main.Leaf -> Main.depth4;
      Main.Tree l_aah r_aai -> GHC.Classes.$fOrdInt_$cmax l_aah r_aai
    }

Main.depth4 = GHC.Types.I# 0

Rec {
Main.catam_$scatam =
  \ (@ a_ajB)
    (eta_B1 :: Main.TreeT a_ajB -> a_ajB)
    (eta1_X2 :: Main.Fix Main.TreeT) ->
    eta_B1
      (case eta1_X2
            `cast` (Main.NTCo:Fix <Main.TreeT>
                    :: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT))
       of _ {
         Main.Leaf -> Main.Leaf @ a_ajB;
         Main.Tree l_aan r_aao ->
           Main.Tree
             @ a_ajB
             (Main.catam_$scatam @ a_ajB eta_B1 l_aan)
             (Main.catam_$scatam @ a_ajB eta_B1 r_aao)
       })
end Rec }

相比之下，这明显更糟糕（在catam_$scatam中创建/消除构造函数，调用更多的函数）。

Main.depth2 =
  \ (w_s1Rz :: Main.Tree) ->
    case Main.$wdepth2 w_s1Rz of ww_s1RC { __DEFAULT ->
    GHC.Types.I# ww_s1RC
    }

Rec {
Main.$wdepth2 [Occ=LoopBreaker] :: Main.Tree -> GHC.Prim.Int#
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType S]
Main.$wdepth2 =
  \ (w_s1Rz :: Main.Tree) ->
    case w_s1Rz
         `cast` (Main.NTCo:Fix <Main.TreeT>
                 :: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT))
    of _ {
      Main.Leaf -> 0;
      Main.Tree l_aaj r_aak ->
        case Main.$wdepth2 l_aaj of ww_s1RC { __DEFAULT ->
        case Main.$wdepth2 r_aak of ww1_X1Sh { __DEFAULT ->
        case GHC.Prim.<=# ww_s1RC ww1_X1Sh of _ {
          GHC.Types.False -> ww_s1RC;
          GHC.Types.True -> ww1_X1Sh
        }
        }
        }
    }
end Rec }

但是如果我们将catam定义为

{-# INLINE catam #-}
catam :: (Functor f) => (f a -> a) -> (Fix f -> a)
catam f = let u = f . fmap u . unfix
          in u

然后它就不再是递归的了，只有内部的u是递归的。这样，GHC就会将catam内联到depth1的定义中，并将fmap与depth1的g合并 - 这正是我们想要的：

Main.depth1 =
  \ (w_s1RJ :: Main.Tree) ->
    case Main.$wdepth1 w_s1RJ of ww_s1RM { __DEFAULT ->
    GHC.Types.I# ww_s1RM
    }

Rec {
Main.$wdepth1 [Occ=LoopBreaker] :: Main.Tree -> GHC.Prim.Int#
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType S]
Main.$wdepth1 =
  \ (w_s1RJ :: Main.Tree) ->
    case w_s1RJ
         `cast` (Main.NTCo:Fix <Main.TreeT>
                 :: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT))
    of _ {
      Main.Leaf -> 0;
      Main.Tree l_aar r_aas ->
        case Main.$wdepth1 l_aar of ww_s1RM { __DEFAULT ->
        case Main.$wdepth1 r_aas of ww1_X1So { __DEFAULT ->
        case GHC.Prim.<=# ww_s1RM ww1_X1So of _ {
          GHC.Types.False -> ww_s1RM;
          GHC.Types.True -> ww1_X1So
        }
        }
        }
    }
end Rec }

现在，它只是与depth2的转储完全相同。

- Petr

---

似乎任何递归函数都可以通过将其主体移动到本地绑定（如上例中的 catam 函数）中来转换为非递归函数。这看起来是一个简单的步骤，有助于优化。我想知道为什么 GHC 不会自动执行它。 - Boris