TwoFinger wip

diff --git a/src/MarkCompact/TwoFinger.hs b/src/MarkCompact/TwoFinger.hs
index 1cc174c780e2db4b3e55862acfbfb54b4c5dc94e..9667e13fb77d18b1b85856cbb747c7cf74f5a5ee 100644 (file)
--- a/src/MarkCompact/TwoFinger.hs
+++ b/src/MarkCompact/TwoFinger.hs
@@ -5,7 +5,8 @@
 module MarkCompact.TwoFinger where
 
 import Debug.Trace 
-import Data.List (sortBy)
+import Data.Ord (Down(..))
+import Data.List
 import Data.Function (on)
 import Data.Array
 import Control.Monad.State
@@ -112,9 +113,7 @@ allocate v = do
       pure $ Right $ ObjectPtr p
     Nothing -> pure $ Left "Out of memory"
   where
-      findIndexWithNothing h = foldl step Nothing $ sortBy (flip compare `on` fst) $ assocs h
-      step _ (i, Nothing) = Just i
-      step acc _ = acc
+      findIndexWithNothing h = ((+)1) <$> (elemIndex Nothing $ map snd $ sortBy (flip compare `on` Down . fst) $ assocs h)
 
 mark :: [ObjectPtr] -> Heap -> Bitmap -> Bitmap
 mark [] _ bm = bm
@@ -146,7 +145,6 @@ markFromRoots = do
 
 collect :: GcM ()
 collect = do
-  traceShowM "mark!!!"
   markFromRoots
   compact
 
@@ -170,17 +168,17 @@ relocate start end = go start end
       | free < scan = do
         gc <- get
         let bm = bitmap gc
-        let indicesToUnmark = fmap fst $ takeWhile (\(_, marked) -> marked) $ assocs bm 
+        let indicesToUnmark = fmap fst $ takeWhile (\(_, marked) -> marked) $ sortBy (flip compare `on` Down . fst) $ assocs bm 
             free' = if indicesToUnmark == [] then free else maximum indicesToUnmark
             bm' = bm // [(i, False) | i <- indicesToUnmark] 
-        put $ gc { bitmap = traceShow (free', indicesToUnmark) bm' }
+        put $ gc { bitmap = traceShow (free', indicesToUnmark) bm', heap = heap gc // [(i, Nothing) | (i, x) <- assocs bm, x == False]  }
 
         let
-          findIndexStep marked (ok, idx)
-            | not marked && idx > free' = (ok, idx - 1)
-            | otherwise = (True, idx) 
-          scan' = snd $ foldr findIndexStep (False, scan) bm'
-    
+          findIndexStep (_, marked) idx
+            | not marked && idx > free' = idx - 1
+            | otherwise = idx 
+          scan' = traceShowId $ foldr findIndexStep scan $ traceShowId $ take scan $ sortBy (flip compare `on` Down . fst) $ assocs bm'
+       
         if scan' > free' then do
           put $ gc { bitmap = bm' // [(scan', False)]}
 
@@ -230,9 +228,12 @@ main = do
         ptr7 <- new (IntVal 7) 
         ptr8 <- new (IntVal 8) 
 
+        writeToRoots 5 ptr6
 
         collect
 
-
-        return [ptr, ptr2]
+        ptr2' <- new (IntVal 2)
+        collect
+        
+        return [ptr, ptr2, ptr2']
   print res