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(..), IOResult(..))
  58 import PrelArr ( StateAndMutableByteArray#(..),
  59                  StateAndByteArray#(..)
  60                )
  61
  62 \end{code}
  63
  64 \begin{code}
  65 packStringIO :: [Char] -> IO (ByteArray Int)
  66 packStringIO str = stToIO (packStringST str)
  67 \end{code}
  68
  69 \begin{code}
  70 unpackCStringIO :: Addr -> IO String
  71 unpackCStringIO addr
  72  | addr == ``NULL'' = return ""
  73  | otherwise        = unpack 0#
  74   where
  75     unpack nh = do
  76        ch <- readCharOffAddr addr (I# nh)
  77        if ch == '\0'
  78         then return []
  79         else do
  80            ls <- unpack (nh +# 1#)
  81            return (ch : ls)
  82
  83 -- unpack 'len' chars
  84 unpackCStringLenIO :: Addr -> Int -> IO String
  85 unpackCStringLenIO addr l@(I# len#)
  86  | len# <# 0#  = fail (userError ("CString.unpackCStringLenIO: negative length (" ++ show l ++ ")"))
  87  | len# ==# 0# = return ""
  88  | otherwise   = unpack [] (len# -# 1#)
  89   where
  90     unpack acc 0# = do
  91        ch <- readCharOffAddr addr (I# 0#)
  92        return (ch:acc)
  93     unpack acc nh = do
  94        ch <- readCharOffAddr addr (I# nh)
  95        unpack (ch:acc) (nh -# 1#)
  96
  97 unpackNBytesIO     :: Addr -> Int -> IO [Char]
  98 unpackNBytesIO a l = stToIO (unpackNBytesST a l)
  99
 100 unpackNBytesAccIO  :: Addr -> Int -> [Char] -> IO [Char]
 101 unpackNBytesAccIO a l acc = stToIO (unpackNBytesAccST a l acc)
 102
 103 unpackNBytesBAIO     :: ByteArray Int -> Int -> IO [Char]
 104 unpackNBytesBAIO ba l = unpackNBytesAccBAIO ba l []
 105
 106 -- note: no bounds checking!
 107 unpackNBytesAccBAIO :: ByteArray Int -> Int -> [Char] -> IO [Char]
 108 unpackNBytesAccBAIO ba 0  rest = return rest
 109 unpackNBytesAccBAIO  (ByteArray _ ba) (I# len#) rest = unpack rest (len# -# 1#)
 110   where
 111     unpack acc i#
 112       | i# <# 0#   = return acc
 113       | otherwise  =
 114          case indexCharArray# ba i# of
 115            ch -> unpack (C# ch : acc) (i# -# 1#)
 116
 117 \end{code}
 118
 119 Turn a NULL-terminated vector of null-terminated strings into a string list
 120 (ToDo: create a module of common marshaling functions)
 121
 122 \begin{code}
 123 unvectorize :: Addr -> Int -> IO [String]
 124 unvectorize ptr n
 125   | str == ``NULL'' = return []
 126   | otherwise = do
 127         x  <- unpackCStringIO str
 128         xs <- unvectorize ptr (n+1)
 129         return (x : xs)
 130   where
 131    str = indexAddrOffAddr ptr n
 132
 133 \end{code}
 134
 135  Turn a string list into a NULL-terminated vector of null-terminated
 136 strings No indices...I hate indices.  Death to Ix.
 137
 138 \begin{code}
 139 vectorize :: [String] -> IO (ByteArray Int)
 140 vectorize xs = do
 141   arr <- allocWords (len + 1)
 142   fill arr 0 xs
 143   freeze arr
 144  where
 145     len :: Int
 146     len = length xs
 147
 148     fill :: MutableByteArray RealWorld Int -> Int -> [String] -> IO ()
 149     fill arr n [] =
 150         _casm_ ``((PP_)%0)[%1] = NULL;'' arr n
 151     fill arr n (x:xs) =
 152         packStringIO x                      >>= \ barr ->
 153         _casm_ ``((PP_)%0)[%1] = (P_)%2;'' arr n barr
 154                                             >>= \ () ->
 155         fill arr (n+1) xs
 156
 157 \end{code}
 158
 159 Allocating chunks of memory in the Haskell heap, leaving
 160 out the bounds - use with care.
 161
 162 \begin{code}
 163 -- Allocate a mutable array of characters with no indices.
 164 allocChars :: Int -> IO (MutableByteArray RealWorld Int)
 165 allocChars (I# size#) = IO $ \ s# ->
 166     case newCharArray# size# s# of
 167       StateAndMutableByteArray# s2# barr# ->
 168         IOok s2# (MutableByteArray (I# 1#, I# size#) barr#)
 169
 170 allocWords :: Int -> IO (MutableByteArray RealWorld Int)
 171 allocWords (I# size#) = IO $ \ s# ->
 172     case newIntArray# size# s# of
 173       StateAndMutableByteArray# s2# barr# ->
 174         IOok s2# (MutableByteArray (I# 1#, I# size#) barr#)
 175
 176 -- Freeze these index-free mutable arrays
 177 freeze :: MutableByteArray RealWorld Int -> IO (ByteArray Int)
 178 freeze (MutableByteArray ixs arr#) = IO $ \ s# ->
 179     case unsafeFreezeByteArray# arr# s# of
 180       StateAndByteArray# s2# frozen# ->
 181         IOok s2# (ByteArray ixs frozen#)
 182
 183 -- Copy a null-terminated string from outside the heap to
 184 -- Haskellized nonsense inside the heap
 185 strcpy :: Addr -> IO String
 186 strcpy str = unpackCStringIO str
 187
 188 \end{code}