label-like continuation

label :: m (m a) がほしい

do
  cont ← label
  print 1
  cont

で無限に 1 が出力されてほしい

---

import Control.Monad.Cont
import Control.Monad.State

main :: IO ()
main = evalStateT (runContT k return) 0

label :: Monad m ⇒ ContT r m (ContT r m a)
label = callCC $ λ k -> callCC $ λ k2 -> k2 $ fix k

counting :: ContT r (StateT Int IO) Int
counting = do
  x ← lift get
  put (x + 1)
  liftIO $ print x
  return x

k :: ContT r (StateT Int IO) ()
k = do
  counting
  liftIO $ putStrLn "A"
  cont ← label
  liftIO $ putStrLn "B"
  v ← counting
  if v < 5 then cont else return ()
  liftIO $ putStrLn "C"
  counting
  return ()

0
A
B
1
B
2
B
3
B
4
B
5
C
6