我如何为 Free Monads 使用 Church 编码？
How do I use the Church encoding for Free Monads?
我一直在使用 free 包中 Control.Monad.Free 中的 Free 数据类型。现在我正在尝试将其转换为在 Control.Monad.Free.Church 中使用 F 但无法弄清楚如何映射函数。
例如，使用 Free 的简单模式匹配函数如下所示 -
-- Pattern match Free
matchFree
:: (a -> r)
-> (f (Free f a) -> r)
-> Free f a
-> r
matchFree kp _ (Pure a) = kp a
matchFree _ kf (Free f) = kf f
我可以通过转换 to/from Free -
轻松将其转换为使用 F 的函数
-- Pattern match F (using toF and fromF)
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = matchF' . fromF
where
matchF' (Pure a) = kp a
matchF' (Free f) = kf (fmap toF f)
但是我不知道如何在不使用 toF 和 fromF -
的情况下完成它
-- Pattern match F (without using toF)???
-- Doesn't compile
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf f = f kp kf
一定是我遗漏了一个通用模式。你能帮我弄清楚吗？
你的
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
看起来像 Scott 编码的 Free monad。 Church 编码版本只是
matchF
:: Functor f
=> (a -> r)
-> (f r -> r)
-> F f a
-> r
matchF kp kf f = runF f kp kf
以下是 Church 和 Scott 编码的列表以供比较：
newtype Church a = Church { runChurch :: forall r. (a -> r -> r) -> r -> r }
newtype Scott a = Scott { runScott :: forall r. (a -> Scott a -> r) -> r -> r }
有点讨厌。这个问题是每个人第一次接触时都会遇到的难题的更一般版本：定义编码为教会数字的自然数的前身（想想：Nat ~ Free Id ()）。
我已将我的模块分成许多中间定义以突出解决方案的结构。为了方便使用，我还上传了a self-contained gist。
我从没有什么令人兴奋的事情开始：重新定义 F 鉴于我目前没有安装此软件包。
{-# LANGUAGE Rank2Types #-}
module MatchFree where
newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }
现在，即使在考虑模式匹配之前，我们也可以从定义常用数据类型的构造函数的对应部分开始：
pureF :: a -> F f a
pureF a = F $ const . ($ a)
freeF :: Functor f => f (F f a) -> F f a
freeF f = F $ \ pr fr -> fr $ fmap (\ inner -> runF inner pr fr) f
接下来，我将介绍两种类型：Open和Close。 Close 只是 F 类型，但 Open 对应于观察到 F f a 元素的内容：它是 Either 纯 a 或一个 f (F f a).
type Open f a = Either a (f (F f a))
type Close f a = F f a
正如我手写的描述所暗示的那样，这两种类型实际上是等价的，我们确实可以编写在它们之间来回转换的函数：
close :: Functor f => Open f a -> Close f a
close = either pureF freeF
open :: Functor f => Close f a -> Open f a
open f = runF f Left (Right . fmap close)
现在，我们可以回到您的问题，操作过程应该非常清楚：open F f a 然后应用 kp 或 kf取决于我们得到了什么。它确实有效：
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = either kp kf . open
回到关于自然数的原始评论：使用 Church numeral 实现的前身在自然数的大小上是 线性，而我们可以合理地期望一个简单的案例分析是恒定时间。好吧，就像自然数一样，这种情况分析非常昂贵，因为正如在 open 的定义中使用 runF 所示，whole 结构被遍历。
让我来描述一个更简单的场景——列表的区别。让我们关注如何使用列表：
通过一个catamorphism，本质上就是我们可以用
来表达
foldr :: (a -> r -> r) -> r -> [a] -> r
正如我们所见，折叠函数永远不会获取列表尾部，只会获取其处理后的值。
通过模式匹配我们可以做更多的事情，特别是我们可以构造一个广义的折叠类型
foldrGen :: (a -> [a] -> r) -> r -> [a] -> r
很容易看出可以用foldrGen表示foldr。但是，由于 foldrGen 不是递归的，因此该表达式涉及递归。
为了概括这两个概念，我们可以引入
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r
这给了消费函数更多的力量：尾巴的减少值，以及尾巴本身。显然，这比之前的两个更通用。这对应于一个 paramorphism，它“吃掉它的参数并保留它”。
但反过来也可以。尽管同态更通用，但它们可以通过 re-creating 原始结构在途中使用变质（以一些开销成本）表示：
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r
foldrPara f z = snd . foldr f' ([], z)
where
f' x t@(xs, r) = (x : xs, f x t)
现在 Church-encoded 数据结构编码变形模式，对于列表，它是可以使用 foldr:
构造的所有内容
newtype List a = L (forall r . r -> (a -> r -> r) -> r)
nil :: List a
nil = L $ \n _ -> n
cons :: a -> List a -> List a
cons x (L xs) = L $ \n c -> c x (xs n c)
fromL :: List a -> [a]
fromL (L f) = f [] (:)
toL :: [a] -> List a
toL xs = L (\n c -> foldr c n xs)
为了看到sub-lists，我们采取了同样的方法：re-create他们在路上：
foldrParaL :: (a -> (List a, r) -> r) -> r -> List a -> r
foldrParaL f z (L l) = snd $ l (nil, z) f'
where
f' x t@(xs, r) = (x `cons` xs, f x t)
这通常适用于 Church-encoded 数据结构，例如编码的自由 monad。它们表示变质，即在看不到结构的各个部分的情况下进行折叠，只有递归结果。为了在这个过程中掌握sub-structures，我们需要在途中重新创建它们。
您要求 "general pattern you are missing"。让我自己尝试解释一下，尽管 Petr Pudlák 的回答也很不错。正如 user3237465 所说，我们可以使用两种编码，Church 和 Scott，而您使用的是 Scott 而不是 Church。所以这里是一般评论。
编码的工作原理
通过继续传递，我们可以用
类型的一些独特函数来描述x类型的任何值
data Identity x = Id { runId :: x }
{- ~ - equivalent to - ~ -}
newtype IdentityFn x = IdFn { runIdFn :: forall z. (x -> z) -> z }
这里的"forall"很重要，它说这个类型留下z作为一个未指定的参数。双射是 Id . ($ id) . runIdFn 从 IdentityFn 到 Identity 而 IdFn . flip ($) . runId 则相反。等价性的出现是因为基本上没有人可以用类型 forall z. z 做任何事情，没有任何操作是足够通用的。我们可以等价的说newtype UnitFn = UnitFn { runUnitFn :: forall z. z -> z }只有一个元素，即UnitFn id，也就是说它对应的单位类型data Unit = Unit类似。
现在，(x, y) -> z 与 x -> y -> z 同构的柯里化观察只是连续传递冰山的一角，它允许我们用纯函数表示数据结构，没有数据结构，因为显然 Identity (x, y) 类型等同于 forall z. (x -> y -> z) -> z。所以 "gluing" 两个项目一起创建这个类型的值是一样的，它只是使用纯函数作为 "glue".
要看到这种等价性，我们只需处理另外两个属性。
首先是和型构造函数，形式为Either x y -> z。看，Either x y -> z 同构于
newtype EitherFn x y = EitherFn { runEitherFn :: forall z. (x -> z) -> (y -> z) -> z }
从中我们得到了模式的基本思想：
- 取一个没有出现在表达式主体中的新类型变量
z。
- 对于数据类型的每个构造函数，创建一个将其所有类型参数作为参数的函数类型，以及returns一个
z。调用这些 "handlers" 对应的构造函数。所以 (x, y) 的处理程序是 (x, y) -> z，我们柯里化到 x -> y -> z，Left x | Right y 的处理程序是 x -> z 和 y -> z。如果没有参数，你可以只取一个值 z 作为你的函数，而不是更麻烦的 () -> z。
- 将所有这些处理程序作为表达式的参数
forall z. Handler1 -> Handler2 -> ... -> HandlerN -> z。
- 一半的同构基本上只是将构造函数作为所需的处理程序提交；另一个模式匹配构造函数并应用相应的处理程序。
细微的遗漏
同样，将这些规则应用到各种事情上也很有趣；例如，正如我上面提到的，如果你将它应用于 data Unit = Unit，你会发现任何单位类型都是恒等函数 forall z. z -> z，如果你将它应用于 data Bool = False | True，你会发现逻辑函数 forall z. z -> z -> z 其中 false = const 而 true = const id。但是，如果您确实玩过它，您会发现仍然缺少某些东西。提示：如果我们看
data List x = Nil | Cons x (List x)
我们看到模式应该是这样的：
data ListFn x = ListFn { runListFn :: forall z. z -> (x -> ??? -> z) -> z }
对于一些 ???。上述规则并没有确定那里的内容。
有两个不错的选择：要么我们充分利用 newtype 的力量将 ListFn x 放在那里（"Scott" 编码），要么我们可以先发制人地减少它使用我们已经给出的函数，在这种情况下它变成了 z 使用我们已经拥有的函数（"Church" 编码）。现在，由于已经预先为我们执行了递归，Church 编码仅完全等同于 finite 数据结构； Scott 编码可以处理无限列表等。也很难理解如何以 Church 形式对相互递归进行编码，而 Scott 形式通常更简单一些。
无论如何，Church 编码有点难想，但更神奇，因为我们可以一厢情愿地接近它："assume that this z is already whatever you're trying to accomplish with tail list, then combine it with head list in the appropriate way."而这种一厢情愿的想法正是人们难以理解的原因foldr，因为这个双射的一侧恰好是列表的 foldr。
还有一些其他的问题，比如"what if, like Int or Integer, the number of constructors is big or infinite?"。这个特定问题的答案是使用函数
data IntFn = IntFn { runIntFn :: forall z. (z -> z) -> z -> z }
你问这是什么？好吧，一个聪明人 (Church) 发现这是一种将整数表示为组合重复的方法：
zero f x = x
one f x = f x
two f x = f (f x)
{- ~ - increment an `n` to `n + 1` - ~ -}
succ n f = f . n f
其实这个帐号m . n是两者的乘积。但我提到这一点是因为插入一个 () 并翻转参数并发现这实际上是 forall z. z -> (() -> z -> z) -> z 并不难，它是列表类型 [()]，其值由 length 加法由 ++ 给出，乘法由 >> 给出。
为了提高效率，您可以对 data PosNeg x = Neg x | Zero | Pos x 进行 Church 编码并使用 [Bool] 的 Church 编码（保持有限！）来形成 PosNeg [Bool] 的 Church 编码，其中每个 [Bool] 隐含地以一个未声明的 True 结尾，在其最后的最高有效位，因此 [Bool] 表示从 +1 到无穷大的数字。
扩展示例：BinLeaf / BL
另一个重要的例子，我们可能会想到二叉树，它在叶子中存储所有信息，但也在内部节点上包含注释：data BinLeaf a x = Leaf x | Bin a (BinLeaf a x) (BinLeaf a x)。按照 Church 编码的方法，我们这样做：
newtype BL a x = BL { runBL :: forall z. (x -> z) -> (a -> z -> z -> z) -> z}
现在我们构造小写实例而不是 Bin "Hello" (Leaf 3) (Bin "What's up?" (Leaf 4) (Leaf 5)：
BL $ \leaf bin -> bin "Hello" (leaf 3) (bin "What's up?" (leaf 4) (leaf 5)
因此，同构是非常简单的一种方式：binleafFromBL f = runBL f Leaf Bin。对方有case dispatch，不过还不错
递归数据的递归算法呢？这就是它变得神奇的地方：Church 编码的 foldr 和 runBL 都有 运行 在我们到达树本身之前我们的功能在子树上。例如，假设我们要模拟这个函数：
sumAnnotate :: (Num n) => BinLeaf a n -> BinLeaf (n, a) n
sumAnnotate (Leaf n) = Leaf n
sumAnnotate (Bin a x y) = Bin (getn x' + getn y', a) x' y'
where x' = sumAnnotate x
y' = sumAnnotate y
getn (Leaf n) = n
getn (Bin (n, _) _ _) = n
我们要做什么？
-- pseudo-constructors for BL a x.
makeLeaf :: x -> BL a x
makeLeaf x = BL $ \leaf _ -> leaf x
makeBin :: a -> BL a x -> BL a x -> BL a x
makeBin a l r = BL $ \leaf bin -> bin a (runBL l leaf bin) (runBL r leaf bin)
-- actual function
sumAnnotate' :: (Num n) => BL a n -> BL n n
sumAnnotate' f = runBL f makeLeaf (\a x y -> makeBin (getn x + getn y, a) x y) where
getn t = runBL t id (\n _ _ -> n)
我们传入一个函数\a x y -> ... :: (Num n) => a -> BL (n, a) n -> BL (n, a) n -> BL (n, a) n。请注意，两个 "arguments" 与此处的 "output" 属于同一类型。使用 Church 编码，我们必须像已经成功一样进行编程 -- 一个叫做 "wishful thinking".
的学科
Free monad 的 Church 编码
Free monad 具有范式
data Free f x = Pure x | Roll f (Free f x)
我们的 Church 编码程序说这变成了：
newtype Fr f x = Fr {runFr :: forall z. (x -> z) -> (f z -> z) -> z}
你的函数
matchFree p _ (Pure x) = p x
matchFree _ f (Free x) = f x
变得简单
matchFree' p f fr = runFr fr p f
我一直在使用 free 包中 Control.Monad.Free 中的 Free 数据类型。现在我正在尝试将其转换为在 Control.Monad.Free.Church 中使用 F 但无法弄清楚如何映射函数。
例如，使用 Free 的简单模式匹配函数如下所示 -
-- Pattern match Free
matchFree
:: (a -> r)
-> (f (Free f a) -> r)
-> Free f a
-> r
matchFree kp _ (Pure a) = kp a
matchFree _ kf (Free f) = kf f
我可以通过转换 to/from Free -
F 的函数
-- Pattern match F (using toF and fromF)
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = matchF' . fromF
where
matchF' (Pure a) = kp a
matchF' (Free f) = kf (fmap toF f)
但是我不知道如何在不使用 toF 和 fromF -
-- Pattern match F (without using toF)???
-- Doesn't compile
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf f = f kp kf
一定是我遗漏了一个通用模式。你能帮我弄清楚吗？
你的
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
看起来像 Scott 编码的 Free monad。 Church 编码版本只是
matchF
:: Functor f
=> (a -> r)
-> (f r -> r)
-> F f a
-> r
matchF kp kf f = runF f kp kf
以下是 Church 和 Scott 编码的列表以供比较：
newtype Church a = Church { runChurch :: forall r. (a -> r -> r) -> r -> r }
newtype Scott a = Scott { runScott :: forall r. (a -> Scott a -> r) -> r -> r }
有点讨厌。这个问题是每个人第一次接触时都会遇到的难题的更一般版本：定义编码为教会数字的自然数的前身（想想：Nat ~ Free Id ()）。
我已将我的模块分成许多中间定义以突出解决方案的结构。为了方便使用，我还上传了a self-contained gist。
我从没有什么令人兴奋的事情开始：重新定义 F 鉴于我目前没有安装此软件包。
{-# LANGUAGE Rank2Types #-}
module MatchFree where
newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }
现在，即使在考虑模式匹配之前，我们也可以从定义常用数据类型的构造函数的对应部分开始：
pureF :: a -> F f a
pureF a = F $ const . ($ a)
freeF :: Functor f => f (F f a) -> F f a
freeF f = F $ \ pr fr -> fr $ fmap (\ inner -> runF inner pr fr) f
接下来，我将介绍两种类型：Open和Close。 Close 只是 F 类型，但 Open 对应于观察到 F f a 元素的内容：它是 Either 纯 a 或一个 f (F f a).
type Open f a = Either a (f (F f a))
type Close f a = F f a
正如我手写的描述所暗示的那样，这两种类型实际上是等价的，我们确实可以编写在它们之间来回转换的函数：
close :: Functor f => Open f a -> Close f a
close = either pureF freeF
open :: Functor f => Close f a -> Open f a
open f = runF f Left (Right . fmap close)
现在，我们可以回到您的问题，操作过程应该非常清楚：open F f a 然后应用 kp 或 kf取决于我们得到了什么。它确实有效：
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = either kp kf . open
回到关于自然数的原始评论：使用 Church numeral 实现的前身在自然数的大小上是 线性，而我们可以合理地期望一个简单的案例分析是恒定时间。好吧，就像自然数一样，这种情况分析非常昂贵，因为正如在 open 的定义中使用 runF 所示，whole 结构被遍历。
让我来描述一个更简单的场景——列表的区别。让我们关注如何使用列表：
通过一个catamorphism，本质上就是我们可以用
来表达foldr :: (a -> r -> r) -> r -> [a] -> r正如我们所见，折叠函数永远不会获取列表尾部，只会获取其处理后的值。
通过模式匹配我们可以做更多的事情，特别是我们可以构造一个广义的折叠类型
foldrGen :: (a -> [a] -> r) -> r -> [a] -> r很容易看出可以用
foldrGen表示foldr。但是，由于foldrGen不是递归的，因此该表达式涉及递归。为了概括这两个概念，我们可以引入
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r这给了消费函数更多的力量：尾巴的减少值，以及尾巴本身。显然，这比之前的两个更通用。这对应于一个 paramorphism，它“吃掉它的参数并保留它”。
但反过来也可以。尽管同态更通用，但它们可以通过 re-creating 原始结构在途中使用变质（以一些开销成本）表示：
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r
foldrPara f z = snd . foldr f' ([], z)
where
f' x t@(xs, r) = (x : xs, f x t)
现在 Church-encoded 数据结构编码变形模式，对于列表，它是可以使用 foldr:
newtype List a = L (forall r . r -> (a -> r -> r) -> r)
nil :: List a
nil = L $ \n _ -> n
cons :: a -> List a -> List a
cons x (L xs) = L $ \n c -> c x (xs n c)
fromL :: List a -> [a]
fromL (L f) = f [] (:)
toL :: [a] -> List a
toL xs = L (\n c -> foldr c n xs)
为了看到sub-lists，我们采取了同样的方法：re-create他们在路上：
foldrParaL :: (a -> (List a, r) -> r) -> r -> List a -> r
foldrParaL f z (L l) = snd $ l (nil, z) f'
where
f' x t@(xs, r) = (x `cons` xs, f x t)
这通常适用于 Church-encoded 数据结构，例如编码的自由 monad。它们表示变质，即在看不到结构的各个部分的情况下进行折叠，只有递归结果。为了在这个过程中掌握sub-structures，我们需要在途中重新创建它们。
您要求 "general pattern you are missing"。让我自己尝试解释一下，尽管 Petr Pudlák 的回答也很不错。正如 user3237465 所说，我们可以使用两种编码，Church 和 Scott，而您使用的是 Scott 而不是 Church。所以这里是一般评论。
编码的工作原理
通过继续传递，我们可以用
类型的一些独特函数来描述x类型的任何值
data Identity x = Id { runId :: x }
{- ~ - equivalent to - ~ -}
newtype IdentityFn x = IdFn { runIdFn :: forall z. (x -> z) -> z }
这里的"forall"很重要，它说这个类型留下z作为一个未指定的参数。双射是 Id . ($ id) . runIdFn 从 IdentityFn 到 Identity 而 IdFn . flip ($) . runId 则相反。等价性的出现是因为基本上没有人可以用类型 forall z. z 做任何事情，没有任何操作是足够通用的。我们可以等价的说newtype UnitFn = UnitFn { runUnitFn :: forall z. z -> z }只有一个元素，即UnitFn id，也就是说它对应的单位类型data Unit = Unit类似。
现在，(x, y) -> z 与 x -> y -> z 同构的柯里化观察只是连续传递冰山的一角，它允许我们用纯函数表示数据结构，没有数据结构，因为显然 Identity (x, y) 类型等同于 forall z. (x -> y -> z) -> z。所以 "gluing" 两个项目一起创建这个类型的值是一样的，它只是使用纯函数作为 "glue".
要看到这种等价性，我们只需处理另外两个属性。
首先是和型构造函数，形式为Either x y -> z。看，Either x y -> z 同构于
newtype EitherFn x y = EitherFn { runEitherFn :: forall z. (x -> z) -> (y -> z) -> z }
从中我们得到了模式的基本思想：
- 取一个没有出现在表达式主体中的新类型变量
z。 - 对于数据类型的每个构造函数，创建一个将其所有类型参数作为参数的函数类型，以及returns一个
z。调用这些 "handlers" 对应的构造函数。所以(x, y)的处理程序是(x, y) -> z，我们柯里化到x -> y -> z，Left x | Right y的处理程序是x -> z和y -> z。如果没有参数，你可以只取一个值z作为你的函数，而不是更麻烦的() -> z。 - 将所有这些处理程序作为表达式的参数
forall z. Handler1 -> Handler2 -> ... -> HandlerN -> z。 - 一半的同构基本上只是将构造函数作为所需的处理程序提交；另一个模式匹配构造函数并应用相应的处理程序。
细微的遗漏
同样，将这些规则应用到各种事情上也很有趣；例如，正如我上面提到的，如果你将它应用于 data Unit = Unit，你会发现任何单位类型都是恒等函数 forall z. z -> z，如果你将它应用于 data Bool = False | True，你会发现逻辑函数 forall z. z -> z -> z 其中 false = const 而 true = const id。但是，如果您确实玩过它，您会发现仍然缺少某些东西。提示：如果我们看
data List x = Nil | Cons x (List x)
我们看到模式应该是这样的：
data ListFn x = ListFn { runListFn :: forall z. z -> (x -> ??? -> z) -> z }
对于一些 ???。上述规则并没有确定那里的内容。
有两个不错的选择：要么我们充分利用 newtype 的力量将 ListFn x 放在那里（"Scott" 编码），要么我们可以先发制人地减少它使用我们已经给出的函数，在这种情况下它变成了 z 使用我们已经拥有的函数（"Church" 编码）。现在，由于已经预先为我们执行了递归，Church 编码仅完全等同于 finite 数据结构； Scott 编码可以处理无限列表等。也很难理解如何以 Church 形式对相互递归进行编码，而 Scott 形式通常更简单一些。
无论如何，Church 编码有点难想，但更神奇，因为我们可以一厢情愿地接近它："assume that this z is already whatever you're trying to accomplish with tail list, then combine it with head list in the appropriate way."而这种一厢情愿的想法正是人们难以理解的原因foldr，因为这个双射的一侧恰好是列表的 foldr。
还有一些其他的问题，比如"what if, like Int or Integer, the number of constructors is big or infinite?"。这个特定问题的答案是使用函数
data IntFn = IntFn { runIntFn :: forall z. (z -> z) -> z -> z }
你问这是什么？好吧，一个聪明人 (Church) 发现这是一种将整数表示为组合重复的方法：
zero f x = x
one f x = f x
two f x = f (f x)
{- ~ - increment an `n` to `n + 1` - ~ -}
succ n f = f . n f
其实这个帐号m . n是两者的乘积。但我提到这一点是因为插入一个 () 并翻转参数并发现这实际上是 forall z. z -> (() -> z -> z) -> z 并不难，它是列表类型 [()]，其值由 length 加法由 ++ 给出，乘法由 >> 给出。
为了提高效率，您可以对 data PosNeg x = Neg x | Zero | Pos x 进行 Church 编码并使用 [Bool] 的 Church 编码（保持有限！）来形成 PosNeg [Bool] 的 Church 编码，其中每个 [Bool] 隐含地以一个未声明的 True 结尾，在其最后的最高有效位，因此 [Bool] 表示从 +1 到无穷大的数字。
扩展示例：BinLeaf / BL
另一个重要的例子，我们可能会想到二叉树，它在叶子中存储所有信息，但也在内部节点上包含注释：data BinLeaf a x = Leaf x | Bin a (BinLeaf a x) (BinLeaf a x)。按照 Church 编码的方法，我们这样做：
newtype BL a x = BL { runBL :: forall z. (x -> z) -> (a -> z -> z -> z) -> z}
现在我们构造小写实例而不是 Bin "Hello" (Leaf 3) (Bin "What's up?" (Leaf 4) (Leaf 5)：
BL $ \leaf bin -> bin "Hello" (leaf 3) (bin "What's up?" (leaf 4) (leaf 5)
因此，同构是非常简单的一种方式：binleafFromBL f = runBL f Leaf Bin。对方有case dispatch，不过还不错
递归数据的递归算法呢？这就是它变得神奇的地方：Church 编码的 foldr 和 runBL 都有 运行 在我们到达树本身之前我们的功能在子树上。例如，假设我们要模拟这个函数：
sumAnnotate :: (Num n) => BinLeaf a n -> BinLeaf (n, a) n
sumAnnotate (Leaf n) = Leaf n
sumAnnotate (Bin a x y) = Bin (getn x' + getn y', a) x' y'
where x' = sumAnnotate x
y' = sumAnnotate y
getn (Leaf n) = n
getn (Bin (n, _) _ _) = n
我们要做什么？
-- pseudo-constructors for BL a x.
makeLeaf :: x -> BL a x
makeLeaf x = BL $ \leaf _ -> leaf x
makeBin :: a -> BL a x -> BL a x -> BL a x
makeBin a l r = BL $ \leaf bin -> bin a (runBL l leaf bin) (runBL r leaf bin)
-- actual function
sumAnnotate' :: (Num n) => BL a n -> BL n n
sumAnnotate' f = runBL f makeLeaf (\a x y -> makeBin (getn x + getn y, a) x y) where
getn t = runBL t id (\n _ _ -> n)
我们传入一个函数\a x y -> ... :: (Num n) => a -> BL (n, a) n -> BL (n, a) n -> BL (n, a) n。请注意，两个 "arguments" 与此处的 "output" 属于同一类型。使用 Church 编码，我们必须像已经成功一样进行编程 -- 一个叫做 "wishful thinking".
Free monad 的 Church 编码
Free monad 具有范式
data Free f x = Pure x | Roll f (Free f x)
我们的 Church 编码程序说这变成了：
newtype Fr f x = Fr {runFr :: forall z. (x -> z) -> (f z -> z) -> z}
你的函数
matchFree p _ (Pure x) = p x
matchFree _ f (Free x) = f x
变得简单
matchFree' p f fr = runFr fr p f