ghc/lib/std/PrelWeak.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1998
   3 %
   4
   5 \section[PrelWeak]{Module @PrelWeak@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module PrelWeak where
  11
  12 import PrelGHC
  13 import PrelMaybe
  14 import PrelBase
  15 import PrelIOBase
  16 import PrelForeign
  17
  18 data Weak v = Weak (Weak# v)
  19
  20 mkWeak  :: k                            -- key
  21         -> v                            -- value
  22         -> IO ()                        -- finaliser
  23         -> IO (Weak v)                  -- weak pointer
  24
  25 mkWeak key val finaliser = IO $ \s ->
  26    case mkWeak# key val finaliser s of { (# s1, w #) ->
  27    (# s1, Weak w #) }
  28
  29 mkWeakNoFinaliser key val = IO $ \s ->
  30    -- zero is a valid finaliser argument to mkWeak#, and means "no finaliser"
  31    case mkWeak# key val (unsafeCoerce# 0#) s of { (# s1, w #) ->
  32    (# s1, Weak w #) }
  33
  34 deRefWeak :: Weak v -> IO (Maybe v)
  35 deRefWeak (Weak w) = IO $ \s ->
  36    case deRefWeak# w s of
  37         (# s1, flag, p #) -> case flag of
  38                                 0# -> (# s1, Nothing #)
  39                                 _  -> (# s1, Just p #)
  40
  41 mkWeakPtr :: k -> IO () -> IO (Weak k)
  42 mkWeakPtr key finaliser = mkWeak key key finaliser
  43
  44 mkWeakPair :: k -> v -> IO () -> IO (Weak (k,v))
  45 mkWeakPair key val finaliser = mkWeak key (key,val) finaliser
  46
  47 addFinaliser :: key -> IO () -> IO ()
  48 addFinaliser key finaliser = do
  49    mkWeakPtr key finaliser              -- throw it away
  50    return ()
  51
  52 addForeignFinaliser :: ForeignObj -> IO () -> IO ()
  53 addForeignFinaliser (ForeignObj fo) finaliser = addFinaliser fo finaliser
  54
  55 {-
  56 finalise :: Weak v -> IO ()
  57 finalise (Weak w) = finaliseWeak# w
  58
  59 instance Eq (Weak v) where
  60   (Weak w1) == (Weak w2) = w1 `sameWeak#` w2
  61 -}
  62
  63 \end{code}