49d5a2d756539560dafd0cf0251c5702c5c9bea8
[packages/old-time.git] / Foreign / C / String.hs
1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Foreign.C.String
5 -- Copyright : (c) The FFI task force 2001
6 -- License : BSD-style (see the file libraries/base/LICENSE)
7 --
8 -- Maintainer : ffi@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
11 --
12 -- Utilities for primitive marshaling
13 --
14 -----------------------------------------------------------------------------
15
16 module Foreign.C.String ( -- representation of strings in C
17
18 CString, -- = Ptr CChar
19 CStringLen, -- = (CString, Int)
20
21 -- conversion of C strings into Haskell strings
22 --
23 peekCString, -- :: CString -> IO String
24 peekCStringLen, -- :: CStringLen -> IO String
25
26 -- conversion of Haskell strings into C strings
27 --
28 newCString, -- :: String -> IO CString
29 newCStringLen, -- :: String -> IO CStringLen
30
31 -- conversion of Haskell strings into C strings using temporary storage
32 --
33 withCString, -- :: String -> (CString -> IO a) -> IO a
34 withCStringLen, -- :: String -> (CStringLen -> IO a) -> IO a
35
36 -- conversion between Haskell and C characters *ignoring* the encoding
37 --
38 castCharToCChar, -- :: Char -> CChar
39 castCCharToChar, -- :: CChar -> Char
40
41 ) where
42
43 import Foreign.Marshal.Array
44 import Foreign.C.Types
45 import Foreign.Ptr
46 import Foreign.Storable
47
48 import Data.Word
49
50 #ifdef __GLASGOW_HASKELL__
51 import GHC.List
52 import GHC.Real
53 import GHC.Num
54 import GHC.IOBase
55 import GHC.Base
56 #else
57 import Data.Char ( chr, ord )
58 #define unsafeChr chr
59 #endif
60
61 -----------------------------------------------------------------------------
62 -- Strings
63
64 -- representation of strings in C
65 -- ------------------------------
66
67 type CString = Ptr CChar -- conventional NUL terminates strings
68 type CStringLen = (CString, Int) -- strings with explicit length
69
70
71 -- exported functions
72 -- ------------------
73 --
74 -- * the following routines apply the default conversion when converting the
75 -- C-land character encoding into the Haskell-land character encoding
76 --
77 -- ** NOTE: The current implementation doesn't handle conversions yet! **
78 --
79 -- * the routines using an explicit length tolerate NUL characters in the
80 -- middle of a string
81 --
82
83 -- marshal a NUL terminated C string into a Haskell string
84 --
85 peekCString :: CString -> IO String
86 #ifndef __GLASGOW_HASKELL__
87 peekCString cp = do cs <- peekArray0 nUL cp; return (cCharsToChars cs)
88 #else
89 peekCString cp = do
90 l <- lengthArray0 nUL cp
91 if l <= 0 then return "" else loop "" (l-1)
92 where
93 loop s i = do
94 xval <- peekElemOff cp i
95 let val = castCCharToChar xval
96 val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)
97 #endif
98
99 -- marshal a C string with explicit length into a Haskell string
100 --
101 peekCStringLen :: CStringLen -> IO String
102 #ifndef __GLASGOW_HASKELL__
103 peekCStringLen (cp, len) = do cs <- peekArray len cp; return (cCharsToChars cs)
104 #else
105 peekCStringLen (cp, len)
106 | len <= 0 = return "" -- being (too?) nice.
107 | otherwise = loop [] (len-1)
108 where
109 loop acc i = do
110 xval <- peekElemOff cp i
111 let val = castCCharToChar xval
112 -- blow away the coercion ASAP.
113 if (val `seq` (i == 0))
114 then return (val:acc)
115 else loop (val:acc) (i-1)
116 #endif
117
118 -- marshal a Haskell string into a NUL terminated C strings
119 --
120 -- * the Haskell string may *not* contain any NUL characters
121 --
122 -- * new storage is allocated for the C string and must be explicitly freed
123 --
124 newCString :: String -> IO CString
125 #ifndef __GLASGOW_HASKELL__
126 newCString = newArray0 nUL . charsToCChars
127 #else
128 newCString str = do
129 ptr <- mallocArray0 (length str)
130 let
131 go [] n# = pokeElemOff ptr (I# n#) nUL
132 go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
133 go str 0#
134 return ptr
135 #endif
136
137 -- marshal a Haskell string into a C string (ie, character array) with
138 -- explicit length information
139 --
140 -- * new storage is allocated for the C string and must be explicitly freed
141 --
142 newCStringLen :: String -> IO CStringLen
143 #ifndef __GLASGOW_HASKELL__
144 newCStringLen str = do a <- newArray (charsToCChars str)
145 return (pairLength str a)
146 #else
147 newCStringLen str = do
148 ptr <- mallocArray0 len
149 let
150 go [] n# = return ()
151 go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
152 go str 0#
153 return (ptr, len)
154 where
155 len = length str
156 #endif
157
158 -- marshal a Haskell string into a NUL terminated C strings using temporary
159 -- storage
160 --
161 -- * the Haskell string may *not* contain any NUL characters
162 --
163 -- * see the lifetime constraints of `MarshalAlloc.alloca'
164 --
165 withCString :: String -> (CString -> IO a) -> IO a
166 #ifndef __GLASGOW_HASKELL__
167 withCString = withArray0 nUL . charsToCChars
168 #else
169 withCString str f =
170 allocaArray0 (length str) $ \ptr ->
171 let
172 go [] n# = pokeElemOff ptr (I# n#) nUL
173 go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
174 in do
175 go str 0#
176 f ptr
177 #endif
178
179 -- marshal a Haskell string into a NUL terminated C strings using temporary
180 -- storage
181 --
182 -- * the Haskell string may *not* contain any NUL characters
183 --
184 -- * see the lifetime constraints of `MarshalAlloc.alloca'
185 --
186 withCStringLen :: String -> (CStringLen -> IO a) -> IO a
187 #ifndef __GLASGOW_HASKELL__
188 withCStringLen str act = withArray (charsToCChars str) $ act . pairLength str
189 #else
190 withCStringLen str f =
191 allocaArray len $ \ptr ->
192 let
193 go [] n# = return ()
194 go (c:cs) n# = do pokeElemOff ptr (I# n#) (castCharToCChar c); go cs (n# +# 1#)
195 in do
196 go str 0#
197 f (ptr,len)
198 where
199 len = length str
200 #endif
201
202 -- auxilliary definitions
203 -- ----------------------
204
205 -- C's end of string character
206 --
207 nUL :: CChar
208 nUL = 0
209
210 -- pair a C string with the length of the given Haskell string
211 --
212 pairLength :: String -> CString -> CStringLen
213 pairLength = flip (,) . length
214
215 -- cast [CChar] to [Char]
216 --
217 cCharsToChars :: [CChar] -> [Char]
218 cCharsToChars xs = map castCCharToChar xs
219
220 -- cast [Char] to [CChar]
221 --
222 charsToCChars :: [Char] -> [CChar]
223 charsToCChars xs = map castCharToCChar xs
224
225 castCCharToChar :: CChar -> Char
226 castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
227
228 castCharToCChar :: Char -> CChar
229 castCharToCChar ch = fromIntegral (ord ch)