ghc/lib/misc/CString.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section{Working with C strings}
   5
   6 A collection of lower-level functions to help converting between
   7 C strings and Haskell Strings (packed or otherwise).
   8
   9 A more user-friendly Haskell interface to packed string representation
  10 is the PackedString interface.
  11
  12 \begin{code}
  13 module CString
  14         (
  15           unpackCString      -- :: Addr -> [Char]
  16         , unpackNBytes       -- :: Addr -> Int -> [Char]
  17         , unpackNBytesST     -- :: Addr -> Int -> ST s [Char]
  18         , unpackNBytesAccST  -- :: Addr -> Int -> [Char] -> ST s [Char]
  19         , unpackCString#     -- :: Addr# -> [Char]       **
  20         , unpackNBytes#      -- :: Addr# -> Int# -> [Char] **
  21         , unpackNBytesST#    -- :: Addr# -> Int# -> ST s [Char]
  22
  23             -- terrrible names...
  24         , unpackCStringIO     -- :: Addr -> IO String
  25         , unpackCStringLenIO  -- :: Addr -> Int -> IO String
  26         , unpackNBytesIO      -- :: Addr -> Int -> IO [Char]
  27         , unpackNBytesAccIO   -- :: Addr -> Int -> [Char] -> IO [Char]
  28         , unpackNBytesBAIO    -- :: ByteArray Int -> Int -> IO [Char]
  29         , unpackNBytesAccBAIO -- :: ByteArray Int -> Int -> [Char] -> IO [Char]
  30
  31         , packString         -- :: [Char] -> ByteArray Int
  32         , packStringST       -- :: [Char] -> ST s (ByteArray Int)
  33         , packStringIO       -- :: [Char] -> IO (ByteArray Int)
  34         , packNBytesST       -- :: Int -> [Char] -> ByteArray Int
  35         , packCString#       -- :: [Char] -> ByteArray#
  36
  37         , unpackCStringBA    -- :: ByteArray Int -> [Char]
  38         , unpackNBytesBA     -- :: ByteArray Int -> Int  -> [Char]
  39         , unpackCStringBA#   -- :: ByteArray#    -> Int# -> [Char]
  40         , unpackNBytesBA#    -- :: ByteArray#    -> Int# -> [Char]
  41
  42           -- unmarshaling (char*) vectors.
  43         , unvectorize        -- :: Addr -> Int -> IO [String]
  44         , vectorize          -- :: [[Char]] -> IO (ByteArray Int)
  45
  46
  47         , allocChars         -- :: Int -> IO (MutableByteArray RealWorld Int)
  48         , allocWords         -- :: Int -> IO (MutableByteArray RealWorld Int)
  49         , freeze             -- :: MutableByteArray RealWorld Int -> IO (ByteArray Int)
  50         , strcpy             -- :: Addr -> IO String
  51
  52         ) where
  53
  54 import PrelPack
  55 import GlaExts
  56 import Addr
  57 import PrelIOBase ( IO(..) )
  58
  59 \end{code}
  60
  61 \begin{code}
  62 packStringIO :: [Char] -> IO (ByteArray Int)
  63 packStringIO str = stToIO (packStringST str)
  64 \end{code}
  65
  66 \begin{code}
  67 unpackCStringIO :: Addr -> IO String
  68 unpackCStringIO addr
  69  | addr == ``NULL'' = return ""
  70  | otherwise        = unpack 0#
  71   where
  72     unpack nh = do
  73        ch <- readCharOffAddr addr (I# nh)
  74        if ch == '\0'
  75         then return []
  76         else do
  77            ls <- unpack (nh +# 1#)
  78            return (ch : ls)
  79
  80 -- unpack 'len' chars
  81 unpackCStringLenIO :: Addr -> Int -> IO String
  82 unpackCStringLenIO addr l@(I# len#)
  83  | len# <# 0#  = fail (userError ("CString.unpackCStringLenIO: negative length (" ++ show l ++ ")"))
  84  | len# ==# 0# = return ""
  85  | otherwise   = unpack [] (len# -# 1#)
  86   where
  87     unpack acc 0# = do
  88        ch <- readCharOffAddr addr (I# 0#)
  89        return (ch:acc)
  90     unpack acc nh = do
  91        ch <- readCharOffAddr addr (I# nh)
  92        unpack (ch:acc) (nh -# 1#)
  93
  94 unpackNBytesIO     :: Addr -> Int -> IO [Char]
  95 unpackNBytesIO a l = stToIO (unpackNBytesST a l)
  96
  97 unpackNBytesAccIO  :: Addr -> Int -> [Char] -> IO [Char]
  98 unpackNBytesAccIO a l acc = stToIO (unpackNBytesAccST a l acc)
  99
 100 unpackNBytesBAIO     :: ByteArray Int -> Int -> IO [Char]
 101 unpackNBytesBAIO ba l = unpackNBytesAccBAIO ba l []
 102
 103 -- note: no bounds checking!
 104 unpackNBytesAccBAIO :: ByteArray Int -> Int -> [Char] -> IO [Char]
 105 unpackNBytesAccBAIO ba 0  rest = return rest
 106 unpackNBytesAccBAIO  (ByteArray _ ba) (I# len#) rest = unpack rest (len# -# 1#)
 107   where
 108     unpack acc i#
 109       | i# <# 0#   = return acc
 110       | otherwise  =
 111          case indexCharArray# ba i# of
 112            ch -> unpack (C# ch : acc) (i# -# 1#)
 113
 114 \end{code}
 115
 116 Turn a NULL-terminated vector of null-terminated strings into a string list
 117 (ToDo: create a module of common marshaling functions)
 118
 119 \begin{code}
 120 unvectorize :: Addr -> Int -> IO [String]
 121 unvectorize ptr n
 122   | str == ``NULL'' = return []
 123   | otherwise = do
 124         x  <- unpackCStringIO str
 125         xs <- unvectorize ptr (n+1)
 126         return (x : xs)
 127   where
 128    str = indexAddrOffAddr ptr n
 129
 130 \end{code}
 131
 132  Turn a string list into a NULL-terminated vector of null-terminated
 133 strings No indices...I hate indices.  Death to Ix.
 134
 135 \begin{code}
 136 vectorize :: [String] -> IO (ByteArray Int)
 137 vectorize xs = do
 138   arr <- allocWords (len + 1)
 139   fill arr 0 xs
 140   freeze arr
 141  where
 142     len :: Int
 143     len = length xs
 144
 145     fill :: MutableByteArray RealWorld Int -> Int -> [String] -> IO ()
 146     fill arr n [] =
 147         _casm_ ``((PP_)%0)[%1] = NULL;'' arr n
 148     fill arr n (x:xs) =
 149         packStringIO x                      >>= \ barr ->
 150         _casm_ ``((PP_)%0)[%1] = (P_)%2;'' arr n barr
 151                                             >>= \ () ->
 152         fill arr (n+1) xs
 153
 154 \end{code}
 155
 156 Allocating chunks of memory in the Haskell heap, leaving
 157 out the bounds - use with care.
 158
 159 \begin{code}
 160 -- Allocate a mutable array of characters with no indices.
 161 allocChars :: Int -> IO (MutableByteArray RealWorld Int)
 162 allocChars (I# size#) = IO $ \ s# ->
 163     case newCharArray# size# s# of
 164       (# s2#, barr# #) ->
 165         (# s2#, (MutableByteArray (I# 1#, I# size#) barr#) #)
 166
 167 allocWords :: Int -> IO (MutableByteArray RealWorld Int)
 168 allocWords (I# size#) = IO $ \ s# ->
 169     case newIntArray# size# s# of
 170       (# s2#, barr# #) ->
 171         (# s2#, (MutableByteArray (I# 1#, I# size#) barr#) #)
 172
 173 -- Freeze these index-free mutable arrays
 174 freeze :: MutableByteArray RealWorld Int -> IO (ByteArray Int)
 175 freeze (MutableByteArray ixs arr#) = IO $ \ s# ->
 176     case unsafeFreezeByteArray# arr# s# of
 177       (# s2#, frozen# #) ->
 178         (# s2#, (ByteArray ixs frozen#) #)
 179
 180 -- Copy a null-terminated string from outside the heap to
 181 -- Haskellized nonsense inside the heap
 182 strcpy :: Addr -> IO String
 183 strcpy str = unpackCStringIO str
 184
 185 \end{code}