ghc/lib/std/PrelStable.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelStable.lhs,v 1.1 1999/01/26 12:25:01 simonm Exp $
   3 %
   4 % (c) The GHC Team, 1992-1999
   5 %
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module PrelStable
  11         ( StablePtr(..)
  12         , makeStablePtr   -- :: a -> IO (StablePtr a)
  13         , deRefStablePtr  -- :: StablePtr a -> a
  14         , freeStablePtr   -- :: StablePtr a -> IO ()
  15    ) where
  16
  17 import PrelBase
  18 import PrelIOBase
  19
  20 -----------------------------------------------------------------------------
  21 -- Stable Pointers
  22
  23 data StablePtr  a = StablePtr  (StablePtr#  a)
  24
  25 instance CCallable   (StablePtr a)
  26 instance CCallable   (StablePtr# a)
  27 instance CReturnable (StablePtr a)
  28
  29 makeStablePtr  :: a -> IO (StablePtr a)
  30 deRefStablePtr :: StablePtr a -> IO a
  31 freeStablePtr  :: StablePtr a -> IO ()
  32
  33 makeStablePtr a = IO $ \ s ->
  34     case makeStablePtr# a s of (# s', sp #) -> (# s', StablePtr sp #)
  35
  36 deRefStablePtr (StablePtr sp) = IO $ \s -> deRefStablePtr# sp s
  37
  38 freeStablePtr  sp = _ccall_ freeStablePtr sp
  39
  40 instance Eq (StablePtr a) where
  41     (StablePtr sp1) == (StablePtr sp2) =
  42         case eqStablePtr# sp1 sp2 of
  43            0# -> False
  44            _  -> True
  45 \end{code}