[project @ 2001-06-28 14:15:04 by simonmar]
[packages/pretty.git] / 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