GOTO (kind of) in Haskell

Goto.hs

module Goto where

import Control.Monad.Cont
import Data.IORef

evalContT :: Monad m => ContT r m r -> m r
evalContT = flip runContT return

reset :: (Monad m) => ContT a m a -> ContT a m a
reset = lift . evalContT

shift :: (Monad m) =>
         ((a -> ContT r m b) -> ContT b m b)
      -> ContT b m a
shift f = ContT $ \k -> evalContT (f $ lift . k)

newtype Label m a = Label (Label m a -> ContT a m a)

label :: Monad m => ContT a m (Label m a)
label = shift (\k -> k (Label k))

goto :: Monad m => Label m a -> ContT a m a
goto l@(Label k) = shift $ \_ ->  k l


foo :: IO ()
foo = evalContT $ do
  counter <- liftIO $ newIORef 1
  liftIO $ putStrLn "Hello"
  point1 <- label
  liftIO $ putStrLn "world"
  count <- liftIO $ atomicModifyIORef counter (\x -> (x+1, x))
  unless (count >= 5) $ goto point1
  liftIO $ putStrLn "done"