Foreign/C/String.hs

   1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
   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 marshalling of C strings.
  13 --
  14 -- The marshalling converts each Haskell character, representing a Unicode
  15 -- code point, to one or more bytes in a manner that, by default, is
  16 -- determined by the current locale.  As a consequence, no guarantees
  17 -- can be made about the relative length of a Haskell string and its
  18 -- corresponding C string, and therefore all the marshalling routines
  19 -- include memory allocation.  The translation between Unicode and the
  20 -- encoding of the current locale may be lossy.
  21 --
  22 -----------------------------------------------------------------------------
  23
  24 module Foreign.C.String (   -- representation of strings in C
  25
  26   -- * C strings
  27
  28   CString,           -- = Ptr CChar
  29   CStringLen,        -- = (Ptr CChar, Int)
  30
  31   -- ** Using a locale-dependent encoding
  32
  33   -- | Currently these functions are identical to their @CAString@ counterparts;
  34   -- eventually they will use an encoding determined by the current locale.
  35
  36   -- conversion of C strings into Haskell strings
  37   --
  38   peekCString,       -- :: CString    -> IO String
  39   peekCStringLen,    -- :: CStringLen -> IO String
  40
  41   -- conversion of Haskell strings into C strings
  42   --
  43   newCString,        -- :: String -> IO CString
  44   newCStringLen,     -- :: String -> IO CStringLen
  45
  46   -- conversion of Haskell strings into C strings using temporary storage
  47   --
  48   withCString,       -- :: String -> (CString    -> IO a) -> IO a
  49   withCStringLen,    -- :: String -> (CStringLen -> IO a) -> IO a
  50
  51   charIsRepresentable, -- :: Char -> IO Bool
  52
  53   -- ** Using 8-bit characters
  54
  55   -- | These variants of the above functions are for use with C libraries
  56   -- that are ignorant of Unicode.  These functions should be used with
  57   -- care, as a loss of information can occur.
  58
  59   castCharToCChar,   -- :: Char -> CChar
  60   castCCharToChar,   -- :: CChar -> Char
  61
  62   peekCAString,      -- :: CString    -> IO String
  63   peekCAStringLen,   -- :: CStringLen -> IO String
  64   newCAString,       -- :: String -> IO CString
  65   newCAStringLen,    -- :: String -> IO CStringLen
  66   withCAString,      -- :: String -> (CString    -> IO a) -> IO a
  67   withCAStringLen,   -- :: String -> (CStringLen -> IO a) -> IO a
  68
  69   -- * C wide strings
  70
  71   -- | These variants of the above functions are for use with C libraries
  72   -- that encode Unicode using the C @wchar_t@ type in a system-dependent
  73   -- way.  The only encodings supported are
  74   --
  75   -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or
  76   --
  77   -- * UTF-16 (as used on Windows systems).
  78
  79   CWString,          -- = Ptr CWchar
  80   CWStringLen,       -- = (Ptr CWchar, Int)
  81
  82   peekCWString,      -- :: CWString    -> IO String
  83   peekCWStringLen,   -- :: CWStringLen -> IO String
  84   newCWString,       -- :: String -> IO CWString
  85   newCWStringLen,    -- :: String -> IO CWStringLen
  86   withCWString,      -- :: String -> (CWString    -> IO a) -> IO a
  87   withCWStringLen,   -- :: String -> (CWStringLen -> IO a) -> IO a
  88
  89   ) where
  90
  91 import Foreign.Marshal.Array
  92 import Foreign.C.Types
  93 import Foreign.Ptr
  94 import Foreign.Storable
  95
  96 import Data.Word
  97
  98 #ifdef __GLASGOW_HASKELL__
  99 import GHC.List
 100 import GHC.Real
 101 import GHC.Num
 102 import GHC.Base
 103 #else
 104 import Data.Char ( chr, ord )
 105 #define unsafeChr chr
 106 #endif
 107
 108 -----------------------------------------------------------------------------
 109 -- Strings
 110
 111 -- representation of strings in C
 112 -- ------------------------------
 113
 114 -- | A C string is a reference to an array of C characters terminated by NUL.
 115 type CString    = Ptr CChar
 116
 117 -- | A string with explicit length information in bytes instead of a
 118 -- terminating NUL (allowing NUL characters in the middle of the string).
 119 type CStringLen = (Ptr CChar, Int)
 120
 121 -- exported functions
 122 -- ------------------
 123 --
 124 -- * the following routines apply the default conversion when converting the
 125 --   C-land character encoding into the Haskell-land character encoding
 126
 127 -- | Marshal a NUL terminated C string into a Haskell string.
 128 --
 129 peekCString    :: CString -> IO String
 130 peekCString = peekCAString
 131
 132 -- | Marshal a C string with explicit length into a Haskell string.
 133 --
 134 peekCStringLen           :: CStringLen -> IO String
 135 peekCStringLen = peekCAStringLen
 136
 137 -- | Marshal a Haskell string into a NUL terminated C string.
 138 --
 139 -- * the Haskell string may /not/ contain any NUL characters
 140 --
 141 -- * new storage is allocated for the C string and must be
 142 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 143 --   'Foreign.Marshal.Alloc.finalizerFree'.
 144 --
 145 newCString :: String -> IO CString
 146 newCString = newCAString
 147
 148 -- | Marshal a Haskell string into a C string (ie, character array) with
 149 -- explicit length information.
 150 --
 151 -- * new storage is allocated for the C string and must be
 152 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 153 --   'Foreign.Marshal.Alloc.finalizerFree'.
 154 --
 155 newCStringLen     :: String -> IO CStringLen
 156 newCStringLen = newCAStringLen
 157
 158 -- | Marshal a Haskell string into a NUL terminated C string using temporary
 159 -- storage.
 160 --
 161 -- * the Haskell string may /not/ contain any NUL characters
 162 --
 163 -- * the memory is freed when the subcomputation terminates (either
 164 --   normally or via an exception), so the pointer to the temporary
 165 --   storage must /not/ be used after this.
 166 --
 167 withCString :: String -> (CString -> IO a) -> IO a
 168 withCString = withCAString
 169
 170 -- | Marshal a Haskell string into a C string (ie, character array)
 171 -- in temporary storage, with explicit length information.
 172 --
 173 -- * the memory is freed when the subcomputation terminates (either
 174 --   normally or via an exception), so the pointer to the temporary
 175 --   storage must /not/ be used after this.
 176 --
 177 withCStringLen         :: String -> (CStringLen -> IO a) -> IO a
 178 withCStringLen = withCAStringLen
 179
 180 -- | Determines whether a character can be accurately encoded in a 'CString'.
 181 -- Unrepresentable characters are converted to @\'?\'@.
 182 --
 183 -- Currently only Latin-1 characters are representable.
 184 charIsRepresentable :: Char -> IO Bool
 185 charIsRepresentable c = return (ord c < 256)
 186
 187 -- single byte characters
 188 -- ----------------------
 189 --
 190 --   ** NOTE: These routines don't handle conversions! **
 191
 192 -- | Convert a C byte, representing a Latin-1 character, to the corresponding
 193 -- Haskell character.
 194 castCCharToChar :: CChar -> Char
 195 castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
 196
 197 -- | Convert a Haskell character to a C character.
 198 -- This function is only safe on the first 256 characters.
 199 castCharToCChar :: Char -> CChar
 200 castCharToCChar ch = fromIntegral (ord ch)
 201
 202 -- | Marshal a NUL terminated C string into a Haskell string.
 203 --
 204 peekCAString    :: CString -> IO String
 205 #ifndef __GLASGOW_HASKELL__
 206 peekCAString cp  = do
 207   cs <- peekArray0 nUL cp
 208   return (cCharsToChars cs)
 209 #else
 210 peekCAString cp = do
 211   l <- lengthArray0 nUL cp
 212   if l <= 0 then return "" else loop "" (l-1)
 213   where
 214     loop s i = do
 215         xval <- peekElemOff cp i
 216         let val = castCCharToChar xval
 217         val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)
 218 #endif
 219
 220 -- | Marshal a C string with explicit length into a Haskell string.
 221 --
 222 peekCAStringLen           :: CStringLen -> IO String
 223 #ifndef __GLASGOW_HASKELL__
 224 peekCAStringLen (cp, len)  = do
 225   cs <- peekArray len cp
 226   return (cCharsToChars cs)
 227 #else
 228 peekCAStringLen (cp, len)
 229   | len <= 0  = return "" -- being (too?) nice.
 230   | otherwise = loop [] (len-1)
 231   where
 232     loop acc i = do
 233          xval <- peekElemOff cp i
 234          let val = castCCharToChar xval
 235            -- blow away the coercion ASAP.
 236          if (val `seq` (i == 0))
 237           then return (val:acc)
 238           else loop (val:acc) (i-1)
 239 #endif
 240
 241 -- | Marshal a Haskell string into a NUL terminated C string.
 242 --
 243 -- * the Haskell string may /not/ contain any NUL characters
 244 --
 245 -- * new storage is allocated for the C string and must be
 246 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 247 --   'Foreign.Marshal.Alloc.finalizerFree'.
 248 --
 249 newCAString :: String -> IO CString
 250 #ifndef __GLASGOW_HASKELL__
 251 newCAString  = newArray0 nUL . charsToCChars
 252 #else
 253 newCAString str = do
 254   ptr <- mallocArray0 (length str)
 255   let
 256         go [] n     = pokeElemOff ptr n nUL
 257         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 258   go str 0
 259   return ptr
 260 #endif
 261
 262 -- | Marshal a Haskell string into a C string (ie, character array) with
 263 -- explicit length information.
 264 --
 265 -- * new storage is allocated for the C string and must be
 266 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 267 --   'Foreign.Marshal.Alloc.finalizerFree'.
 268 --
 269 newCAStringLen     :: String -> IO CStringLen
 270 #ifndef __GLASGOW_HASKELL__
 271 newCAStringLen str  = newArrayLen (charsToCChars str)
 272 #else
 273 newCAStringLen str = do
 274   ptr <- mallocArray0 len
 275   let
 276         go [] n     = n `seq` return () -- make it strict in n
 277         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 278   go str 0
 279   return (ptr, len)
 280   where
 281     len = length str
 282 #endif
 283
 284 -- | Marshal a Haskell string into a NUL terminated C string using temporary
 285 -- storage.
 286 --
 287 -- * the Haskell string may /not/ contain any NUL characters
 288 --
 289 -- * the memory is freed when the subcomputation terminates (either
 290 --   normally or via an exception), so the pointer to the temporary
 291 --   storage must /not/ be used after this.
 292 --
 293 withCAString :: String -> (CString -> IO a) -> IO a
 294 #ifndef __GLASGOW_HASKELL__
 295 withCAString  = withArray0 nUL . charsToCChars
 296 #else
 297 withCAString str f =
 298   allocaArray0 (length str) $ \ptr ->
 299       let
 300         go [] n     = pokeElemOff ptr n nUL
 301         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 302       in do
 303       go str 0
 304       f ptr
 305 #endif
 306
 307 -- | Marshal a Haskell string into a C string (ie, character array)
 308 -- in temporary storage, with explicit length information.
 309 --
 310 -- * the memory is freed when the subcomputation terminates (either
 311 --   normally or via an exception), so the pointer to the temporary
 312 --   storage must /not/ be used after this.
 313 --
 314 withCAStringLen         :: String -> (CStringLen -> IO a) -> IO a
 315 withCAStringLen str f    =
 316 #ifndef __GLASGOW_HASKELL__
 317   withArrayLen (charsToCChars str) $ \ len ptr -> f (ptr, len)
 318 #else
 319   allocaArray len $ \ptr ->
 320       let
 321         go [] n     = n `seq` return () -- make it strict in n
 322         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 323       in do
 324       go str 0
 325       f (ptr,len)
 326   where
 327     len = length str
 328 #endif
 329
 330 -- auxiliary definitions
 331 -- ----------------------
 332
 333 -- C's end of string character
 334 --
 335 nUL :: CChar
 336 nUL  = 0
 337
 338 -- allocate an array to hold the list and pair it with the number of elements
 339 newArrayLen        :: Storable a => [a] -> IO (Ptr a, Int)
 340 newArrayLen xs      = do
 341   a <- newArray xs
 342   return (a, length xs)
 343
 344 #ifndef __GLASGOW_HASKELL__
 345 -- cast [CChar] to [Char]
 346 --
 347 cCharsToChars :: [CChar] -> [Char]
 348 cCharsToChars xs  = map castCCharToChar xs
 349
 350 -- cast [Char] to [CChar]
 351 --
 352 charsToCChars :: [Char] -> [CChar]
 353 charsToCChars xs  = map castCharToCChar xs
 354 #endif
 355
 356 -----------------------------------------------------------------------------
 357 -- Wide strings
 358
 359 -- representation of wide strings in C
 360 -- -----------------------------------
 361
 362 -- | A C wide string is a reference to an array of C wide characters
 363 -- terminated by NUL.
 364 type CWString    = Ptr CWchar
 365
 366 -- | A wide character string with explicit length information in 'CWchar's
 367 -- instead of a terminating NUL (allowing NUL characters in the middle
 368 -- of the string).
 369 type CWStringLen = (Ptr CWchar, Int)
 370
 371 -- | Marshal a NUL terminated C wide string into a Haskell string.
 372 --
 373 peekCWString    :: CWString -> IO String
 374 peekCWString cp  = do
 375   cs <- peekArray0 wNUL cp
 376   return (cWcharsToChars cs)
 377
 378 -- | Marshal a C wide string with explicit length into a Haskell string.
 379 --
 380 peekCWStringLen           :: CWStringLen -> IO String
 381 peekCWStringLen (cp, len)  = do
 382   cs <- peekArray len cp
 383   return (cWcharsToChars cs)
 384
 385 -- | Marshal a Haskell string into a NUL terminated C wide string.
 386 --
 387 -- * the Haskell string may /not/ contain any NUL characters
 388 --
 389 -- * new storage is allocated for the C wide string and must
 390 --   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
 391 --   'Foreign.Marshal.Alloc.finalizerFree'.
 392 --
 393 newCWString :: String -> IO CWString
 394 newCWString  = newArray0 wNUL . charsToCWchars
 395
 396 -- | Marshal a Haskell string into a C wide string (ie, wide character array)
 397 -- with explicit length information.
 398 --
 399 -- * new storage is allocated for the C wide string and must
 400 --   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
 401 --   'Foreign.Marshal.Alloc.finalizerFree'.
 402 --
 403 newCWStringLen     :: String -> IO CWStringLen
 404 newCWStringLen str  = newArrayLen (charsToCWchars str)
 405
 406 -- | Marshal a Haskell string into a NUL terminated C wide string using
 407 -- temporary storage.
 408 --
 409 -- * the Haskell string may /not/ contain any NUL characters
 410 --
 411 -- * the memory is freed when the subcomputation terminates (either
 412 --   normally or via an exception), so the pointer to the temporary
 413 --   storage must /not/ be used after this.
 414 --
 415 withCWString :: String -> (CWString -> IO a) -> IO a
 416 withCWString  = withArray0 wNUL . charsToCWchars
 417
 418 -- | Marshal a Haskell string into a NUL terminated C wide string using
 419 -- temporary storage.
 420 --
 421 -- * the Haskell string may /not/ contain any NUL characters
 422 --
 423 -- * the memory is freed when the subcomputation terminates (either
 424 --   normally or via an exception), so the pointer to the temporary
 425 --   storage must /not/ be used after this.
 426 --
 427 withCWStringLen         :: String -> (CWStringLen -> IO a) -> IO a
 428 withCWStringLen str f    =
 429   withArrayLen (charsToCWchars str) $ \ len ptr -> f (ptr, len)
 430
 431 -- auxiliary definitions
 432 -- ----------------------
 433
 434 wNUL :: CWchar
 435 wNUL = 0
 436
 437 cWcharsToChars :: [CWchar] -> [Char]
 438 charsToCWchars :: [Char] -> [CWchar]
 439
 440 #ifdef mingw32_HOST_OS
 441
 442 -- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.
 443
 444 -- coding errors generate Chars in the surrogate range
 445 cWcharsToChars = map chr . fromUTF16 . map fromIntegral
 446  where
 447   fromUTF16 (c1:c2:wcs)
 448     | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =
 449       ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs
 450   fromUTF16 (c:wcs) = c : fromUTF16 wcs
 451   fromUTF16 [] = []
 452
 453 charsToCWchars = foldr utf16Char [] . map ord
 454  where
 455   utf16Char c wcs
 456     | c < 0x10000 = fromIntegral c : wcs
 457     | otherwise   = let c' = c - 0x10000 in
 458                     fromIntegral (c' `div` 0x400 + 0xd800) :
 459                     fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs
 460
 461 #else /* !mingw32_HOST_OS */
 462
 463 cWcharsToChars xs  = map castCWcharToChar xs
 464 charsToCWchars xs  = map castCharToCWchar xs
 465
 466 -- These conversions only make sense if __STDC_ISO_10646__ is defined
 467 -- (meaning that wchar_t is ISO 10646, aka Unicode)
 468
 469 castCWcharToChar :: CWchar -> Char
 470 castCWcharToChar ch = chr (fromIntegral ch )
 471
 472 castCharToCWchar :: Char -> CWchar
 473 castCharToCWchar ch = fromIntegral (ord ch)
 474
 475 #endif /* !mingw32_HOST_OS */