[project @ 2000-05-22 13:09:29 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / PrelWeak.lhs

diff --git a/ghc/lib/std/PrelWeak.lhs b/ghc/lib/std/PrelWeak.lhs
index 97a7bf5..d7cfaac 100644 (file)
--- a/ghc/lib/std/PrelWeak.lhs
+++ b/ghc/lib/std/PrelWeak.lhs
@@ -13,7 +13,7 @@ import PrelGHC
 import PrelBase
 import PrelMaybe
 -- NOTE: To break a cycle, ForeignObj is not in PrelForeign, but PrelIOBase!
-import PrelIOBase      ( IO(..), ForeignObj(..) )
+import PrelIOBase      ( IO(..), unIO, ForeignObj(..) )
 
 #ifndef __PARALLEL_HASKELL__
 
@@ -41,10 +41,31 @@ addForeignFinalizer :: ForeignObj -> IO () -> IO ()
 addForeignFinalizer (ForeignObj fo) finalizer = addFinalizer fo finalizer
 
 {-
-instance Eq (Weak v) where
+Instance Eq (Weak v) where
   (Weak w1) == (Weak w2) = w1 `sameWeak#` w2
 -}
 
+
+-- run a batch of finalizers from the garbage collector.  We're given 
+-- an array of finalizers and the length of the array, and we just
+-- call each one in turn.
+--
+-- the IO primitives are inlined by hand here to get the optimal
+-- code (sigh) --SDM.
+
+runFinalizerBatch :: Int -> Array# (IO ()) -> IO ()
+runFinalizerBatch (I# n) arr = 
+   let  go m  = IO $ \s ->
+                 case m of 
+                 0# -> (# s, () #)
+                 _  -> let m' = m -# 1# in
+                       case indexArray# arr m' of { (# io #) -> 
+                       case unIO io s of          { (# s, _ #) -> 
+                       unIO (go m') s
+                       }}
+   in
+        go n
+
 #endif
 
 \end{code}