Haskell語言學習筆記（30）MonadCont, Cont, ContT

MonadCont 類型類

class Monad m => MonadCont m where
    callCC :: ((a -> m b) -> m a) -> m a
instance MonadCont (ContT r m) where
    callCC = ContT.callCC

• class Monad m => MonadCont m where
  MonadState 是個類型類，它爲 ContT 等封裝了CPS函數的 Monad 定義了通用接口。
  MonadState 只包含 callCC 一個函數。該函數爲CPS函數提供了顯式的流程控制功能。
• instance MonadCont (ContT r m) where
  callCC = ContT.callCC
  對於 ContT 這個Monad轉換器來講，callCC 函數的定義由 ContT 模塊來提供。注意這裏點運算符的含義不是函數的合成而是受限名字。
  Hackage - Where is the MonadReader implementation for ReaderT defined?

ContT Monad轉換器

newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
instance Monad (ContT r m) where
    return x = ContT ($ x)
    m >>= k  = ContT $ \c -> runContT m (\x -> runContT (k x) c)

• newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
  ContT 類型是個 newtype，也就是對現有類型的封裝。該類型有三個類型參數：內部 Monad 類型參數 m，中間結果類型參數 a 以及最終結果類型參數 r。
  ContT r m a 類型封裝了一個CPS函數：\k -> m r（一般形式爲 \k -> k a），經過 runContT 字段能夠從 ContT 類型中取出這個函數。
• instance Monad (ContT r m) where
  ContT r m 是一個 Monad。
  對比 Monad 類型類的定義，可知 return 函數的類型簽名爲：
  return :: a -> ContT r m a
  大體至關於 a -> (a -> m r) -> m r
  而 bind 操做符的類型簽名爲：
  (>>=) :: ContT r m a -> (a -> ContT r m b) -> ContT r m b
  大體至關於 (a -> m r) -> m r -> (a -> (b -> m r) -> m r) -> (b -> m r) -> m r
• return x = ContT ($ x)
  return 函數把 a 類型的值 x 封裝進了 ContT Monad 中。
  return x = ContT $ \k -> k x
  這裏 x 的類型爲 a, k 的類型爲 a -> m r，k x 的類型爲 m r，
  \k -> k x 的類型爲 (a -> m r) -> m r，
  ContT $ \k -> k x 也就是 ContT ($ x) 的類型爲 ContT r m a。
• m >>= k = ContT $ \c -> runContT m (\x -> runContT (k x) c)
  對比函數簽名，可知 m 的類型爲 ContT r m a，大體至關於 (a -> m r) -> m r。
  而 k 的類型爲 a -> ContT r m b，大體至關於 a -> (b -> m r) -> m r。
  x 的類型爲 a，c 的類型爲 b -> m r。
  k x 的類型 ContT r m b，
  runContT (k x) 的類型爲 (b -> m r) -> m r，
  runContT (k x) c 的類型爲 m r。
  \x -> runContT (k x) c 的類型爲 a -> m r，
  runContT m 的類型爲 (a -> m r) -> m r，
  runContT m (\x -> runContT (k x) c) 的類型爲 m r。
  \c -> runContT m (\x -> runContT (k x) c) 的類型爲 (b -> m r) -> m r，
  ContT $ \c -> runContT m (\x -> runContT (k x) c) 的類型爲 ContT r m b。
• m >>= k = ContT $ \c -> runContT m (\x -> runContT (k x) c)
  bind 操做符組合兩個封裝了CPS函數的 Cont Monad，計算結果仍然是一個封裝了CPS函數的 Cont Monad。
  這裏假設 m = ContT c1 where c1 f1 = f1 a，k = \a -> ContT c2 where c2 f2 = f2 b。
  bind 操做符具體計算流程以下：
  首先經過 runContT m 把封裝在 bind 操做符的左操做數 m 中的CPS函數 c1 取出來，
  c1 函數將把類型爲 a 的運算結果 x 傳遞給 f1，也就是 (\x -> runContT (k x) c) 這個函數，獲得 runContT (k x) c 這個運算結果。
  而後 runContT (k x) 再把 bind 操做符的右操做數 k 中所封裝的CPS函數 c2 取出來。
  c2 函數將把類型爲 b 的運算結果 y 傳遞給 f2, 也就是最外層的函數 c，獲得最終運算結果 c y。
  最後經過 ContT $ \c -> c y 這一形式，把計算結果從新封裝進了 ContT Monad。

