X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FGC.hs;h=687197babd98d65a1661f3ca604535cb64e1baa7;hb=3c586be8ee0075882c7538b63ac91d129eab2d12;hp=b22af7af511d54e7fb71f6e0372bc8804dcfcd12;hpb=23d1abdb070795c9052cc13b40f2287041b63a41;p=mate.git

diff --git a/Mate/GC.hs b/Mate/GC.hs
index b22af7a..687197b 100644
--- a/Mate/GC.hs
+++ b/Mate/GC.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Mate.GC 
-  ( RefObj(..), PrintableRef(..), traverseIO, markTree'' 
+  ( RefObj(..), PrintableRef(..), traverseIO, markTree'', patchAllRefs 
     {- dont export generic versions for high performance -> remove for production -}) where
 
 import Control.Monad
@@ -8,7 +8,7 @@ import qualified Data.Set as S
 
 import Foreign.Ptr (IntPtr, Ptr)
 
-class (Eq a, Ord a) => RefObj a where
+class (Eq a, Ord a, Show a) => RefObj a where
   
   payload :: a -> IO IntPtr
   size    :: a -> IO Int
@@ -17,6 +17,7 @@ class (Eq a, Ord a) => RefObj a where
   refs      :: a -> IO [a]
   patchRefs :: a -> [a] -> IO ()
   newRef    :: a -> a -> IO ()
+  getNewRef :: a -> IO a
   
   marked  :: a -> IO Bool
   mark    :: a -> IO ()
@@ -49,3 +50,17 @@ markTree :: RefObj a => a -> IO ()
 markTree root = marked root >>= (`unless` continue)
   where continue = mark root >> refs root >>= mapM_  markTree
 
+
+-- | This object is alive. so its children are alive. patch child references to point
+-- to childrens new references
+patchRefsObj :: (RefObj a) => a -> IO ()
+patchRefsObj obj = do obj' <- getNewRef obj 
+                      fields <- refs obj
+                      newRefs <- mapM getNewRef fields
+                      print newRefs
+                      patchRefs obj' newRefs                 
+
+patchAllRefs :: (RefObj a) => [a] -> IO ()
+patchAllRefs = mapM_ patchRefsObj
+
+