1 % ------------------------------------------------------------------------------
2 % $Id: PrelForeign.lhs,v 1.16 2000/12/11 16:56:47 simonmar Exp $
4 % (c) The University of Glasgow, 1994-2000
7 \section[Foreign]{Module @Foreign@}
10 {-# OPTIONS -fno-implicit-prelude #-}
14 #ifndef __PARALLEL_HASKELL__
17 -- the rest are deprecated
28 import PrelWeak ( addForeignFinalizer )
31 %*********************************************************
33 \subsection{ForeignPtr}
35 %*********************************************************
38 data ForeignPtr a = ForeignPtr ForeignObj#
39 instance CCallable (ForeignPtr a)
42 %*********************************************************
44 \subsection{Type @ForeignObj@ and its operations}
46 %*********************************************************
48 mkForeignObj and writeForeignObj are the building blocks
49 for makeForeignObj, they can probably be nuked in the future.
52 #ifndef __PARALLEL_HASKELL__
53 --instance CCallable ForeignObj
54 --instance CCallable ForeignObj#
56 makeForeignObj :: Addr -> IO () -> IO ForeignObj
57 makeForeignObj addr finalizer = do
58 fObj <- mkForeignObj addr
59 addForeignFinalizer fObj finalizer
62 mkForeignObj :: Addr -> IO ForeignObj
63 mkForeignObj (A# obj) = IO ( \ s# ->
64 case mkForeignObj# obj s# of
65 (# s1#, fo# #) -> (# s1#, ForeignObj fo# #) )
67 writeForeignObj :: ForeignObj -> Addr -> IO ()
68 writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
69 case writeForeignObj# fo# datum# s# of { s1# -> (# s1#, () #) } )
70 #endif /* !__PARALLEL_HASKELL__ */
73 %*********************************************************
75 \subsection{Unpacking Foreigns}
77 %*********************************************************
79 Primitives for converting Foreigns pointing to external
80 sequence of bytes into a list of @Char@s (a renamed version
84 #ifndef __PARALLEL_HASKELL__
85 unpackCStringFO :: ForeignObj -> [Char]
86 unpackCStringFO (ForeignObj fo#) = unpackCStringFO# fo#
88 unpackCStringFO# :: ForeignObj# -> [Char]
89 unpackCStringFO# fo {- ptr. to NUL terminated string-}
93 | ch `eqChar#` '\0'# = []
94 | otherwise = C# ch : unpack (nh +# 1#)
96 ch = indexCharOffForeignObj# fo nh
98 unpackNBytesFO :: ForeignObj -> Int -> [Char]
99 unpackNBytesFO (ForeignObj fo) (I# l) = unpackNBytesFO# fo l
101 unpackNBytesFO# :: ForeignObj# -> Int# -> [Char]
102 -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
103 unpackNBytesFO# fo len
108 | otherwise = C# ch : unpack (i +# 1#)
110 ch = indexCharOffForeignObj# fo i