ghc/interpreter/prelude/PreludePackString.hs

   1 -- Standard list functions
   2
   3 #ifdef HEAD
   4 module PreludePackString
   5         ( primUnpackString    -- unpack Hugs-generated string constants
   6         , primPackString      -- pack String into ByteArray
   7         , primUnpackCString   -- unpack null-terminated string
   8         , unsafeUnpackCString -- unpack null-terminated string
   9         )
  10   where
  11
  12 import qualified Char(isSpace)
  13 import PreludeBuiltin
  14 #endif /* HEAD */
  15 #ifdef BODY
  16
  17 -- Unpack strings generated by the Hugs code generator.
  18 -- Strings can contain \0 provided they're coded right.
  19 --
  20 -- ToDo: change this (and Hugs code generator) to use ByteArrays
  21 primUnpackString :: Addr -> String
  22 primUnpackString a = unpack 0
  23  where
  24   -- The following decoding is based on evalString in the old machine.c
  25   unpack i
  26     | c == '\0' = []
  27     | c == '\\' = if '\\' == primIndexCharOffAddr a (i+1)
  28                   then '\\' : unpack (i+2)
  29                   else '\0' : unpack (i+2)
  30     | otherwise = c : unpack (i+1)
  31    where
  32     c = primIndexCharOffAddr a i
  33
  34 primPackString :: [Char] -> PrimByteArray
  35 primPackString str = runST (do
  36   { let len = length str
  37   ; arr <- primNewByteArray (len+1)
  38   ; sequence (zipWith (primWriteCharArray arr) [0..] str)
  39   ; primWriteCharArray arr len '\0'
  40   ; primUnsafeFreezeByteArray arr
  41   })
  42
  43 -- Note that this version is in the IO monad and copies the whole string
  44 -- immediately!
  45 primUnpackCString :: Addr -> IO String
  46 primUnpackCString a = unpack 0 []
  47  where
  48   unpack i acc = do
  49     { c <- primReadCharOffAddr a i
  50     ; if c == '\0'
  51            then return (reverse acc)
  52            else unpack (i+1) (c:acc)
  53     }
  54
  55 primUnpackCStringAcc :: Addr -> Int -> String -> IO String
  56 primUnpackCStringAcc a n acc = unpack n acc
  57  where
  58   unpack 0 acc
  59     = return acc
  60   unpack (n+1) acc
  61     = do
  62       { c <- primReadCharOffAddr a n
  63       ; unpack n (c:acc)
  64       }
  65
  66 unsafeUnpackCString :: Addr -> String
  67 unsafeUnpackCString = unsafePerformIO . primUnpackCString
  68
  69 #endif /* BODY */