[rearrange jumpoint and continuation code, continue work on moving IO monad to jumppoint based errors
John Meacham <john@repetae.net>**20060221053557] addfile ./lib/System/IO/Continuation.hs
hunk ./Main.hs 466
-    --wdump FD.Grin $ printGrin x
+    wdump FD.Grin $ printGrin x
hunk ./lib/Jhc/IO.hs 3
+import Jhc.Hole
hunk ./lib/Jhc/IO.hs 10
-type IOErrorCont = IOCont World__ IOError
+type IOErrorCont = (JumpPoint,Hole IOError)
hunk ./lib/Jhc/IO.hs 26
-errorContinuation :: (IOErrorCont -> World__ -> IOResult a) -> IO a
-errorContinuation x = newContinuation__ (\ncont -> IO $ \_ w -> x ncont w) showError
+errorContinuation :: IO a -> IO a
+errorContinuation x = catch x showError
hunk ./lib/Jhc/IO.hs 30
-unsafePerformIO (IO x) = case errorContinuation x of
+unsafePerformIO x = case errorContinuation x of
hunk ./lib/Jhc/IO.hs 36
-unsafeInterleaveIO (IO action) = IO $ \c w -> JustIO w $ case action' c w of
+unsafeInterleaveIO action = IO $ \c w -> JustIO w $ case action' c w of
hunk ./lib/Jhc/IO.hs 53
-{-
-fixIO :: (a -> IO a) -> IO a
-fixIO k = IO $ \w -> let
-            r@(JustIO _ ans) = case k ans of
-                    IO z -> case z w of
-                        FailIO _ z -> error $ case z of IOError z ->  z
-                        z -> z
-              in r
--}
hunk ./lib/Jhc/IO.hs 62
+getJumpPoint :: IO (JumpPoint,Hole IOError)
+getJumpPoint = IO $ \ jh w -> JustIO w jh
+
hunk ./lib/Jhc/IO.hs 66
-ioError e   =  (IO $ \c w -> case callContinuation c e of IO cont -> cont c w)
+ioError e   =  do
+    (jp,he) <- getJumpPoint
+    fillHole he e
+    jumpJumpPoint__ jp
hunk ./lib/Jhc/IO.hs 73
-catch (IO x) fn = newContinuation__ (\ncont -> IO $ \_ w -> x ncont w) fn
+catch (IO x) fn = do
+    hole <- newHole
+    withJumpPoint__ $ \jp b -> case b of
+        False -> IO $ \_ w -> x (jp,hole) w
+        True -> fn (readHole hole)
hunk ./lib/Jhc/JumpPoint.hs 1
-module Jhc.JumpPoint(IOCont(),newContinuation,callContinuation,newContinuation__) where
-
+module Jhc.JumpPoint(JumpPoint(), withJumpPoint__, jumpJumpPoint__) where
hunk ./lib/Jhc/JumpPoint.hs 4
-import Jhc.Hole
hunk ./lib/Jhc/JumpPoint.hs 7
-
-data IOCont s a = IOCont (Hole a) JumpPoint
hunk ./lib/Jhc/JumpPoint.hs 9
-newContinuation :: (forall s . IOCont s a -> IO b) -> (a -> IO b) -> IO b
-newContinuation act cc = newContinuation__ act cc
-
-
--- | this is unsafe and should only be used internally to the IO library
-newContinuation__ :: (IOCont World__ a -> IO b) -> (a -> IO b) -> IO b
-newContinuation__ act cc = do
-    jp@(JumpPoint jp') <- newJumpPoint__
-    ref <- newHole
-    r <- runJumpPoint__ jp
-    case r of
-        False -> do
-            res <- act (IOCont ref jp)
-            free jp'
-            return res
-        True -> do
-            free jp'
-            cc (readHole ref)
-
-
-callContinuation :: IOCont s a -> a -> IO b
-callContinuation (IOCont ref jp) x = do
-    fillHole ref x
-    jumpJumpPoint__ jp
-
-
-
hunk ./lib/Jhc/JumpPoint.hs 10
-newJumpPoint__ :: IO JumpPoint
-newJumpPoint__ = do
+-- | in order to be safe, the JumpPoint must not escape the handling function
+withJumpPoint__ :: (JumpPoint -> Bool -> IO a) -> IO a
+withJumpPoint__ action = do
hunk ./lib/Jhc/JumpPoint.hs 14
-    return (JumpPoint p)
+    let jp = (JumpPoint p)
+    r <- jhc_setjmp jp
+    r <- action jp (r /= 0)
+    free p
+    return r
+
+jumpJumpPoint__ :: JumpPoint -> IO a
+jumpJumpPoint__ jp = jhc_longjmp  jp >> return (error "jumpJumpPoint__")
hunk ./lib/Jhc/JumpPoint.hs 27
-
-runJumpPoint__ :: JumpPoint -> IO Bool
-runJumpPoint__ jp = do
-    r <- jhc_setjmp  jp
-    return (r /= 0)
-
-jumpJumpPoint__ :: JumpPoint -> IO a
-jumpJumpPoint__ jp = jhc_longjmp  jp >> return (error "jumpJumpPoint__")
-
-foreign import ccall "stdlib.h malloc" _malloc :: Int -> IO (Ptr a)
+foreign import ccall "malloc.h malloc" _malloc :: Int -> IO (Ptr a)
hunk ./lib/System/IO/Continuation.hs 1
+module System.IO.Continuation(IOCont(),newContinuation,callContinuation) where
+
+import Jhc.JumpPoint
+import Jhc.Hole
+
+data IOCont s a = IOCont (Hole a) JumpPoint
+
+newContinuation :: (forall s . IOCont s a -> IO b) -> (a -> IO b) -> IO b
+newContinuation act cc = do
+    ref <- newHole
+    withJumpPoint__ $ \jp r -> case r of
+        False -> do act (IOCont ref jp)
+        True  -> do cc (readHole ref)
+
+callContinuation :: IOCont s a -> a -> IO b
+callContinuation (IOCont ref jp) x = do
+    fillHole ref x
+    jumpJumpPoint__ jp
+
hunk ./test/jump.hs 1
-import Jhc.JumpPoint
+import System.IO.Continuation