[basic IORef support added
John Meacham <john@repetae.net>**20060427064341] hunk ./E/WorkerWrapper.hs 69
+workWrap' _dataTable tvr _e | getProperty prop_NOINLINE tvr  = fail "not going to be inlined"
hunk ./Grin/DeadCode.hs 121
-            g (Update (Var v _) n@(~(NodeC x vs)))
+            g (Update vv@(Var v _) n@(~(NodeC x vs)))
hunk ./Grin/DeadCode.hs 125
-                | otherwise = addRule $ doNode n
+                | otherwise = addRule $ (doNode vv) `mappend` (doNode n)
hunk ./Grin/FromE.hs 343
+    ce (EPrim ap@(APrim (PrimPrim "writeRef__") _) [r,v,_] _) = do
+        let var = Var v2 TyNode
+            [r',v'] = args [r,v]
+        return $ Update r' (NodeC (toAtom "CData.IORef.IORef") [v'])
hunk ./Grin/Grin.hs 28
+    isMutableNodeTag,
hunk ./Grin/Grin.hs 641
+ref_tag =  (toAtom "CData.IORef.IORef")
+
+isMutableNodeTag t = t == ref_tag
+
hunk ./Grin/Grin.hs 647
+valIsConstant (NodeC t _) | isMutableNodeTag t = False
hunk ./Grin/Optimize.hs 92
-isOmittable (Store (NodeC n _)) | n == tagHole = False
+isOmittable (Store (NodeC n _)) | isMutableNodeTag n || n == tagHole = False
hunk ./Grin/Optimize.hs 123
-        h (Store (NodeC t xs)) | t `member` sset = do
+        h (Store (NodeC t xs)) | not (isMutableNodeTag t), t `member` sset = do
hunk ./Grin/Optimize.hs 127
-        h (Update v (NodeC t xs)) | t `member` sset = do
+        h (Update v (NodeC t xs)) | not (isMutableNodeTag t), t `member` sset = do
hunk ./Grin/Simplify.hs 53
+valIsMutable (NodeC t _) = isMutableNodeTag t
+valIsMutable _ = False
+
hunk ./Grin/Simplify.hs 83
-    gs (Store n) | valIsNF n = do
+    gs (Store n) | valIsNF n, not (valIsMutable n) = do
hunk ./Grin/Simplify.hs 162
-    getCS (b,app@App{})  = return $ Map.singleton app (Return b)
+    --getCS (b,app@App{})  = return $ Map.singleton app (Return b)
hunk ./Grin/Simplify.hs 164
-    getCS (b@Var {},Store v@(NodeC t _)) | tagIsWHNF t, t /= tagHole = return $ Map.fromList [(Store v,Return b),(Fetch b,Return v),(App funcEval [b] TyNode,Return v)]
-    getCS (b@Var {},Store v@(NodeC t _)) | t /= tagHole = return $ Map.fromList [(Store v,Return b)]
+    getCS (b@Var {},Store v@(NodeC t _)) | not (isMutableNodeTag t), tagIsWHNF t, t /= tagHole = return $ Map.fromList [(Store v,Return b),(Fetch b,Return v),(App funcEval [b] TyNode,Return v)]
+    getCS (b@Var {},Store v@(NodeC t _)) | not (isMutableNodeTag t), t /= tagHole = return $ Map.fromList [(Store v,Return b)]
hunk ./Grin/Simplify.hs 311
-    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ :>>= lr) | fa == funcEval, v == v' = do
+    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ :>>= lr) | not (valIsMutable t), fa == funcEval, v == v' = do
hunk ./Grin/Simplify.hs 314
-    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ) | fa == funcEval, v == v' = do
+    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ) | not (valIsMutable t), fa == funcEval, v == v' = do
hunk ./Grin/Simplify.hs 534
+                    | a `elem` noInline = Map.empty
hunk ./Grin/Simplify.hs 546
+noInline = [toAtom "fData.IORef.readIORef", toAtom "fData.IORef.writeIORef"]
+
hunk ./lib/base/Data/IORef.hs 2
-    IORef,	      -- abstract, instance of: Eq
+    IORef(),	      -- abstract, instance of: Eq
hunk ./lib/base/Data/IORef.hs 12
-data Ref s a = Ref a
+data IORef a = IORef a
hunk ./lib/base/Data/IORef.hs 14
-type IORef = Ref World__
+{-# NOINLINE newIORef #-}
+newIORef :: a -> IO (IORef a)
+newIORef v = do
+    v' <- strictReturn v
+    return (IORef v')
hunk ./lib/base/Data/IORef.hs 20
-foreign import primitive newRef__ :: forall s . a -> s -> (s,Ref s a)
-foreign import primitive readRef__ :: forall s . Ref s a -> s -> (s,a)
-foreign import primitive writeRef__ :: forall s . Ref s a -> a -> s -> s
+{-# NOINLINE readIORef #-}
+readIORef :: IORef a -> IO a
+readIORef r = do
+    --v <- strictReturn r
+    case r of
+        IORef r -> strictReturn r
hunk ./lib/base/Data/IORef.hs 27
-foreign import primitive eqRef__ :: forall s . Ref s a -> Ref s a -> Bool
hunk ./lib/base/Data/IORef.hs 28
-newIORef v = IO $ \_ world -> case newRef__ v world of
-    (world',r) -> JustIO world' r
-readIORef r = IO $ \_ world -> case readRef__ r world of
-    (world',v) -> JustIO world' v
-writeIORef r v = IO $ \_ world -> case writeRef__ r v world of
-    world' -> JustIO world' ()
+--foreign import primitive newRef__ :: forall s . a -> s -> (s,Ref s a)
+--foreign import primitive readRef__ :: forall s . Ref s a -> s -> (s,a)
+foreign import primitive writeRef__ ::  IORef a -> a -> World__ -> World__
+
+{-# NOINLINE writeIORef #-}
+writeIORef :: IORef a -> a -> IO ()
+writeIORef r v = do
+    IO $ \_ world -> case writeRef__ r v world of
+        world' -> JustIO world' ()
+
+--foreign import primitive eqRef__ :: forall s . Ref s a -> Ref s a -> Bool
+
+--newIORef v = IO $ \_ world -> case newRef__ v world of
+--    (world',r) -> JustIO world' r
+--readIORef r = IO $ \_ world -> case readRef__ r world of
+--    (world',v) -> JustIO world' v
+--writeIORef r v = IO $ \_ world -> case writeRef__ r v world of
+--    world' -> JustIO world' ()