2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[Foreign]{Module @Foreign@}
8 {-# OPTIONS -fno-implicit-prelude #-}
12 #ifndef __PARALLEL_HASKELL__
17 #ifndef __PARALLEL_HASKELL__
18 unpackCStringFO, -- :: ForeignObj -> [Char]
19 unpackNBytesFO, -- :: ForeignObj -> Int -> [Char]
20 unpackCStringFO#, -- :: ForeignObj# -> [Char]
21 unpackNBytesFO# -- :: ForeignObj# -> Int# -> [Char]
35 %*********************************************************
37 \subsection{Type @ForeignObj@ and its operations}
39 %*********************************************************
42 #ifndef __PARALLEL_HASKELL__
43 instance CCallable ForeignObj
44 instance CCallable ForeignObj#
46 eqForeignObj :: ForeignObj -> ForeignObj -> Bool
47 makeForeignObj :: Addr -> Addr -> IO ForeignObj
48 writeForeignObj :: ForeignObj -> Addr -> IO ()
50 {- derived op - attaching a free() finaliser to a malloc() allocated reference. -}
51 makeMallocPtr :: Addr -> IO ForeignObj
53 makeForeignObj (A# obj) (A# finaliser) = IO ( \ s# ->
54 case makeForeignObj# obj finaliser s# of
55 StateAndForeignObj# s1# fo# -> IOok s1# (ForeignObj fo#))
57 writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
58 case writeForeignObj# fo# datum# s# of { s1# -> IOok s1# () } )
60 makeMallocPtr a = makeForeignObj a (``&free''::Addr)
63 = unsafePerformIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
65 instance Eq ForeignObj where
66 p == q = eqForeignObj p q
67 p /= q = not (eqForeignObj p q)
68 #endif /* !__PARALLEL_HASKELL__ */
71 %*********************************************************
73 \subsection{Type @StablePtr@ and its operations}
75 %*********************************************************
78 #ifndef __PARALLEL_HASKELL__
79 data StablePtr a = StablePtr (StablePtr# a)
80 instance CCallable (StablePtr a)
81 instance CCallable (StablePtr# a)
82 instance CReturnable (StablePtr a)
84 -- Nota Bene: it is important {\em not\/} to inline calls to
85 -- @makeStablePtr#@ since the corresponding macro is very long and we'll
86 -- get terrible code-bloat.
88 makeStablePtr :: a -> IO (StablePtr a)
89 deRefStablePtr :: StablePtr a -> IO a
90 freeStablePtr :: StablePtr a -> IO ()
92 {-# INLINE deRefStablePtr #-}
93 {-# INLINE freeStablePtr #-}
95 makeStablePtr f = IO $ \ rw1# ->
96 case makeStablePtr# f rw1# of
97 StateAndStablePtr# rw2# sp# -> IOok rw2# (StablePtr sp#)
99 deRefStablePtr (StablePtr sp#) = IO $ \ rw1# ->
100 case deRefStablePtr# sp# rw1# of
101 StateAndPtr# rw2# a -> IOok rw2# a
103 freeStablePtr sp = _ccall_ freeStablePointer sp
105 #endif /* !__PARALLEL_HASKELL__ */
108 %*********************************************************
110 \subsection{Ghastly return types}
112 %*********************************************************
115 #ifndef __PARALLEL_HASKELL__
116 data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
118 data StateAndForeignObj# s = StateAndForeignObj# (State# s) ForeignObj#
121 %*********************************************************
123 \subsection{Unpacking Foreigns}
125 %*********************************************************
127 Primitives for converting Foreigns pointing to external
128 sequence of bytes into a list of @Char@s (a renamed version
132 #ifndef __PARALLEL_HASKELL__
133 unpackCStringFO :: ForeignObj -> [Char]
134 unpackCStringFO (ForeignObj fo#) = unpackCStringFO# fo#
136 unpackCStringFO# :: ForeignObj# -> [Char]
137 unpackCStringFO# fo {- ptr. to NUL terminated string-}
141 | ch `eqChar#` '\0'# = []
142 | otherwise = C# ch : unpack (nh +# 1#)
144 ch = indexCharOffForeignObj# fo nh
146 unpackNBytesFO :: ForeignObj -> Int -> [Char]
147 unpackNBytesFO (ForeignObj fo) (I# l) = unpackNBytesFO# fo l
149 unpackNBytesFO# :: ForeignObj# -> Int# -> [Char]
150 -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
151 unpackNBytesFO# fo len
156 | otherwise = C# ch : unpack (i +# 1#)
158 ch = indexCharOffForeignObj# fo i