GHC/Weak.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: Weak.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1998-2000
   5 %
   6
   7 \section[GHC.Weak]{Module @GHC.Weak@}
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module GHC.Weak where
  13
  14 import GHC.Base
  15 import Data.Maybe
  16 import GHC.IOBase       ( IO(..), unIO )
  17
  18 data Weak v = Weak (Weak# v)
  19
  20 mkWeak  :: k                            -- key
  21         -> v                            -- value
  22         -> Maybe (IO ())                -- finalizer
  23         -> IO (Weak v)                  -- weak pointer
  24
  25 mkWeak key val (Just finalizer) = IO $ \s ->
  26    case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) }
  27 mkWeak key val Nothing = IO $ \s ->
  28    case mkWeak# key val (unsafeCoerce# 0#) s of { (# s1, w #) -> (# s1, Weak w #) }
  29
  30 mkWeakPtr :: k -> Maybe (IO ()) -> IO (Weak k)
  31 mkWeakPtr key finalizer = mkWeak key key finalizer
  32
  33 addFinalizer :: key -> IO () -> IO ()
  34 addFinalizer key finalizer = do
  35    mkWeakPtr key (Just finalizer)       -- throw it away
  36    return ()
  37
  38 {-
  39 Instance Eq (Weak v) where
  40   (Weak w1) == (Weak w2) = w1 `sameWeak#` w2
  41 -}
  42
  43
  44 -- run a batch of finalizers from the garbage collector.  We're given
  45 -- an array of finalizers and the length of the array, and we just
  46 -- call each one in turn.
  47 --
  48 -- the IO primitives are inlined by hand here to get the optimal
  49 -- code (sigh) --SDM.
  50
  51 runFinalizerBatch :: Int -> Array# (IO ()) -> IO ()
  52 runFinalizerBatch (I# n) arr =
  53    let  go m  = IO $ \s ->
  54                   case m of
  55                   0# -> (# s, () #)
  56                   _  -> let m' = m -# 1# in
  57                         case indexArray# arr m' of { (# io #) ->
  58                         case unIO io s of          { (# s, _ #) ->
  59                         unIO (go m') s
  60                         }}
  61    in
  62         go n
  63
  64 \end{code}