scratch/GC: playground for datastructures to be used in GC - probably...

[mate.git] / scratch / GC.hs

diff --git a/scratch/GC.hs b/scratch/GC.hs
index d2bece279834a70f20f694239f18de856bcdb1cd..c78eb506629f6922a09995f00b12f429b88660f3 100644 (file)
--- a/scratch/GC.hs
+++ b/scratch/GC.hs
@@ -1,64 +1,60 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-module GC 
-  ({- dont export generic versions for high performance ;-) -}) where
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module GC where
 
 import Control.Monad
 
-import Data.Foldable hiding (mapM_)
-
 import Foreign.Ptr
 import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
 import Foreign.Storable
+import Foreign.C.Types
 import GHC.Int
+import Text.Printf
 
+class RefObject a where
+  mem  :: a -> IntPtr 
+  refs :: a -> [IntPtr]
 
-class RefObj a where
-  payload :: a -> IO IntPtr
-  refs    :: a -> IO [a]
-  marked  :: a -> IO Bool
-  mark    :: a -> IO ()
 
+data RefObj = RefObj IntPtr [IntPtr] deriving Show
 
-instance RefObj (Ptr a) where
-  payload     = return . ptrToIntPtr
-  refs        = unpackRefs . castPtr
-  marked      = markedRef
-  mark        = markRef
+instance RefObject RefObj where
+  mem  (RefObj mem _ ) = mem
+  refs (RefObj _ refs) = refs
 
+data Succ = forall a. (RefObject a) => Succ (a -> [a])
 
-idOff           = 0x0
-numberOfObjsOff = 0x4
-fieldsOff = 0xC
-markedOff = 0x8
+obj2 = do buffer <- mallocBytes 4
+          pokeByteOff buffer 0 (0::Int32)
+          return buffer
 
-unpackRefs :: Ptr Int32 -> IO [Ptr b]
-unpackRefs ptr = do  --dereference number of objs; mark field skipped via fieldsOffset
-                    numberOfObjs <- peekByteOff ptr numberOfObjsOff :: IO Int32
-                    mapM (peekElemOff (ptr `plusPtr` fieldsOff)) [0..fromIntegral $ numberOfObjs-1]
+obj3 = do buffer <- mallocBytes 4
+          pokeByteOff buffer 0 (0::Int32)
+          return buffer
 
-markedRef :: Ptr a -> IO Bool
-markedRef ptr = liftM ((/=0) . fromIntegral) (peekByteOff ptr markedOff :: IO Int32)
+obj1 f g = do buffer <- mallocBytes 12
+              pokeByteOff buffer 0 (2::Int32)
+              pokeByteOff buffer 4 f
+              pokeByteOff buffer 8 g
+              return buffer
 
-markRef :: Ptr a -> IO ()
-markRef ptr = pokeByteOff ptr markedOff (1::Int32)
+ptrToRefObj ptr = do objCount <- peek ptr :: IO Int32
+                     let objsBase = ptr `plusPtr` 4
+                     objs <- mapM ((liftM ptrToIntPtr) . peekElemOff objsBase . fromIntegral) [0..objCount-1]
+                     return $ RefObj (ptrToIntPtr ptr) objs
 
-markTree :: RefObj a => a -> IO ()
-markTree root = marked root >>= (`when` continue) . not
-  where continue = mark root >> refs root >>= mapM_  markTree
+test1 = do f <- obj2
+           g <- obj3
+           (print . ptrToIntPtr) f
+           (print . ptrToIntPtr) g
+           ptrToRefObj =<< obj1 f g
 
+traverse :: (RefObject a) => (IntPtr -> IO a) -> a -> [a] -> IO [a]
+traverse dereference x ws = do children <- mapM dereference (refs x)
+                               undefined
 
-emptyObj id  = do mem <- mallocBytes 0xC
-                  pokeArray mem [id,0,0::Int32]
-                  return mem
+succMem :: Ptr a -> Succ
+succMem =undefined-- Succ (\_ -> obj1
 
-twoRefs = do mem <- mallocBytes 0x14
-             -- idOfObj; numberofObj; marked waste memory Int32
-             pokeArray mem [0::Int32,2,0]
-             obj1 <- emptyObj 1
-             obj2 <- emptyObj 2
-             pokeByteOff mem 0xC obj1
-             pokeByteOff mem (0xC+0x4) obj2
-             return mem