X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelWeak.lhs;h=1a7e643ffb4160353f0dd7f56c2c0ac32c0da2f8;hb=239e9471e104fd88ec93bf42623c3a68a496657a;hp=7d008a43eebebd4ac14c827118677035f5e4cd84;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelWeak.lhs b/ghc/lib/std/PrelWeak.lhs
index 7d008a4..1a7e643 100644
--- a/ghc/lib/std/PrelWeak.lhs
+++ b/ghc/lib/std/PrelWeak.lhs
@@ -1,5 +1,7 @@
+% ------------------------------------------------------------------------------
+% $Id: PrelWeak.lhs,v 1.16 2001/03/22 03:51:09 hwloidl Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1998
+% (c) The University of Glasgow, 1998-2000
 %
 
 \section[PrelWeak]{Module @PrelWeak@}
@@ -10,49 +12,54 @@
 module PrelWeak where
 
 import PrelGHC
-import PrelMaybe
 import PrelBase
-import PrelIOBase
-import PrelForeign
+import PrelMaybe
+import PrelIOBase	( IO(..), unIO )
 
 data Weak v = Weak (Weak# v)
 
 mkWeak  :: k				-- key
 	-> v				-- value
-	-> IO ()			-- finaliser
+	-> Maybe (IO ())		-- finalizer
 	-> IO (Weak v)			-- weak pointer
 
-mkWeak key val finaliser = IO $ \s ->
-   case mkWeak# key val finaliser s of { (# s, w #) ->
-   (# s, Weak w #) }
-
-deRefWeak :: Weak v -> IO (Maybe v)
-deRefWeak (Weak w) = IO $ \s ->
-   case deRefWeak# w s of
-	(# s, flag, w #) -> case flag of
-				0# -> (# s, Nothing #)
-				_  -> (# s, Just w #)
+mkWeak key val (Just finalizer) = IO $ \s ->
+   case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) }
+mkWeak key val Nothing = IO $ \s ->
+   case mkWeak# key val (unsafeCoerce# 0#) s of { (# s1, w #) -> (# s1, Weak w #) }
 
-mkWeakPtr :: k -> IO () -> IO (Weak k)
-mkWeakPtr key finaliser = mkWeak key key finaliser
+mkWeakPtr :: k -> Maybe (IO ()) -> IO (Weak k)
+mkWeakPtr key finalizer = mkWeak key key finalizer
 
-mkWeakPair :: k -> v -> IO () -> IO (Weak (k,v))
-mkWeakPair key val finaliser = mkWeak key (key,val) finaliser
-
-addFinaliser :: key -> IO () -> IO ()
-addFinaliser key finaliser = do
-   mkWeakPtr key finaliser		-- throw it away
+addFinalizer :: key -> IO () -> IO ()
+addFinalizer key finalizer = do
+   mkWeakPtr key (Just finalizer)	-- throw it away
    return ()
 
-addForeignFinaliser :: ForeignObj -> IO () -> IO ()
-addForeignFinaliser (ForeignObj fo) finaliser = addFinaliser fo finaliser
-
 {-
-finalise :: Weak v -> IO ()
-finalise (Weak w) = finaliseWeak# w
-
-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
+
 \end{code}