Haskell 中 callCC 的意外输出

Question

我试图使用

callCC

在 Haskell 中构建一个非常简单的协程示例。 我对

callCC :: ((a -> m b) -> m a) -> m a

如何运作的理解是通过写作

example :: Cont Int Int
example = do
   callCC $ \k -> ...
   f

我基本上将

callCC

的延续绑定在一起，即

f

到

k

。然后，如果

k

在

callCC

的体内使用，例如

callCC $ \k -> ... k 42 ...

它将导致使用该值调用延续，即

f 42

，否则，如果

k

未使用，

callCC $ \k -> ... return 41

，它将导致

f

应用于

41

。通过将此

k

存储在某些数据结构中，我可以获得在

example

之后立即恢复功能 (

callCC

) 的能力（因为

f

绑定到

k

）。

我的协程代码如下

{-#LANGUAGE GeneralisedNewtypeDeriving #-}

module Cont where

import Control.Monad.Cont
import Control.Monad.IO.Class(liftIO)
import Control.Monad.State(put, get, runStateT, evalStateT, StateT, MonadState, MonadIO, execStateT)

newtype CoroutineT r m a = CoroutineT {runCoroutineT :: ContT r (StateT [CoroutineT r m ()] m) a}
    deriving (Functor,Applicative,Monad,MonadCont,MonadIO, MonadState [CoroutineT r m ()])


schedule :: CoroutineT () IO ()
schedule = do
    cs <- get
    case cs of
        (c:cs) -> do
            put cs
            c
            schedule
        [] -> return ()

yield :: CoroutineT () IO ()
yield = callCC $ \k1 -> do
            cs <- get
            put (cs ++ [k1 ()])
            schedule

test1 :: CoroutineT () IO ()
test1 = do
    liftIO $ print "HelloTest1"
    yield
    liftIO $ print "HelloTest1_2"

test2 :: CoroutineT () IO ()
test2 = do
    liftIO $ print "HelloTest2"
    yield
    liftIO $ print "HelloTest2_2"

test_cont :: IO ()
test_cont = do 
    runStateT (evalContT (runCoroutineT schedule)) [test1,test2]
    return ()

其中

yield

将延续存储在状态中，然后由

schedule

恢复。

我希望每个延续执行两次——一次在“调用”

schedule

之后的

c

中执行，然后在每个

yeild

被评估之后执行。因此预期输出应该是

"HelloTest1"
"HelloTest2"
"HelloTest1_2"
"HelloTest2_2"
"HelloTest2_2"
"HelloTest1_2"

现实中发生的事情是

"HelloTest1"
"HelloTest2"
"HelloTest1_2"
"HelloTest2_2"
"HelloTest1_2"

我的理解和/或代码可能有什么问题？

Answer 1

您可能忽略了这样一个事实：当调用使用

callCC

捕获的延续（

c

中的

schedule

）时，调用站点的当前延续（

schedule

以及后续内容）将被丢弃。

PROGRAM            | STATE
---------------------------
schedule             [test1,test2]
---------------------------
test1                [test2]
schedule
--------------------------- Print "HelloTest1"
yield                [test2]
print "HelloTest1_2"
schedule
---------------------------  -- let K1 = do print "HelloTest1_2"; schedule
schedule             [test2, K1]
print "HelloTest1_2"
schedule
---------------------------
test2                [K1]
schedule
print "HelloTest1_2"
--------------------------- Print "HelloTest2"
yield                [K1]
print "HelloTest2_2"
schedule
print "HelloTest1_2"
---------------------------  -- let K2 = print "HelloTest2_2"; schedule; print "HelloTest1_2"
schedule             [K1, K2]
print "HelloTest2_2"
schedule
print "HelloTest1_2"
--------------------------- -- call K1: the current continuation is discarded, the whole program becomes K1 (Note the definition of K1 above is a lie since it doesn't include this detail.)
print "HelloTest1_2" [K2]
schedule
--------------------------- Print "HelloTest1_2"
schedule             [K2]
--------------------------- -- call K2: the current continuation is discarded, the whole program becomes K2
print "HelloTest2_2" []
schedule
print "HelloTest1_2"
--------------------------- Print "HelloTest2_2" and "HelloTest1_2"