From: Harald Steinlechner <haraldsteinlechner@gmail.com>
Date: Sun, 26 Aug 2012 14:50:00 +0000 (+0200)
Subject: scratch/GC: playground for datastructures to be used in GC - probably...
X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=280c9c440fc6117911c329f9ce5556bac75b359b

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

diff --git a/scratch/GC.hs b/scratch/GC.hs
new file mode 100644
index 0000000..c78eb50
--- /dev/null
+++ b/scratch/GC.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module GC where
+
+import Control.Monad
+
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Foreign.C.Types
+import GHC.Int
+import Text.Printf
+
+class RefObject a where
+  mem  :: a -> IntPtr 
+  refs :: a -> [IntPtr]
+
+
+data RefObj = RefObj IntPtr [IntPtr] deriving Show
+
+instance RefObject RefObj where
+  mem  (RefObj mem _ ) = mem
+  refs (RefObj _ refs) = refs
+
+data Succ = forall a. (RefObject a) => Succ (a -> [a])
+
+obj2 = do buffer <- mallocBytes 4
+          pokeByteOff buffer 0 (0::Int32)
+          return buffer
+
+obj3 = do buffer <- mallocBytes 4
+          pokeByteOff buffer 0 (0::Int32)
+          return buffer
+
+obj1 f g = do buffer <- mallocBytes 12
+              pokeByteOff buffer 0 (2::Int32)
+              pokeByteOff buffer 4 f
+              pokeByteOff buffer 8 g
+              return buffer
+
+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
+
+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
+
+succMem :: Ptr a -> Succ
+succMem =undefined-- Succ (\_ -> obj1
+
+
+