[add Jhc.Hole for a mutable value that is filled in at most once. make JumpPoints work properly.
John Meacham <john@repetae.net>**20060217034335] addfile ./lib/Jhc/Hole.hs
addfile ./test/jump.hs
hunk ./E/FromHs.hs 244
-            calt e =  Alt (LitCons x [ tvr | ~(EVar tvr) <- vs ]  ct)  e
+            calt e =  Alt (LitCons x [ case e of EVar tvr -> tvr; _ -> error $ "createMethods: "++ show e | e <- vs ]  ct)  e
hunk ./E/PrimOpt.hs 64
+            ELit (LitCons _ [a,b] (ESort EStar)) = rt
+        primopt (PrimPrim "newHole__") [y] rt  = return $ EAp (ELam y' $ eCaseTup' (EPrim (primPrim "newHole_") [EVar y'] (ltTuple' [a,b])) [a',b'] (eTuple [EVar a',EVar b'])) y where
+            [y',a',b'] = vars [getType y,a,b]
hunk ./Grin/FromE.hs 38
+import Support.Tuple
hunk ./Grin/FromE.hs 77
+tagRef = toAtom "CData.IORef.Ref"
hunk ./Grin/FromE.hs 301
+    ce (EPrim ap@(APrim (PrimPrim "newHole_") _) [_] _) = do
+        let var = Var v2 (TyPtr TyNode)
+        return $ Store (NodeC (toAtom "@hole") []) :>>= var :-> Return (tuple [pworld__,var])
+    ce (EPrim ap@(APrim (PrimPrim "fillHole__") _) [r,v,_] _) = do
+        let var = Var v2 TyNode
+            [r',v'] = args [r,v]
+        return $ gEval v' :>>= n1 :-> Update r' n1 :>>= unit :-> Return world__
hunk ./Grin/FromE.hs 369
-    ce e = error $ "ce: " ++ show (funcName,e)
+    ce e = error $ "ce: " ++ render (pprint (funcName,e))
hunk ./data/jhc_rts.c 137
-static int
-jhc_setjmp(jmp_buf *jb)
-{
-    return setjmp(*jb);
-}
-static void
-jhc_longjmp(jmp_buf *jb)
-{
-    longjmp(*jb,1);
-}
+#define jhc_setjmp(jb) setjmp(*(jmp_buf *)jb)
+#define jhc_longjmp(jb) longjmp(*(jmp_buf *)jb,1)
+
hunk ./lib/Data/IORef.hs 12
-data Ref s a
+data Ref s a = Ref a
hunk ./lib/Data/IORef.hs 18
-foreign import primitive writeRef__ :: forall s . Ref s a -> a -> s
+foreign import primitive writeRef__ :: forall s . Ref s a -> a -> s -> s
hunk ./lib/Data/IORef.hs 26
-writeIORef r v = IO $ \world -> case writeRef__ r v of
+writeIORef r v = IO $ \world -> case writeRef__ r v world of
hunk ./lib/Data/IORef.hs 29
-instance Eq (IORef a) where
-    x == y = eqRef__ x y
-    x /= y = not (eqRef__ x y)
+--instance Eq (IORef a) where
+--    x == y = eqRef__ x y
+--    x /= y = not (eqRef__ x y)
hunk ./lib/Jhc/Hole.hs 1
+
+module Jhc.Hole(Hole,newHole,fillHole,readHole) where
+
+import Jhc.IO
+
+newtype Hole a = Hole a
+
+
+
+-- | unchecked error if readHole is evaled before fillHole has filled it in.
+readHole :: Hole a -> a
+readHole (Hole x) = x
+
+
+
+foreign import primitive newHole__  :: World__ -> (s,Hole a)
+foreign import primitive fillHole__ :: Hole a -> a -> World__ ->World__
+
+newHole :: IO (Hole a)
+newHole = IO $ \world -> case newHole__ world of
+    (world',r) -> JustIO world' r
+
+fillHole :: Hole a -> a -> IO ()
+fillHole r v = IO $ \world -> case fillHole__ r v world of
+    world' -> JustIO world' ()
+
hunk ./lib/Jhc/JumpPoint.hs 4
---import Data.IORef
+import Jhc.Hole
hunk ./lib/Jhc/JumpPoint.hs 8
-type IORef a = a
-writeIORef _ _ = return ()
-newIORef a = return a
-readIORef a = return a
hunk ./lib/Jhc/JumpPoint.hs 9
-data IOCont s a = IOCont !(IORef a) !JumpPoint
+data IOCont s a = IOCont (Hole a) JumpPoint
hunk ./lib/Jhc/JumpPoint.hs 15
-    ref <- newIORef (error "shnizzle")
+    ref <- newHole
hunk ./lib/Jhc/JumpPoint.hs 24
-            arg <- readIORef ref
-            cc arg
+            cc (readHole ref)
hunk ./lib/Jhc/JumpPoint.hs 29
-    writeIORef ref x
+    fillHole ref x
hunk ./lib/Jhc/JumpPoint.hs 31
-    return $ error "callContinuation: end of the line"
hunk ./lib/Jhc/JumpPoint.hs 50
-jumpJumpPoint__ :: JumpPoint -> IO ()
-jumpJumpPoint__ jp = jhc_longjmp  jp
+jumpJumpPoint__ :: JumpPoint -> IO a
+jumpJumpPoint__ jp = jhc_longjmp  jp >> return (error "jumpJumpPoint__")
hunk ./test/jump.hs 1
+import Jhc.JumpPoint
+
+
+go :: IOCont s String -> IO ()
+go cont = do
+    putStrLn "hello"
+    --newContinuation (go' cont) (const undefined)
+    callContinuation cont "there"
+    putStrLn "you"
+
+
+main = do
+    newContinuation go putStrLn