證實ContT符合Monad法則：
1. return a >>= f ≡ f a
return a >>= f
≡ ContT (\k -> k a) >>= f
≡ ContT $ \c -> runContT (ContT (\k -> k a)) (\x -> runContT (f x) c)
≡ ContT $ \c -> (\k -> k a) (\x -> runContT (f x) c)
≡ ContT $ \c -> (\x -> runContT (f x) c) a
≡ ContT $ \c -> runContT (f a) c
≡ ContT $ runContT (f a)
≡ f a
2. m >>= return ≡ m
m >>= return
≡ ContT $ \c -> runContT m (\x -> runContT (return x) c)
≡ ContT $ \c -> runContT m (\x -> runContT (ContT $ \k -> k x) c)
≡ ContT $ \c -> runContT m (\x -> (\k -> k x) c)
≡ ContT $ \c -> runContT m (\x -> c x)
≡ ContT $ \c -> runContT m c
≡ ContT $ runContT m
≡ m
3. (m >>= f) >>= g ≡ m >>= (\x -> f x >>= g)
(m >>= f) >>= g
≡ (ContT $ \c -> runContT m (\x -> runContT (f x) c)) >>= g
≡ ContT $ \c -> runContT (ContT $ \c -> runContT m (\x -> runContT (f x) c)) (\x -> runContT (g x) c)
≡ ContT $ \c -> (\c -> runContT m (\x -> runContT (f x) c)) (\x -> runContT (g x) c)
≡ ContT $ \c -> runContT m (\x -> runContT (f x) (\x -> runContT (g x) c))
m >>= (\x -> f x >>= g)
≡ ContT $ \c -> runContT m (\x -> runContT ((\x -> f x >>= g) x) c)
≡ ContT $ \c -> runContT m (\x -> runContT (f x >>= g) c)
≡ ContT $ \c -> runContT m (\x -> runContT (ContT $ \c -> runContT (f x) (\x -> runContT (g x) c)) c)
≡ ContT $ \c -> runContT m (\x -> (\c -> runContT (f x) (\x -> runContT (g x) c)) c)
≡ ContT $ \c -> runContT m (\x -> runContT (f x) (\x -> runContT (g x) c))

lift liftIO 函數

instance MonadTrans (ContT r) where
    lift m = ContT (m >>=)

instance (MonadIO m) => MonadIO (ContT r m) where
    liftIO = lift . liftIO

lift m 將封裝在內部 Monad m 的值封裝進了 ContT Monad 之中。
lift m = ContT $ \k -> m >>= k
這裏 m 的類型爲 m a, k 的類型爲 a -> m r，m >> k 的類型爲 m r，
\k -> m >>= k 的類型爲 (a -> m r) -> m r，
ContT $ \k -> m >>= k 也就是 ContT (m >>=) 的類型爲 ContT r m a。

證實 ContT 中 lift 函數的定義符合 lift 的法則。
1. lift . return ≡ return
lift . return $ a
≡ lift (m a)
≡ ContT (m a >>=)
≡ ContT $ \k -> m a >>= k
≡ ContT $ \k -> k a
≡ return a
2. lift (m >>= f) ≡ lift m >>= (lift . f)
假設 m = n a 而且 f a = n b
因而 m >>= f = n b
lift (m >>= f)
≡ lift (n b)
≡ ContT (n b >>=)
≡ ContT $ \k -> n b >>= k
≡ ContT $ \k -> k b
≡ return b
lift m >>= (lift . f)
≡ ContT (n a >>=) >>= \x -> ContT (f x >>=)
≡ ContT (\k -> k a) >>= \x -> ContT (\k -> f x >>= k)
≡ ContT $ \c -> runContT $ ContT (\k -> k a) (\x -> runContT $ ContT (\k -> f x >>= k) c)
≡ ContT $ \c -> (\k -> k a) (\x -> (\k -> f x >>= k) c)
≡ ContT $ \c -> (\x -> (\k -> f x >>= k) c) a
≡ ContT $ \c -> (\k -> f a >>= k) c
≡ ContT $ \c -> (\k -> n b >>= k) c
≡ ContT $ \c -> (\k -> k b) c
≡ ContT $ \c -> c b
≡ return b

