ghc/lib/std/PrelWeak.lhs

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