GHC/Weak.lhs

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