Foreign/ForeignPtr.hs

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Foreign.ForeignPtr
   5 -- Copyright   :  (c) The University of Glasgow 2001
   6 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   7 --
   8 -- Maintainer  :  ffi@haskell.org
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- This module defines foreign pointers, i.e. addresses with associated
  13 -- finalizers.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Foreign.ForeignPtr
  18         ( ForeignPtr,            -- abstract, instance of: Eq
  19         , newForeignPtr          -- :: Ptr a -> IO () -> IO (ForeignPtr a)
  20         , addForeignPtrFinalizer -- :: ForeignPtr a -> IO () -> IO ()
  21         , withForeignPtr         -- :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  22         , foreignPtrToPtr        -- :: ForeignPtr a -> Ptr a
  23         , touchForeignPtr        -- :: ForeignPtr a -> IO ()
  24         , castForeignPtr         -- :: ForeignPtr a -> ForeignPtr b
  25         )
  26         where
  27
  28 import Foreign.Ptr
  29 import Data.Dynamic
  30
  31 #ifdef __GLASGOW_HASKELL__
  32 import GHC.Base
  33 import GHC.IOBase
  34 import GHC.Num
  35 import GHC.Err
  36 #endif
  37
  38 #include "Dynamic.h"
  39 INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
  40
  41 #ifdef __GLASGOW_HASKELL__
  42 data ForeignPtr a = ForeignPtr ForeignObj#
  43 instance CCallable (ForeignPtr a)
  44
  45 eqForeignPtr  :: ForeignPtr a -> ForeignPtr a -> Bool
  46 eqForeignPtr (ForeignPtr fo1#) (ForeignPtr fo2#) = eqForeignObj# fo1# fo2#
  47
  48 instance Eq (ForeignPtr a) where
  49     p == q = eqForeignPtr p q
  50     p /= q = not (eqForeignPtr p q)
  51
  52 newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
  53 newForeignPtr p finalizer
  54   = do fObj <- mkForeignPtr p
  55        addForeignPtrFinalizer fObj finalizer
  56        return fObj
  57
  58 addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
  59 addForeignPtrFinalizer (ForeignPtr fo) finalizer =
  60   IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) }
  61
  62 mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -}
  63 mkForeignPtr (Ptr obj) =  IO ( \ s# ->
  64     case mkForeignObj# obj s# of
  65       (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# #) )
  66
  67 touchForeignPtr :: ForeignPtr a -> IO ()
  68 touchForeignPtr (ForeignPtr fo)
  69    = IO $ \s -> case touch# fo s of s -> (# s, () #)
  70
  71 withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  72 withForeignPtr fo io
  73   = do r <- io (foreignPtrToPtr fo)
  74        touchForeignPtr fo
  75        return r
  76
  77 foreignPtrToPtr :: ForeignPtr a -> Ptr a
  78 foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo)
  79
  80 castForeignPtr (ForeignPtr a) = ForeignPtr a
  81 #endif
  82