Prelude Control.Monad.Trans.Cont Control.Monad.Trans> f a = if even a then Just (a `div` 2) else Nothing
Prelude Control.Monad.Trans.Cont Control.Monad.Trans> c = lift . f :: Int -> ContT Int Maybe Int
Prelude Control.Monad.Trans.Cont Control.Monad.Trans> runContT (c 3) return
Nothing
Prelude Control.Monad.Trans.Cont Control.Monad.Trans> runContT (c 4) f
Just 1
Prelude Control.Monad.Trans.Cont Control.Monad.Trans> c = lift getLine :: ContT r IO String
Prelude Control.Monad.Trans.Cont Control.Monad.Trans> runContT c print
abc
"abc"

callCC 函數

callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a
callCC f = ContT $ \c -> runContT (f (\x -> ContT $ \_ -> c x)) c

CallCC 是 Call With Current Continuation（對當前延續函數進行調用）的縮寫，它爲 ContT Monad 提供了退出的手段。
CallCC 有一個參數 f，CallCC f 返回一個 ContT Monad。
f 的類型是 (a -> ContT r m b) -> ContT r m a，也就是說 f 自己是個函數，它的返回值類型和 CallCC f 相同，都是一個ContT Monad。
f 一般採用 \exit -> do ... 這種形式。

Prelude Control.Monad.Trans.Cont Control.Monad.Trans> runContT (callCC (\exit -> exit 1) :: ContT Int Maybe Int) return
Just 1
Prelude Control.Monad.Trans.Cont Control.Monad.Trans> runContT (callCC (\exit -> do{exit 1; return 2}) :: ContT Int Maybe Int) return
Just 1

也就是說只要 CallCC 的參數採用 \exit -> do {...; exit a; ...} 這種形式，
那麼該函數所返回的 ContT Monad 將無視 exit a 後面的處理流程，無條件地將 a 傳遞給外圍函數。
下面看看 CallCC 函數是如何作到這一點的。

• callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a
  callCC f = ContT $ \c -> runContT (f (\x -> ContT $ \_ -> c x)) c
  ContT $ \c -> runContT (f (\x -> ContT $ \_ -> c x)) c 類型爲 ContT r m a
  \c -> runContT (f (\x -> ContT $ \_ -> c x)) c 類型爲 (a -> m r) -> m r
  c 的類型爲 a -> m r，
  runContT (f (\x -> ContT $ \_ -> c x)) 的類型爲 (a -> m r) -> m r，
  f (\x -> ContT $ \_ -> c x) 的類型爲 ContT r m a，
  f 的類型爲 (a -> ContT r m b) -> ContT r m a，
  \x -> ContT $ \_ -> c x 的類型爲 a -> ContT r m b，x 的類型爲 a，
  ContT $ \_ -> c x 的類型爲 ContT r m b，
  \_ -> c x 的類型爲 (b -> m r) -> m r，
  _ 的類型爲 b -> m r，
  c x 的類型爲 m r。
• callCC f = ContT $ \c -> runContT (f (\x -> ContT $ \_ -> c x)) c
  這裏假設 f = \exit -> exit a >>= k。
  callCC f where f = \exit -> exit a >>= k
  = ContT $ \c -> runContT (f (\x -> ContT $ \_ -> c x)) c
  = ContT $ \c -> runContT ((\exit -> exit a >>= k) (\x -> ContT $ \_ -> c x)) c
  = ContT $ \c -> runContT ((\x -> ContT $ \_ -> c x) a >>= k) c
  = ContT $ \c -> runContT ((ContT $ \_ -> c a) >>= k) c
