1月 27 2016

使用Continuation Monad实现Coroutine

其实知道Continuation Monad还可以这么用还是因为CodeWars上的一道题。足足肝了三天还是没完全想明白orz。姑且先记录一下现在的想法吧。

先来回顾一下Continuation Monad的定义：

newtype Cont r a = Cont { runCont :: (a -> r) -> r }

-- useful alias
(|>) :: a -> (a -> r) -> r
x |> f = f x

从上一篇文章中我们知道f >>= g不过就是f x展开为一连串的apply形式：

Cont r x == ($ x)
         == \f -> x |> f
         == \f -> x |> (\g -> g |> f)
         == \f -> x |> (\g -> g |> ... (\z -> z |> f))

这种形式到底有什么用呢？我们马上就能看到。

现在的问题是Coroutine该如何实现？我们可以把它抽象为一个指挥棒传递的过程。一个线程x开心的运行着一些计算，直到它需要输入或输出一些数据。这个时候它把指挥棒交给另一个线程y,直到y产生一些输入输出，再交还指挥棒。等等，这个描述是不是和上面的展开式有点像？如果把每一个lambda表达式都看成一个计算的话，这正是我们需要的。于是根据语义我们可以写下

{-# LANGUAGE DeriveFunctor #-}

-- u : input type  d : output type
newtype Coroutine r u d a = Coroutine { runCoroutine :: (a -> r) -> r } deriving Functor

data Command r u d a = Done a
                     | Out d (Coroutine r u d a)
                     | In (\u -> Coroutine r u d a)
                     deriving Functor

这里详细的解释一下。Coroutine实际上和Cotinuation是一个东西，只不过多了额外的两个类型参数。u为输入参数的类型，d为输出参数的类型。Command r u d a里则定义了三种基本类型，分别为Done a表示计算完成，没有输入输出；Out d (Coroutine r u d a)表示输出类型为d的数据，同时执行参数中的计算；In (\u -> Coroutine r u d a)表示需要输入数据，并在等待输入时执行参数中的计算。很优雅的抽象，对吧？下一步就是将Coroutine声明为Monad：

-- useful alias
apply = runCoroutine

instance Applicative (Coroutine r u d) where
  pure = return
  (<*>) = ap
  
instance Monad (Coroutine r u d) where
  return a = Coroutine ($ a)
  f >>= g  = Coroutine $ \k -> apply f $
                           \a -> case a of
                             Done x -> (g x) `apply` k
                             Out d c -> k $ Out d (c >>= g)
                             In fn -> k $ In (\u -> fn u >>= g)

这里在做的实际上和原来并没有太大区别，只是在每一个lambda表达式中多了一个判断。

如果计算完成了（Done a），那么直接进行下一个计算。
如果计算需要输出类型为d的数据（`Out d (Coroutine r u d a))，那么挂起这个计算，直到另一个计算返回结果，并将函数应用到这个结果上。
如果计算需要输入一个u类型，那么同样挂起计算，等到有输入的时候将输入传给另一个计算。

这样看起来可能很抽象，并且我们现在还没办法构建真正的”continuation” 。不妨定义一些helper function：

output :: a -> Coroutine r u a ()
input :: Coroutine r v d v
produce :: [a] -> Coroutine r u a ()
consume :: Coroutine [t] u t a -> [t]
filterC :: (v -> Bool) -> Coroutine r v v ()
limit :: Int -> Coroutine r v v ()
suppress :: Int -> Coroutine r v v ()

-- alias
mkCoroutine :: Command r u d a -> Coroutine r u d a
mkCoroutine command = Coroutine ($ command)

先来看output，我们希望它立刻输出一些东西，于是可以写出：

1 2	output :: a -> Coroutine r u a () output v = mkCoroutine $ Out v (return ())

然后是input，它在获取一个输入后返回它：

1 2	input :: Coroutine r v d v input u = mkCoroutine $ In (\u -> return u)

produce连续的产生输出，而consume将所有的Out提取出来：

produce :: [a] -> Coroutine r u a ()
produce xs = mapM_ output xs

consume :: Coroutine [t] u t a -> [t]
consume c = runCoroutine c go
    where go (Done _)  = []
          go (Out d n) = d : consume n
          go (In _)    = []

filterC挑选出每一个符合条件的输入并输出：

filterC :: (v -> Bool) -> Coroutine r v v ()
filterC p = do
    i <- input
    when (p i) (output i)
    filterC p

最后，limit类似于take，suppress类似于drop：

limit :: Int -> Coroutine r v v ()
limit n = replicateM_ n (input >>= output)

suppress :: Int -> Coroutine r v v ()
suppress n
    | n > 0 = input >> suppress (n-1)
    | otherwise = forever $ input >>= output

现在，我们就可以用这些函数来构建一些有趣的东西了

1
2
3

p1 = filterC even >>> limit 5

consume (produce [0..] >>> p1) === [0, 2, 4, 6, 8]

更多的玩法就留给读者去发掘吧w

Phantom Shrine

Haskell, Programming Languages, Hardware, and Happy Hacking!

使用Continuation Monad实现Coroutine