ghc/lib/std/PrelForeign.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelForeign.lhs,v 1.19 2001/05/18 16:54:05 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[Foreign]{Module @Foreign@}
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module PrelForeign where
  13
  14 import PrelIOBase
  15 import PrelNum                  -- for fromInteger
  16 import PrelBase
  17 import PrelPtr
  18 \end{code}
  19
  20 %*********************************************************
  21 %*                                                      *
  22 \subsection{ForeignPtr}
  23 %*                                                      *
  24 %*********************************************************
  25
  26 \begin{code}
  27 data ForeignPtr a = ForeignPtr ForeignObj#
  28 instance CCallable (ForeignPtr a)
  29
  30 eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool
  31 eqForeignPtr mp1 mp2
  32   = unsafePerformIO (primEqForeignPtr mp1 mp2) /= (0::Int)
  33
  34 foreign import "eqForeignObj" unsafe
  35   primEqForeignPtr :: ForeignPtr a -> ForeignPtr a -> IO Int
  36
  37 instance Eq (ForeignPtr a) where
  38     p == q = eqForeignPtr p q
  39     p /= q = not (eqForeignPtr p q)
  40
  41 newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
  42 newForeignPtr p finalizer
  43   = do fObj <- mkForeignPtr p
  44        addForeignPtrFinalizer fObj finalizer
  45        return fObj
  46
  47 addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
  48 addForeignPtrFinalizer (ForeignPtr fo) finalizer =
  49   IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) }
  50
  51 mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -}
  52 mkForeignPtr (Ptr obj) =  IO ( \ s# ->
  53     case mkForeignObj# obj s# of
  54       (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# #) )
  55
  56 touchForeignPtr :: ForeignPtr a -> IO ()
  57 touchForeignPtr (ForeignPtr fo)
  58    = IO $ \s -> case touch# fo s of s -> (# s, () #)
  59
  60 withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  61 withForeignPtr fo io
  62   = do r <- io (foreignPtrToPtr fo)
  63        touchForeignPtr fo
  64        return r
  65
  66 foreignPtrToPtr :: ForeignPtr a -> Ptr a
  67 foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo)
  68
  69 castForeignPtr (ForeignPtr a) = ForeignPtr a
  70
  71 \end{code}
  72
  73