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)