home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Weak.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  2.4 KB  |  80 lines
  1. -- A first cut at implementing the (key,value) form of Weak pointers.
  2. --
  3. -- Notes (please refer to the draft specification for background):
  4. --
  5. --  - mkWeakPair is listed in the signature specification, but its
  6. --    semantics are not described, and hence we have not provided
  7. --    an implementation here.
  8. --
  9. --  - Programmers using weak pointers should call runFinalizer at
  10. --    regular intervals to ensure that finalizers are scheduled for
  11. --    execution.  This implementation provides functions runFinalizer,
  12. --    finalizerWaiting, and runAllFinalizers to provide programmers with
  13. --    control over the execution of finalizers.  None of these functions
  14. --    are part of the current specification.
  15. --
  16. -- Tested with Hugs 98.
  17.  
  18. module Weak(Weak,
  19.         mkWeak, mkWeakPtr, mkWeakPair,
  20.             deRefWeak, finalize, addFinalizer, replaceFinalizer,
  21.         runFinalizer, finalizerWaiting, runAllFinalizers ) where
  22.  
  23. data Weak a
  24.  
  25. primitive mkWeak    :: k -> v -> Maybe (IO ()) -> IO (Weak v)
  26. primitive deRefWeak :: Weak v -> IO (Maybe v)
  27. primitive replaceFinalizer :: Weak v -> Maybe (IO ()) -> IO (Maybe (IO ()))
  28. primitive finalize  :: Weak v -> IO ()
  29. primitive weakPtrEq :: Weak a -> Weak a -> Bool
  30.  
  31. instance Eq (Weak a) where
  32.   (==) = weakPtrEq
  33.  
  34. mkWeakPtr           :: k -> Maybe (IO ()) -> IO (Weak k)
  35. mkWeakPtr v f        = mkWeak v v f
  36.  
  37. mkWeakPair          :: k -> v -> Maybe (IO ()) -> IO (Weak (k,v))
  38. mkWeakPair k v f     = mkWeak k (k,v) f
  39.  
  40. addFinalizer        :: k -> IO () -> IO ()
  41. addFinalizer v f     = do mkWeakPtr v (Just f)
  42.               return ()
  43.  
  44. primitive runFinalizer     :: IO ()
  45. primitive finalizerWaiting :: IO Bool
  46.  
  47. runAllFinalizers    :: IO ()
  48. runAllFinalizers     = do waiting <- finalizerWaiting
  49.               if waiting then do runFinalizer
  50.                          runAllFinalizers
  51.                      else return ()
  52.  
  53. {- for testing purposes
  54. primitive gc "primGC" :: IO ()
  55.  
  56. -- not a CAF!
  57. test z = do
  58.   { let k = [z]        -- use a list so we're sure it's heap allocated
  59.   ; print k        -- this makes sure x is in whnf
  60.   ; w <- mkWeak k "value" (Just (putStrLn ("Finalizer for "++show k)))
  61.             -- note that the finalizer uses the key, but
  62.             -- this shouldn't keep the weak ptr alive!
  63.   ; showWeakPtr w
  64.   ; gc
  65.   ; print k        -- this makes sure k is still alive after the GC
  66.   ; showWeakPtr w    -- so it's probably still alive here
  67.   ; gc
  68.   ; showWeakPtr w    -- but ought to be dead by here
  69.   }
  70.  
  71. showWeakPtr :: Show a => Weak a -> IO ()
  72. showWeakPtr w = do
  73.   { x <- deRefWeak w
  74.   ; print x
  75.   }
  76.  
  77. -}
  78.  
  79. -- End of module Weak
  80.