Glorious hacking (all the hard work) by Bryan O'Sullivan.
\begin{code}
+{-# OPTIONS -#include "cbits/PackedString.h" #-}
+
module PackedString (
PackedString, -- abstract
)
import Addr
-import PrelArr ( StateAndMutableByteArray#(..) , StateAndByteArray#(..) )
import PrelST
import ST
import IOExts ( unsafePerformIO )
ba1 = ByteArray (0, I# (len1 -# 1#)) bs1
ba2 = ByteArray (0, I# (len2 -# 1#)) bs2
-comparePS (PS bs1 len1 has_null1) (CPS bs2 len2)
+comparePS (PS bs1 len1 has_null1) (CPS bs2 _)
| not has_null1
= unsafePerformIO (
_ccall_ strcmp ba1 ba2 >>= \ (I# res) ->
ba1 = ByteArray (0, I# (len1 -# 1#)) bs1
ba2 = A# bs2
-comparePS (CPS bs1 len1) (CPS bs2 len2)
+comparePS (CPS bs1 len1) (CPS bs2 _)
= unsafePerformIO (
_ccall_ strcmp ba1 ba2 >>= \ (I# res) ->
return (
packNCharsST len str
packNCharsST :: Int -> [Char] -> ST s PackedString
-packNCharsST len@(I# length#) str =
+packNCharsST (I# length#) str =
{-
allocate an array that will hold the string
(not forgetting the NUL byte at the end)
= PS frozen# n# (byteArrayHasNUL# frozen# n#)
psToByteArray :: PackedString -> ByteArray Int
-psToByteArray (PS bytes n has_null)
- = ByteArray (0, I# (n -# 1#)) bytes
+psToByteArray (PS bytes n _) = ByteArray (0, I# (n -# 1#)) bytes
psToByteArray (CPS addr len#)
= let
isCString _ = False
psToCString :: PackedString -> Addr
-psToCString (CPS addr _) = (A# addr)
-psToCString (PS bytes n# has_null) =
+psToCString (CPS addr _) = (A# addr)
+psToCString (PS bytes l# _) =
unsafePerformIO $ do
- stuff <- _ccall_ malloc ((I# n#) * (``sizeof(char)''))
+ stuff <- _ccall_ malloc ((I# l#) * (``sizeof(char)''))
let
fill_in n# i#
| n# ==# 0# = return ()
let ch# = indexCharArray# bytes i#
writeCharOffAddr stuff (I# i#) (C# ch#)
fill_in (n# -# 1#) (i# +# 1#)
- fill_in n# 0#
+ fill_in l# 0#
return stuff
\end{code}
-- = [ indexPS ps n | n <- [ 0::Int .. lengthPS ps - 1 ] ]
unpackPS :: PackedString -> [Char]
-unpackPS (PS bytes len has_null)
- = unpack 0#
+unpackPS (PS bytes len _) = unpack 0#
where
unpack nh
| nh >=# len = []
where
ch = indexCharArray# bytes nh
-unpackPS (CPS addr len)
- = unpack 0#
+unpackPS (CPS addr _) = unpack 0#
where
unpack nh
| ch `eqChar#` '\0'# = []
| otherwise = y#
unpackPSIO :: PackedString -> IO String
-unpackPSIO ps@(PS bytes len has_null) = return (unpackPS ps)
-unpackPSIO (CPS addr len)
- = unpack 0#
+unpackPSIO ps@(PS bytes _ _) = return (unpackPS ps)
+unpackPSIO (CPS addr _) = unpack 0#
where
unpack nh = do
ch <- readCharOffAddr (A# addr) (I# nh)
in
hFillBufBA hdl byte_array len >>= \ (I# read#) ->
if read# ==# 0# then -- EOF or other error
- fail (userError "hGetPS: EOF reached or other error")
+ ioError (userError "hGetPS: EOF reached or other error")
else
{-
The system call may not return the number of
{-# INLINE lengthPS# #-}
+lengthPS# :: PackedString -> Int#
lengthPS# (PS _ i _) = i
lengthPS# (CPS _ i) = i
{-# INLINE indexPS# #-}
+indexPS# :: PackedString -> Int# -> Char#
indexPS# (PS bs i _) n
= --ASSERT (n >=# 0# && n <# i) -- error checking: my eye! (WDP 94/10)
indexCharArray# bs n
(I# off', cs)
copy_arr :: MutableByteArray s Int -> [Char] -> Int# -> Int# -> ST s ()
- copy_arr arr# [_] _ _ = return ()
+ copy_arr _ [_] _ _ = return ()
copy_arr arr# ls n i =
let
(x,ls') = matchOffset 0# ls
foldrPS :: (Char -> a -> a) -> a -> PackedString -> a
-foldrPS f b ps
- = if nullPS ps then
- b
- else
- whizzRL b len
+foldrPS f v ps
+ | nullPS ps = v
+ | otherwise = whizzRL v len
where
len = lengthPS# ps
concatPS pss
= let
tot_len# = case (foldr ((+) . lengthPS) 0 pss) of { I# x -> x }
- tot_len = I# tot_len#
in
runST (
new_ps_array (tot_len# +# 1#) >>= \ arr# -> -- incl NUL byte!
substrPS :: PackedString -> Int -> Int -> PackedString
substrPS ps (I# begin) (I# end) = substrPS# ps begin end
+substrPS# :: PackedString -> Int# -> Int# -> PackedString
substrPS# ps s e
| s <# 0# || e <# s
= error "substrPS: bounds out of range"
len = lengthPS# ps
result_len# = (if e <# len then (e +# 1#) else len) -# s
- result_len = I# result_len#
-----------------------
fill_in :: MutableByteArray s Int -> Int# -> ST s ()
packCBytes len addr = runST (packCBytesST len addr)
packCBytesST :: Int -> Addr -> ST s PackedString
-packCBytesST len@(I# length#) (A# addr) =
+packCBytesST (I# length#) (A# addr) =
{-
allocate an array that will hold the string
(not forgetting the NUL byte at the end)