Haskell/继续传递风格
继续传递风格（简称 CPS）是一种编程风格，其中函数不返回值；相反，它们将控制权传递给一个延续，它指定接下来会发生什么。在本章中，我们将讨论它如何在 Haskell 中发挥作用，特别是如何用单子表达 CPS。
为了消除困惑，我们将再次回顾本书中早期的示例，当我们介绍 ($) 运算符时
> map ($ 2) [(2*), (4*), (8*)] [4,8,16]
上面的表达式没有什么不寻常之处，除了写成这样而不是 map (*2) [2, 4, 8] 有点奇怪。($) 部分使代码看起来反向，就好像我们正在将值应用于函数，而不是相反。现在，重点来了：这种看起来无害的颠倒其实是继续传递风格的本质！
从 CPS 的角度来看，($ 2) 是一个挂起的计算：一个具有通用类型 (a -> r) -> r 的函数，它接收另一个函数作为参数，并产生最终结果。a -> r 参数是延续；它指定了计算将如何结束。在本例中，列表中的函数通过 map 作为延续提供，产生三个不同的结果。请注意，挂起的计算在很大程度上可以与普通值互换：flip ($) [1] 将任何值转换为挂起的计算，并将 id 作为其延续传递会返回原始值。
延续不仅仅是用来给 Haskell 新手留下深刻印象的把戏。它们使我们能够显式地操作，并戏剧性地改变程序的控制流程。例如，可以使用延续从过程提前返回。异常和失败也可以使用延续来处理——传入一个成功延续，另一个失败延续，并调用适当的延续。其他可能性包括“挂起”计算并稍后再返回，以及实现简单的并发形式（值得注意的是，一个 Haskell 实现 Hugs 使用延续来实现协作并发）。
在 Haskell 中，延续可以用类似的方式，在单子中实现有趣的控制流。请注意，通常有针对这些用例的替代技术，尤其是在与惰性结合使用时。在某些情况下，CPS 可以通过消除某些构造-模式匹配序列（即函数返回一个复杂结构，调用者将在某个时候对其进行解构）来提高性能，尽管一个足够智能的编译器应该能够执行消除 [2]。
利用延续的一个基本方法是修改我们的函数，使它们返回挂起的计算而不是普通值。我们将通过两个简单的示例来说明如何做到这一点。
示例：一个简单的模块，没有延续
-- We assume some primitives add and square for the example:
add :: Int -> Int -> Int
add x y = x + y
square :: Int -> Int
square x = x * x
pythagoras :: Int -> Int -> Int
pythagoras x y = add (square x) (square y)
修改为返回挂起的计算，pythagoras 看起来像这样
示例：一个简单的模块，使用延续
-- We assume CPS versions of the add and square primitives,
-- (note: the actual definitions of add_cps and square_cps are not
-- in CPS form, they just have the correct type)
add_cps :: Int -> Int -> ((Int -> r) -> r)
add_cps x y = \k -> k (add x y)
square_cps :: Int -> ((Int -> r) -> r)
square_cps x = \k -> k (square x)
pythagoras_cps :: Int -> Int -> ((Int -> r) -> r)
pythagoras_cps x y = \k ->
square_cps x $ \x_squared ->
square_cps y $ \y_squared ->
add_cps x_squared y_squared $ k
pythagoras_cps 示例是如何工作的
- 对 x 平方并将结果抛入 (\x_squared -> ...) 延续
- 对 y 平方并将结果抛入 (\y_squared -> ...) 延续
- 将 x_squared 和 y_squared 相加并将结果抛入顶级/程序延续
k。
我们可以通过将 print 作为程序延续在 GHCi 中尝试它
*Main> pythagoras_cps 3 4 print 25
如果我们查看 pythagoras_cps 的类型，没有可选的括号围绕 (Int -> r) -> r，并将它与 pythagoras 的原始类型进行比较，我们会注意到延续实际上是作为额外参数添加的，从而证明了“继续传递风格”的名称。
示例： 一个简单的更高阶函数，没有延续
thrice :: (a -> a) -> a -> a
thrice f x = f (f (f x))
*Main> thrice tail "foobar" "bar"
一个更高阶函数，比如 thrice，在转换为 CPS 后，也会接收以 CPS 形式存在的函数作为参数。因此，f :: a -> a 会变成 f_cps :: a -> ((a -> r) -> r)，最终类型会是 thrice_cps :: (a -> ((a -> r) -> r)) -> a -> ((a -> r) -> r)。定义的其余部分自然而然地遵循类型 - 我们将 f 替换为 CPS 版本，并将当前延续传递给它。
示例： 一个简单的更高阶函数，使用延续
thrice_cps :: (a -> ((a -> r) -> r)) -> a -> ((a -> r) -> r)
thrice_cps f_cps x = \k ->
f_cps x $ \fx ->
f_cps fx $ \ffx ->
f_cps ffx $ k
有了延续传递函数，下一步就是提供一种整洁的方式来组合它们，最好是不用我们上面看到的长长的嵌套 lambda 链。一个好的开始是使用一个组合子将 CPS 函数应用于一个挂起的计算。它可能会有以下类型
chainCPS :: ((a -> r) -> r) -> (a -> ((b -> r) -> r)) -> ((b -> r) -> r)
(你可能想在继续阅读之前尝试实现它。提示：从声明结果是一个接受 b -> r 延续的函数开始；然后，让类型来指导你。)
以下是实现代码
chainCPS s f = \k -> s $ \x -> f x $ k
我们为原始的挂起计算 s 提供了一个延续，这个延续会创建一个新的挂起计算（由 f 生成）并将最终延续 k 传递给它。不出所料，它与前面示例中嵌套 lambda 模式非常相似。
chainCPS 的类型看起来是不是很熟悉？如果我们用 (Monad m) => m a 替换 (a -> r) -> r，用 (Monad m) => m b 替换 (b -> r) -> r，就会得到 (>>=) 的签名。此外，我们老朋友 flip ($) 在某种程度上扮演着 return 的角色，因为它能以一种平凡的方式将一个值变成一个挂起的计算。瞧，我们得到了一个函子！现在我们唯一需要的是 [3]一个 Cont r a 类型来包装挂起的计算，以及常用的包装和解包函数。
cont :: ((a -> r) -> r) -> Cont r a
runCont :: Cont r a -> (a -> r) -> r
Cont 的函子实例直接源于我们的描述，唯一的区别是包装和解包的代码
instance Monad (Cont r) where
return x = cont ($ x)
s >>= f = cont $ \c -> runCont s $ \x -> runCont (f x) c
最终结果是，函子实例使延续传递（以及 lambda 链）隐式化。函子绑定将 CPS 函数应用于一个挂起的计算，而 runCont 用于提供最终的延续。举个简单的例子，勾股定理示例变成了
示例： 使用 Cont 函子的 pythagoras 示例
-- Using the Cont monad from the transformers package.
import Control.Monad.Trans.Cont
add_cont :: Int -> Int -> Cont r Int
add_cont x y = return (add x y)
square_cont :: Int -> Cont r Int
square_cont x = return (square x)
pythagoras_cont :: Int -> Int -> Cont r Int
pythagoras_cont x y = do
x_squared <- square_cont x
y_squared <- square_cont y
add_cont x_squared y_squared
虽然看到一个函子自然而然地出现总是令人愉悦，但可能还是会有点失望。CPS 的承诺之一是通过延续精确地控制流程操作。然而，在将函数转换为 CPS 后，我们立即将延续隐藏在函子后面。为了纠正这一点，我们将介绍 callCC，一个让我们能够明确控制延续的函数——但只在我们想要的地方。
callCC 是一个非常特殊的函数；最好用例子来介绍。让我们从一个简单的例子开始
示例： 使用 callCC 的 square
-- Without callCC
square :: Int -> Cont r Int
square n = return (n ^ 2)
-- With callCC
squareCCC :: Int -> Cont r Int
squareCCC n = callCC $ \k -> k (n ^ 2)
传递给 callCC 的参数是一个函数，它的结果是一个挂起的计算（通用类型 Cont r a），我们将它称为“callCC 计算”。原则上，callCC 计算就是整个 callCC 表达式求值的结果。需要注意的是，也是使 callCC 如此特殊的原因是由于 k，它是参数的另一个参数。它是一个函数，充当一个弹出按钮：在任何地方调用它都会导致传递给它的值变成一个挂起的计算，然后这个计算会被插入到调用 callCC 的位置的控制流程中。这是无条件发生的；特别是，callCC 计算中调用 k 之后的所有内容都会被立即丢弃。从另一个角度来看，k 会捕获调用 callCC 之后的所有剩余计算；调用它会将一个值抛到那个特定点（“callCC” 代表“调用当前延续”）的延续中。虽然在这个简单的例子中，效果仅仅是像一个普通的 return 一样，但 callCC 开启了许多可能性，我们现在将要探索。
callCC 使我们能够对抛到延续中的内容以及何时抛出这些内容具有额外的控制权。以下示例开始展示如何使用这种额外的控制权。
示例： 我们第一个真正的 callCC 函数
foo :: Int -> Cont r String
foo x = callCC $ \k -> do
let y = x ^ 2 + 3
when (y > 20) $ k "over twenty"
return (show $ y - 4)
foo 是一个稍微病态的函数，它计算输入的平方并加 3；如果这个计算的结果大于 20，那么我们会立即从 callCC 计算（以及在这种情况下，从整个函数）中返回，并将字符串 "over twenty" 抛到传递给 foo 的延续中。如果不是这样，那么我们就会从之前的计算结果中减去 4，将它 show 出来，并把它抛到延续中。值得注意的是，这里的 k 的使用方式就像一个命令式语言中的 'return'语句一样，会立即退出函数。然而，由于这是 Haskell，所以 k 只是一个普通的头等函数，因此你可以将它传递给其他函数，比如 when，将其存储在一个 Reader 中，等等。
当然，你可以在 do 块中嵌入对 callCC 的调用
示例： 涉及 do 块的更复杂的 callCC 示例
bar :: Char -> String -> Cont r Int
bar c s = do
msg <- callCC $ \k -> do
let s0 = c : s
when (s0 == "hello") $ k "They say hello."
let s1 = show s0
return ("They appear to be saying " ++ s1)
return (length msg)
当你用一个值调用 k 时，整个 callCC 调用会接收这个值。实际上，这使得 k 非常像其他语言中的 'goto' 语句：当我们在示例中调用 k 时，它会将执行弹出到第一次调用 callCC 的地方，也就是 msg <- callCC $ ... 行。不会再执行 callCC 的参数（内部 do 块）。因此，以下示例包含了一行无用的代码
示例： 弹出函数，引入一行无用的代码
quux :: Cont r Int
quux = callCC $ \k -> do
let n = 5
k n
return 25
quux 会返回 5，而不是 25，因为我们在到达 return 25 行之前就弹出了 quux。
我们在这里有意打破了一个趋势：通常情况下，当我们介绍一个函数时，我们会直接给出它的类型，但这次我们没有这样做。原因很简单：类型很复杂，它并不能立即让我们了解函数的功能或工作原理。然而，在最初介绍 callCC 之后，我们现在可以更好地理解它。深吸一口气...
callCC :: ((a -> Cont r b) -> Cont r a) -> Cont r a
我们可以根据我们已经了解的 callCC 的知识来理解它。整体结果类型和参数的结果类型必须相同（即 Cont r a），因为在没有调用 k 的情况下，对应的结果值是相同的。那么，k 的类型呢？如上所述，k 的参数会被变成一个挂起的计算，并在调用 callCC 的位置被插入；因此，如果后者类型为 Cont r a，那么 k 的参数类型必须为 a。至于 k 的结果类型，有趣的是，只要它被包装在相同的 Cont r 函子中，它实际上并不重要；换句话说，b 代表一个任意类型。这是因为，由 a 参数生成的挂起计算会接收调用 callCC 之后的所有延续，因此 k 的结果接收的延续无关紧要。
注意
k 的结果类型的任意性解释了为什么以下无用代码示例的变体会导致类型错误
quux :: Cont r Int
quux = callCC $ \k -> do
let n = 5
when True $ k n
k 25
k 的结果类型可以是任何形式为 Cont r b 的类型；但是，when 将其限制为 Cont r ()，因此最后的 k 25 与 quux 的结果类型不匹配。解决方案非常简单：将最后的 k 替换为一个普通的 return。
为了结束这一节，以下是 callCC 的实现代码。你能在其中识别出 k 吗？
callCC f = cont $ \h -> runCont (f (\a -> cont $ \_ -> h a)) h
尽管代码并不明显，但一个令人惊奇的事实是，Cont 的 callCC、return 和 (>>=) 的实现可以从它们的类型签名中自动生成 - Lennart Augustsson 的 Djinn [1] 是一个可以为你完成此操作的程序。有关 Djinn 背后理论的背景信息，请参阅 Phil Gossett 的 Google 技术讲座：[2]；以及 Dan Piponi 的文章：[3]，其中使用了 Djinn 来推导出继续传递风格。
现在我们将看看控制流操作的一些更现实的例子。第一个示例，如下所示，最初取自 所有关于单子教程 的“继续单子”部分，经许可使用。
示例：使用 Cont 实现复杂的控制结构
{- We use the continuation monad to perform "escapes" from code blocks.
This function implements a complicated control structure to process
numbers:
Input (n) Output List Shown
========= ====== ==========
0-9 n none
10-199 number of digits in (n/2) digits of (n/2)
200-19999 n digits of (n/2)
20000-1999999 (n/2) backwards none
>= 2000000 sum of digits of (n/2) digits of (n/2)
-}
fun :: Int -> String
fun n = (`runCont` id) $ do
str <- callCC $ \exit1 -> do -- define "exit1"
when (n < 10) (exit1 (show n))
let ns = map digitToInt (show (n `div` 2))
n' <- callCC $ \exit2 -> do -- define "exit2"
when ((length ns) < 3) (exit2 (length ns))
when ((length ns) < 5) (exit2 n)
when ((length ns) < 7) $ do
let ns' = map intToDigit (reverse ns)
exit1 (dropWhile (=='0') ns') --escape 2 levels
return $ sum ns
return $ "(ns = " ++ (show ns) ++ ") " ++ (show n')
return $ "Answer: " ++ str
fun 是一个接受整数 n 的函数。该实现使用 Cont 和 callCC 来设置一个使用 Cont 和 callCC 的控制结构，根据 n 所处的范围执行不同的操作，如顶部的注释所示。让我们来分析一下它。
- 首先，顶部的
(`runCont` id)只是意味着我们使用id的最终继续执行后面的Cont块（或者换句话说，我们从挂起的计算中提取值而不做任何修改）。这是必需的，因为fun的结果类型没有提到Cont。 - 我们将
str绑定到以下callCCdo-block 的结果。- 如果
n小于 10，我们立即退出，只显示n。 - 否则，我们继续执行。我们构建一个列表
ns，其中包含n `div` 2的数字。 n'（一个Int）绑定到以下内部callCCdo-block 的结果。- 如果
length ns < 3，即如果n `div` 2的数字少于 3 位，我们从这个内部 do-block 中弹出，结果为数字位数。 - 如果
n `div` 2的数字少于 5 位，我们从内部 do-block 中弹出，返回原始的n。 - 如果
n `div` 2的数字少于 7 位，我们从内部和外部的 do-block 中弹出，结果为n `div` 2的数字的反向顺序（一个String）。 - 否则，我们结束内部 do-block，返回
n `div` 2的数字之和。
- 如果
- 我们结束这个 do-block，返回字符串
"(ns = X) Y"，其中 X 是ns（n `div` 2的数字），Y 是内部 do-block 的结果n'。
- 如果
- 最后，我们从整个函数中返回，结果是字符串 "Answer: Z"，其中 Z 是我们从
callCCdo-block 中得到的字符串。
继续的一种用法是模拟异常。为此，我们保存两个继续：一个是如果发生异常则将我们带到处理程序的继续，另一个是如果成功则将我们带到处理程序后代码的继续。以下是一个简单的函数，它接受两个数字并对其进行整数除法，当分母为零时失败。
示例：抛出异常的 div
divExcpt :: Int -> Int -> (String -> Cont r Int) -> Cont r Int
divExcpt x y handler = callCC $ \ok -> do
err <- callCC $ \notOk -> do
when (y == 0) $ notOk "Denominator 0"
ok $ x `div` y
handler err
{- For example,
runCont (divExcpt 10 2 error) id --> 5
runCont (divExcpt 10 0 error) id --> *** Exception: Denominator 0
-}
它是如何工作的？我们使用两次嵌套的 callCC 调用。第一个标记一个继续，它将在没有问题时使用。第二个标记一个继续，它将在我们希望抛出异常时使用。如果分母不是 0，x `div` y 将被抛入 ok 继续，因此执行将直接弹出到 divExcpt 的顶层。然而，如果我们传递了一个为零的分母，我们将在 notOk 继续中抛出一个错误消息，这将使我们弹出到内部 do-block，并且该字符串将被分配给 err 并传递给 handler。
可以使用以下函数看到更通用的异常处理方法。将计算作为第一个参数传递（更准确地说，是一个接受一个抛出异常函数并导致计算的函数）并将一个错误处理程序作为第二个参数传递。本例利用了通用的 MonadCont 类 [4]，它默认情况下涵盖了 Cont 和相应的 ContT 变换器，以及任何其他实例化它的继续单子。
示例：使用继续实现通用的 try。
import Control.Monad.Cont
tryCont :: MonadCont m => ((err -> m a) -> m a) -> (err -> m a) -> m a
tryCont c h = callCC $ \ok -> do
err <- callCC $ \notOk -> do
x <- c notOk
ok x
h err
以下是我们的 try 在实际中的应用。
示例：使用 try
data SqrtException = LessThanZero deriving (Show, Eq)
sqrtIO :: (SqrtException -> ContT r IO ()) -> ContT r IO ()
sqrtIO throw = do
ln <- lift (putStr "Enter a number to sqrt: " >> readLn)
when (ln < 0) (throw LessThanZero)
lift $ print (sqrt ln)
main = runContT (tryCont sqrtIO (lift . print)) return
在本例中，抛出错误意味着从封闭的 callCC 中退出。sqrtIO 中的 throw 跳出了 tryCont 的内部 callCC。
在本节中，我们创建了一个 CoroutineT 单子，它提供了一个带有 fork 的单子，该单子将新挂起的协程入队，以及一个带有 yield 的单子，该单子会挂起当前线程。
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- We use GeneralizedNewtypeDeriving to avoid boilerplate. As of GHC 7.8, it is safe.
import Control.Applicative
import Control.Monad.Cont
import Control.Monad.State
-- The CoroutineT monad is just ContT stacked with a StateT containing the suspended coroutines.
newtype CoroutineT r m a = CoroutineT {runCoroutineT' :: ContT r (StateT [CoroutineT r m ()] m) a}
deriving (Functor,Applicative,Monad,MonadCont,MonadIO)
-- Used to manipulate the coroutine queue.
getCCs :: Monad m => CoroutineT r m [CoroutineT r m ()]
getCCs = CoroutineT $ lift get
putCCs :: Monad m => [CoroutineT r m ()] -> CoroutineT r m ()
putCCs = CoroutineT . lift . put
-- Pop and push coroutines to the queue.
dequeue :: Monad m => CoroutineT r m ()
dequeue = do
current_ccs <- getCCs
case current_ccs of
[] -> return ()
(p:ps) -> do
putCCs ps
p
queue :: Monad m => CoroutineT r m () -> CoroutineT r m ()
queue p = do
ccs <- getCCs
putCCs (ccs++[p])
-- The interface.
yield :: Monad m => CoroutineT r m ()
yield = callCC $ \k -> do
queue (k ())
dequeue
fork :: Monad m => CoroutineT r m () -> CoroutineT r m ()
fork p = callCC $ \k -> do
queue (k ())
p
dequeue
-- Exhaust passes control to suspended coroutines repeatedly until there isn't any left.
exhaust :: Monad m => CoroutineT r m ()
exhaust = do
exhausted <- null <$> getCCs
if not exhausted
then yield >> exhaust
else return ()
-- Runs the coroutines in the base monad.
runCoroutineT :: Monad m => CoroutineT r m r -> m r
runCoroutineT = flip evalStateT [] . flip runContT return . runCoroutineT' . (<* exhaust)
一些示例用法
printOne n = do
liftIO (print n)
yield
example = runCoroutineT $ do
fork $ replicateM_ 3 (printOne 3)
fork $ replicateM_ 4 (printOne 4)
replicateM_ 2 (printOne 2)
输出
3 4 3 2 4 3 2 4 4
CPS 函数的一个有趣的用法是实现我们自己的模式匹配。我们将通过一些示例来说明如何做到这一点。
示例：内置模式匹配
check :: Bool -> String
check b = case b of
True -> "It's True"
False -> "It's False"
现在我们已经学习了 CPS，我们可以像这样重构代码。
示例：CPS 中的模式匹配
type BoolCPS r = r -> r -> r
true :: BoolCPS r
true x _ = x
false :: BoolCPS r
false _ x = x
check :: BoolCPS String -> String
check b = b "It's True" "It's False"
*Main> check true "It's True" *Main> check false "It's False"
这里发生的情况是，我们使用函数来表示 True 和 False，而不是简单值，这些函数将选择传递给它们的第一个或第二个参数。由于 true 和 false 的行为不同，我们可以实现与模式匹配相同的效果。此外，True、False 和 true、false 可以通过 \b -> b True False 和 \b -> if b then true else false 来相互转换。
我们应该看看这与更复杂的示例中的 CPS 有什么关系。
示例：更复杂的模式匹配及其 CPS 等价关系
data Foobar = Zero | One Int | Two Int Int
type FoobarCPS r = r -> (Int -> r) -> (Int -> Int -> r) -> r
zero :: FoobarCPS r
zero x _ _ = x
one :: Int -> FoobarCPS r
one x _ f _ = f x
two :: Int -> Int -> FoobarCPS r
two x y _ _ f = f x y
fun :: Foobar -> Int
fun x = case x of
Zero -> 0
One a -> a + 1
Two a b -> a + b + 2
funCPS :: FoobarCPS Int -> Int
funCPS x = x 0 (+1) (\a b -> a + b + 2)
*Main> fun Zero 0 *Main> fun $ One 3 4 *Main> fun $ Two 3 4 9 *Main> funCPS zero 0 *Main> funCPS $ one 3 4 *Main> funCPS $ two 3 4 9
与前面的示例类似，我们用函数表示值。这些函数值会选择它们传递的相应（即匹配）继续，并将存储在函数值中的值传递给后者。有趣的是，这个过程不涉及任何比较。如我们所知，模式匹配可以用于不是 Eq 实例的类型：函数值“知道”它们自己的模式是什么，并将自动选择正确的继续。如果这是从外部完成的，比如通过 pattern_match :: [(pattern, result)] -> value -> result 函数，它就必须检查和比较模式和值，以查看它们是否匹配 - 因此需要 Eq 实例。
说明
- ↑ 也就是说，
\x -> ($ x)，完全写出来是\x -> \k -> k x - ↑ attoparsec 是 CPS 性能驱动用法的示例。
- ↑ 除了验证单子定律是否成立之外，这留给读者作为练习。
- ↑ 在
mtl包中找到，模块 Control.Monad.Cont 中。