X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FGC.hs;h=687197babd98d65a1661f3ca604535cb64e1baa7;hb=3c586be8ee0075882c7538b63ac91d129eab2d12;hp=5ddd6e2bab9245e9a17804a8cda3bd5444d29cae;hpb=3b65fdd337b571a3f22df4722fb79027a5aad060;p=mate.git diff --git a/Mate/GC.hs b/Mate/GC.hs index 5ddd6e2..687197b 100644 --- a/Mate/GC.hs +++ b/Mate/GC.hs @@ -1,26 +1,28 @@ {-# 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 import qualified Data.Set as S -import Foreign.Ptr (IntPtr) +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 + cast :: Ptr b -> a + refs :: a -> IO [a] patchRefs :: a -> [a] -> IO () newRef :: a -> a -> IO () + getNewRef :: a -> IO a marked :: a -> IO Bool mark :: a -> IO () unmark :: a -> IO () - copy :: a -> IO a class PrintableRef a where printRef :: a -> IO () @@ -48,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 + +