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   :  experimental
  10 -- Portability :  non-portable
  11 --
  12 -- $Id: ForeignPtr.hs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
  13 --
  14 -- This module defines foreign pointers, i.e. addresses with associated
  15 -- finalizers.
  16 --
  17 -----------------------------------------------------------------------------
  18
  19 module Foreign.ForeignPtr
  20         ( ForeignPtr,            -- abstract, instance of: Eq
  21         , newForeignPtr          -- :: Ptr a -> IO () -> IO (ForeignPtr a)
  22         , addForeignPtrFinalizer -- :: ForeignPtr a -> IO () -> IO ()
  23         , withForeignPtr         -- :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  24         , foreignPtrToPtr        -- :: ForeignPtr a -> Ptr a
  25         , touchForeignPtr        -- :: ForeignPtr a -> IO ()
  26         , castForeignPtr         -- :: ForeignPtr a -> ForeignPtr b
  27         )
  28         where
  29
  30 import Foreign.Ptr
  31 import Data.Dynamic
  32
  33 #ifdef __GLASGOW_HASKELL__
  34 import GHC.Base
  35 import GHC.IOBase
  36 import GHC.Num
  37 import GHC.Err
  38 #endif
  39
  40 #include "Dynamic.h"
  41 INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
  42
  43 #ifdef __GLASGOW_HASKELL__
  44 data ForeignPtr a = ForeignPtr ForeignObj#
  45 instance CCallable (ForeignPtr a)
  46
  47 eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool
  48 eqForeignPtr mp1 mp2
  49   = unsafePerformIO (primEqForeignPtr mp1 mp2) /= (0::Int)
  50
  51 foreign import "eqForeignObj" unsafe
  52   primEqForeignPtr :: ForeignPtr a -> ForeignPtr a -> IO Int
  53
  54 instance Eq (ForeignPtr a) where
  55     p == q = eqForeignPtr p q
  56     p /= q = not (eqForeignPtr p q)
  57
  58 newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
  59 newForeignPtr p finalizer
  60   = do fObj <- mkForeignPtr p
  61        addForeignPtrFinalizer fObj finalizer
  62        return fObj
  63
  64 addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
  65 addForeignPtrFinalizer (ForeignPtr fo) finalizer =
  66   IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) }
  67
  68 mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -}
  69 mkForeignPtr (Ptr obj) =  IO ( \ s# ->
  70     case mkForeignObj# obj s# of
  71       (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# #) )
  72
  73 touchForeignPtr :: ForeignPtr a -> IO ()
  74 touchForeignPtr (ForeignPtr fo)
  75    = IO $ \s -> case touch# fo s of s -> (# s, () #)
  76
  77 withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  78 withForeignPtr fo io
  79   = do r <- io (foreignPtrToPtr fo)
  80        touchForeignPtr fo
  81        return r
  82
  83 foreignPtrToPtr :: ForeignPtr a -> Ptr a
  84 foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo)
  85
  86 castForeignPtr (ForeignPtr a) = ForeignPtr a
  87 #endif
  88