[Haskell-cafe] Re: How to abort a computation within Continuation Monad?

Gleb Alexeyev gleb.alexeev at gmail.com
Tue Nov 20 06:22:41 EST 2007


Dimitry Golubovsky wrote:

> If I have
> 
> callCC $ \exit -> do
>   foo
> ...
> 
> I cannot jump to `exit' from within foo unless `exit' is given to foo
> as an argument.
> 
  As Derek Elkins has written, one of the options is to use delimited 
continuations, see 
http://research.microsoft.com/~simonpj/papers/control/ for Haskell 
implementation.

But in this case Cont may be enough. If you don't like passing `exit' 
explicitly, you can put in into Reader monad. This is the idea:

--------------------------------------------------------------------
import Control.Monad.Cont
import Control.Monad.Reader

type Abortable r a = ReaderT (r -> Cont r r) (Cont r) a

runAbortable :: Abortable a a -> a
runAbortable m = runCont (callCC $ \exit -> runReaderT m exit) id

abort :: r -> Abortable r a
abort x = do
   exit <- ask
   lift (exit x)
   undefined     -- this hack is needed to make abort polymorphic

test a b c = do
   x <- if a then abort "a" else return 1
   y <- if b then abort "b" else return False
   z <- foo c   -- calling foo without explicit abort continuation
   return $ show (x, y, z)
       where foo True = abort "c"
             foo False = return 5.39

run m = putStrLn (runAbortable m)

main = do run (test False False False)
           run (test False False True)
           run (test False True False)
           run (test True False False)

------------------------------------------------------------------

This implementation is a bit hackish, since it uses undefined to make 
abort polymorphic in return type. You can use rank-2 types to avoid it, 
see http://www.vex.net/~trebla/tmp/ContMonad.lhs by Albert C. Lai.



More information about the Haskell-Cafe mailing list