• m >>= k = ContT $ \c -> runContT m (\x -> runContT (k x) c)
  (ContT $ \_ -> c a) >>= k
  = ContT $ \c -> runContT (ContT $ \_ -> c a) (\x -> runContT (k x) c)
  = ContT $ \c -> (\_ -> c a) (\x -> runContT (k x) c)
  = ContT $ \c -> c a
• callCC f where f = \exit -> exit a >>= k
  = ContT $ \c -> runContT ((ContT $ \_ -> c a) >>= k) c
  = ContT $ \c -> runContT (ContT $ \c -> c a) c
  = ContT $ \c -> (\c -> c a) c
  = ContT $ \c -> c a
• callCC f = ContT $ \c -> runContT (f (\x -> ContT $ \_ -> c x)) c
  這裏假設 f = \exit -> exit a >>= k >>= h。
  f = \exit -> exit a >>= k >>= h
  = \exit -> exit a >>= (\x -> k x >> h)
  = \exit -> exit a >>= k' where k' = \x -> k x >> h
  callCC f where f = \exit -> exit a >>= k >>= h
  = callCC f where f = \exit -> exit a >>= k' where k' = \x -> k x >> h
  = ContT $ \c -> c a

從以上推導過程能夠看出 CallCC 的參數若是採用 \exit -> do {...; exit a; ...} 這種形式，
該函數所返回的 ContT Monad 確實會無視 exit a 後面的處理流程，無條件地將 a 傳遞給外圍函數。

ContT Monad轉換器的其餘函數

evalContT :: (Monad m) => ContT r m r -> m r
evalContT m = runContT m return

mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
mapContT f m = ContT $ f . runContT m

withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
withContT f m = ContT $ runContT m . f

resetT :: (Monad m) => ContT r m r -> ContT r' m r
resetT = lift . evalContT

shiftT :: (Monad m) => ((a -> m r) -> ContT r m r) -> ContT r m a
shiftT f = ContT (evalContT . f)

liftLocal :: (Monad m) => m r' -> ((r' -> r') -> m r -> m r) ->
    (r' -> r') -> ContT r m a -> ContT r m a
liftLocal ask local f m = ContT $ \c -> do
    r <- ask
    local f (runContT m (local (const r) . c))

Cont Monad

cont :: ((a -> r) -> r) -> Cont r a
cont f = ContT (\c -> Identity (f (runIdentity . c)))

runCont :: Cont r a  -> (a -> r)  -> r
runCont m k = runIdentity (runContT m (Identity . k))

evalCont :: Cont r r -> r
evalCont m = runIdentity (evalContT m)

mapCont :: (r -> r) -> Cont r a -> Cont r a
mapCont f = mapContT (Identity . f . runIdentity)

withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
withCont f = withContT ((Identity .) . f . (runIdentity .))

reset :: Cont r r -> Cont r' r
reset = resetT

shift :: ((a -> r) -> Cont r r) -> Cont r a
shift f = shiftT (f . (runIdentity .))

Cont Monad 是 ContT Monad（轉換器） 的一個特例。

應用實例

import Control.Monad.Trans.Cont
import Control.Monad (when)

add :: Int -> Int -> Int
add x y = x + y

square :: Int -> Int
square x = x * x

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

pythagoras_cont' :: Int -> Int -> Cont r Int
pythagoras_cont' x y = callCC $ \exit -> do
    when (x < 0 || y < 0) $ exit (-1)
    x_squared <- square_cont x
    y_squared <- square_cont y
    add_cont x_squared y_squared

main = do
    runCont (pythagoras_cont 3 4) print -- 25
    runCont (pythagoras_cont' 3 4) print -- 25
    runCont (pythagoras_cont' (-3) 4) print -- -1

How and why does the Haskell Cont monad work?