Haskell/Continuation Passing Style
Continuation Passing Style (簡稱 CPS) 是一種程式設計風格，其中函式不返回值；而是將控制權傳遞給一個 continuation，它指定了接下來會發生什麼。在本章中，我們將考慮這在 Haskell 中是如何實現的，特別是如何用單子來表達 CPS。
什麼是Continuation?
[edit | edit source]為了消除困惑，我們將再次回顧書中很早之前的一個例子，當我們介紹 ($) 運算子時
> map ($ 2) [(2*), (4*), (8*)] [4,8,16]
上面的表示式沒有什麼特別之處，除了用它而不是 map (*2) [2, 4, 8] 來寫有點古怪。($) 部分使程式碼看起來像反過來的，就好像我們把值應用到函式而不是相反。現在，重點來了：這種看起來無害的反轉正是 Continuation Passing Style 的核心！
從 CPS 的角度來看，($ 2) 是一個 掛起的計算：一個具有通用型別 (a -> r) -> r 的函式，它接受另一個函式作為引數，併產生一個最終結果。a -> r 引數是 continuation；它指定了計算如何結束。在本例中，列表中的函式透過 map 作為 continuation 提供，產生三個不同的結果。請注意，掛起的計算在很大程度上可以與普通值互換：flip ($) [1] 將任何值轉換為掛起的計算，並將 id 作為其 continuation 傳遞會返回原始值。
它們有什麼用處?
[edit | edit source]Continuation 不僅僅是用來給 Haskell 新手留下深刻印象的技巧。它們使程式能夠顯式地操作和顯著地改變程式的控制流。例如，可以利用 continuation 從過程提前返回。異常和失敗也可以用 continuation 處理 - 傳遞一個 continuation 表示成功，另一個 continuation 表示失敗，並呼叫相應的 continuation。其他可能性包括“掛起”計算並在以後返回，以及實現簡單的併發形式（特別是，Haskell 的一個實現 Hugs 使用 continuation 來實現協作式併發）。
在 Haskell 中，continuation 可以以類似的方式使用，用於在單子中實現有趣的控制流。請注意，對於此類用例通常存在替代技術，尤其是在與惰性結合使用的情況下。在某些情況下，CPS 可以透過消除某些構造模式匹配序列來提高效能（例如，函式返回一個複雜結構，呼叫者會在某個時刻將其分解），儘管足夠聰明的編譯器應該能夠消除此類序列[2]。
傳遞Continuation
[edit | edit source]利用 continuation 的一種基本方法是對我們的函式進行修改，使它們返回掛起的計算而不是普通值。我們將透過兩個簡單的例子來說明如何做到這一點。
pythagoras
[edit | edit source]示例：一個簡單的模組，沒有 continuation
-- 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 看起來像這樣
示例：一個簡單的模組，使用 continuation
-- 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 -> ...) continuation 中
- 對 y 進行平方並將結果傳遞到 (\y_squared -> ...) continuation 中
- 將 x_squared 和 y_squared 相加並將結果傳遞到頂層/程式 continuation
k中。
我們可以透過將 print 作為程式 continuation 傳遞來在 GHCi 中嘗試它
*Main> pythagoras_cps 3 4 print 25
如果我們檢視 pythagoras_cps 的型別（沒有在 (Int -> r) -> r 周圍加上可選的括號），並將其與 pythagoras 的原始型別進行比較，我們會注意到，continuation 實際上被新增為一個額外的引數，因此證明了“continuation passing style”這個名字的合理性。
示例： 一個簡單的更高階函式，沒有延續
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)。定義的其餘部分很自然地遵循型別——我們用 CPS 版本替換 f，並傳遞現有的延續。
示例： 一個簡單的更高階函式，帶延續
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
我們用一個新的掛起計算 (由 f 生成) 來提供原始的掛起計算 s，並將最終的延續 k 傳遞給它。不出所料，它與前面示例中巢狀的 lambda 模式非常相似。
chainCPS 的型別看起來很熟悉嗎？如果我們將 (a -> r) -> r 替換為 (Monad m) => m a，並將 (b -> r) -> r 替換為 (Monad m) => m b，我們將得到 (>>=) 簽名。此外，我們的老朋友 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” 代表 “call with current continuation”) 的延續中。雖然在這個簡單的示例中，效果僅僅是普通 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
雖然程式碼遠非顯而易見，但一個令人驚奇的事實是，callCC、return 和 (>>=) 的 Cont 實現可以從它們的型別簽名自動生成——Lennart Augustsson 的 Djinn [1] 是一個可以為你執行此操作的程式。有關 Djinn 背後理論的背景資訊，請參見 Phil Gossett 的 Google 技術講座：[2]；有關使用 Djinn 推導延續傳遞風格的資訊，請參見 Dan Piponi 的文章：[3]。
現在我們將研究一些更真實的控制流操作示例。下面的第一個示例最初取自 關於單子的所有教程 的“Continuation 單子”部分，經許可使用。
示例： 使用 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)只是意味著我們執行後面的Cont塊，並使用id作為最終的延續（或者，換句話說，我們從掛起的計算中提取值而不改變它）。這是必要的，因為fun的結果型別沒有提到Cont。 - 我們將
str繫結到以下callCCdo 塊的結果。- 如果
n小於 10，我們直接退出，只顯示n。 - 否則，我們繼續執行。我們構造一個
ns列表，它包含n `div` 2的數字。 n'（一個Int）被繫結到以下內部callCCdo 塊的結果。- 如果
length ns < 3，即如果n `div` 2的位數少於 3 位，我們將從這個內部 do 塊退出，返回位數作為結果。 - 如果
n `div` 2的位數少於 5 位，我們將從內部 do 塊退出，返回原始的n。 - 如果
n `div` 2的位數少於 7 位，我們將從內部和外部兩個 do 塊退出，結果為n `div` 2的數字以逆序排列（一個String）。 - 否則，我們結束內部 do 塊，返回
n `div` 2的數字之和。
- 如果
- 我們結束這個 do 塊，返回字串
"(ns = X) Y"，其中 X 是ns，即n `div` 2的數字，而 Y 是內部 do 塊的結果n'。
- 如果
- 最後，我們從整個函式退出，結果是字串 "Answer: Z"，其中 Z 是我們從
callCCdo 塊得到的字串。
延續的一個用途是模擬異常。為此，我們保留兩個延續：一個用於在發生異常時將我們帶到處理程式，另一個用於在成功時將我們帶到處理程式後的程式碼。這是一個簡單的函式，它接受兩個數字並在它們之間進行整數除法，當除數為零時會失敗。
示例： 丟擲異常的 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 塊中，該字串將被分配給 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。