ghc/lib/std/PrelForeign.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelForeign.lhs,v 1.17 2001/01/11 17:25:57 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 PrelBase
  16 import PrelPtr
  17 \end{code}
  18
  19 %*********************************************************
  20 %*                                                      *
  21 \subsection{ForeignPtr}
  22 %*                                                      *
  23 %*********************************************************
  24
  25 \begin{code}
  26 #ifndef __PARALLEL_HASKELL__
  27 newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
  28 newForeignPtr p finalizer
  29   = do fObj <- mkForeignPtr p
  30        addForeignPtrFinalizer fObj finalizer
  31        return fObj
  32
  33 addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
  34 addForeignPtrFinalizer (ForeignPtr fo) finalizer =
  35   IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) }
  36
  37 mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -}
  38 mkForeignPtr (Ptr obj) =  IO ( \ s# ->
  39     case mkForeignObj# obj s# of
  40       (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# #) )
  41
  42 touchForeignPtr :: ForeignPtr a -> IO ()
  43 touchForeignPtr (ForeignPtr fo)
  44    = IO $ \s -> case touch# fo s of s -> (# s, () #)
  45
  46 withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  47 withForeignPtr fo io
  48   = do r <- io (foreignPtrToPtr fo)
  49        touchForeignPtr fo
  50        return r
  51
  52 foreignPtrToPtr :: ForeignPtr a -> Ptr a
  53 foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo)
  54
  55 castForeignPtr (ForeignPtr a) = ForeignPtr a
  56 #endif
  57 \end{code}
  58
  59