+% ------------------------------------------------------------------------------
+% $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@}
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}