X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelPack.lhs;h=934ffa7b4bd49e651dd9bed253c3cc6a1c7498ba;hb=bb864806cef069b0bba9fbaa92b4135f99041dcd;hp=5def5736dacb3fae72872610d5cd11465bd0c523;hpb=c415cd35368f45739132fc180837fc07f0490921;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelPack.lhs b/ghc/lib/std/PrelPack.lhs index 5def573..934ffa7 100644 --- a/ghc/lib/std/PrelPack.lhs +++ b/ghc/lib/std/PrelPack.lhs @@ -53,6 +53,7 @@ import PrelList ( length ) import PrelST import PrelNum import PrelArr +import PrelByteArr import PrelAddr \end{code} @@ -67,11 +68,14 @@ Primitives for converting Addrs pointing to external sequence of bytes into a list of @Char@s: \begin{code} -unpackCString :: Addr{- ptr. to NUL terminated string-} -> [Char] +unpackCString :: Addr -> [Char] unpackCString a@(A# addr) | a == nullAddr = [] | otherwise = unpackCString# addr +unpackNBytes :: Addr -> Int -> [Char] +unpackNBytes (A# addr) (I# l) = unpackNBytes# addr l + unpackCStringST :: Addr{- ptr. to NUL terminated string-} -> ST s [Char] unpackCStringST a@(A# addr) | a == nullAddr = return [] @@ -85,37 +89,12 @@ unpackCStringST a@(A# addr) where ch = indexCharOffAddr# addr nh -unpackCString# :: Addr# -> [Char] -unpackCString# addr - = unpack 0# - where - unpack nh - | ch `eqChar#` '\0'# = [] - | otherwise = C# ch : unpack (nh +# 1#) - where - ch = indexCharOffAddr# addr nh - -unpackNBytes :: Addr -> Int -> [Char] -unpackNBytes (A# addr) (I# l) = unpackNBytes# addr l - unpackNBytesST :: Addr -> Int -> ST s [Char] unpackNBytesST (A# addr) (I# l) = unpackNBytesAccST# addr l [] unpackNBytesAccST :: Addr -> Int -> [Char] -> ST s [Char] unpackNBytesAccST (A# addr) (I# l) rest = unpackNBytesAccST# addr l rest -unpackNBytes# :: Addr# -> Int# -> [Char] - -- This one is called by the compiler to unpack literal strings with NULs in them; rare. - -- It's strict! -unpackNBytes# _addr 0# = [] -unpackNBytes# addr len# = unpack [] (len# -# 1#) - where - unpack acc i# - | i# <# 0# = acc - | otherwise = - case indexCharOffAddr# addr i# of - ch -> unpack (C# ch : acc) (i# -# 1#) - unpackNBytesST# :: Addr# -> Int# -> ST s [Char] unpackNBytesST# addr# l# = unpackNBytesAccST# addr# l# [] @@ -141,7 +120,7 @@ Converting byte arrays into list of chars: \begin{code} unpackCStringBA :: ByteArray Int -> [Char] -unpackCStringBA (ByteArray (l@(I# l#),u@(I# u#)) bytes) +unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes) | l > u = [] | otherwise = unpackCStringBA# bytes (u# -# l# +# 1#) @@ -160,7 +139,7 @@ unpackCStringBA# bytes len ch = indexCharArray# bytes nh unpackNBytesBA :: ByteArray Int -> Int -> [Char] -unpackNBytesBA (ByteArray (l,u) bytes) i +unpackNBytesBA (ByteArray l u bytes) i = unpackNBytesBA# bytes len# where len# = case max 0 (min i len) of I# v# -> v# @@ -190,7 +169,7 @@ Converting a list of chars into a packed @ByteArray@ representation. \begin{code} packCString# :: [Char] -> ByteArray# -packCString# str = case (packString str) of { ByteArray _ bytes -> bytes } +packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes } packString :: [Char] -> ByteArray Int packString str = runST (packStringST str) @@ -232,47 +211,18 @@ freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int) new_ps_array size = ST $ \ s -> case (newCharArray# size s) of { (# s2#, barr# #) -> - (# s2#, MutableByteArray bot barr# #) } + (# s2#, MutableByteArray bot bot barr# #) } where bot = error "new_ps_array" -write_ps_array (MutableByteArray _ barr#) n ch = ST $ \ s# -> +write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# -> case writeCharArray# barr# n ch s# of { s2# -> (# s2#, () #) } -- same as unsafeFreezeByteArray -freeze_ps_array (MutableByteArray _ arr#) len# = ST $ \ s# -> +freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# -> case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) -> - (# s2#, ByteArray (0,I# len#) frozen# #) } + (# s2#, ByteArray 0 (I# len#) frozen# #) } \end{code} -%******************************************************** -%* * -\subsection{Misc} -%* * -%******************************************************** - -The compiler may emit these two - -\begin{code} -unpackAppendCString# :: Addr# -> [Char] -> [Char] -unpackAppendCString# addr rest - = unpack 0# - where - unpack nh - | ch `eqChar#` '\0'# = rest - | otherwise = C# ch : unpack (nh +# 1#) - where - ch = indexCharOffAddr# addr nh - -unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a -unpackFoldrCString# addr f z - = unpack 0# - where - unpack nh - | ch `eqChar#` '\0'# = z - | otherwise = C# ch `f` unpack (nh +# 1#) - where - ch = indexCharOffAddr# addr nh -\end{code}