From 4351e77131c483a08d58bcc5eee89ae8ca044ade Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Mon, 20 Jul 1998 09:39:14 +0000
Subject: [PATCH] [project @ 1998-07-20 09:39:14 by sof] new functions:
unpackCStringIO, unpackCStringLenIO, unpackPSIO, unpackNBytesPS,
cByteArrayToPS
---
ghc/lib/misc/PackedString.lhs | 88 +++++++++++++++++++++++++++++++++--
1 file changed, 85 insertions(+), 3 deletions(-)
diff --git a/ghc/lib/misc/PackedString.lhs b/ghc/lib/misc/PackedString.lhs
index b53d1d968937..4bb3520987e0 100644
--- a/ghc/lib/misc/PackedString.lhs
+++ b/ghc/lib/misc/PackedString.lhs
@@ -17,6 +17,7 @@ module PackedString (
packCBytesST, -- :: Int -> Addr -> ST s PackedString
byteArrayToPS, -- :: ByteArray Int -> PackedString
+ cByteArrayToPS, -- :: ByteArray Int -> PackedString
unsafeByteArrayToPS, -- :: ByteArray a -> Int -> PackedString
psToByteArray, -- :: PackedString -> ByteArray Int
@@ -24,7 +25,10 @@ module PackedString (
psToCString, -- :: PackedString -> Addr
isCString, -- :: PackedString -> Bool
- unpackPS, -- :: PackedString -> [Char]
+ unpackPS, -- :: PackedString -> [Char]
+ unpackNBytesPS, -- :: PackedString -> Int -> [Char]
+ unpackPSIO, -- :: PackedString -> IO [Char]
+
{-LATER:
hPutPS, -- :: Handle -> PackedString -> IO ()
putPS, -- :: FILE -> PackedString -> PrimIO () -- ToDo: more sensible type
@@ -70,8 +74,14 @@ module PackedString (
-- Converting to C strings
packCString#,
- unpackCString#, unpackCString2#, unpackAppendCString#, unpackFoldrCString#,
- unpackCString
+ unpackCString#,
+ unpackCString2#,
+ unpackAppendCString#,
+ unpackFoldrCString#,
+ unpackCString,
+ unpackCStringIO,
+ unpackCStringLenIO
+
) where
import GlaExts
@@ -262,6 +272,28 @@ byteArrayToPS (ByteArray ixs@(_, ix_end) frozen#) =
in
PS frozen# n# (byteArrayHasNUL# frozen# n#)
+-- byteArray is zero-terminated, make everything upto it
+-- a packed string.
+cByteArrayToPS :: ByteArray Int -> PackedString
+cByteArrayToPS (ByteArray ixs@(_, ix_end) frozen#) =
+ let
+ n# =
+ case (
+ if null (range ixs)
+ then 0
+ else ((index ixs ix_end) + 1)
+ ) of { I# x -> x }
+ len# = findNull 0#
+
+ findNull i#
+ | i# ==# n# = n#
+ | ch# `eqChar#` '\0'# = i# -- everything upto the sentinel
+ | otherwise = findNull (i# +# 1#)
+ where
+ ch# = indexCharArray# frozen# i#
+ in
+ PS frozen# len# False
+
unsafeByteArrayToPS :: ByteArray a -> Int -> PackedString
unsafeByteArrayToPS (ByteArray _ frozen#) (I# n#)
= PS frozen# n# (byteArrayHasNUL# frozen# n#)
@@ -332,6 +364,32 @@ unpackPS (CPS addr len)
| otherwise = C# ch : unpack (nh +# 1#)
where
ch = indexCharOffAddr# addr nh
+
+unpackNBytesPS :: PackedString -> Int -> [Char]
+unpackNBytesPS ps len@(I# l#)
+ | len < 0 = error ("PackedString.unpackNBytesPS: negative length "++ show len)
+ | otherwise =
+ case ps of
+ PS bytes len# has_null -> unpackPS (PS bytes (min# len# l#) has_null)
+ CPS a len# -> unpackPS (CPS a (min# len# l#))
+ where
+ min# x# y#
+ | x# ># y# = x#
+ | otherwise = y#
+
+unpackPSIO :: PackedString -> IO String
+unpackPSIO ps@(PS bytes len has_null) = return (unpackPS ps)
+unpackPSIO (CPS addr len)
+ = unpack 0#
+ where
+ unpack nh = do
+ ch <- readCharOffAddr (A# addr) (I# nh)
+ if ch == '\0'
+ then return []
+ else do
+ ls <- unpack (nh +# 1#)
+ return (ch : ls)
+
\end{code}
Output a packed string via a handle:
@@ -1039,6 +1097,30 @@ unpackCString# addr
where
ch = indexCharOffAddr# addr nh
+unpackCStringIO :: Addr -> IO String
+unpackCStringIO addr = unpack 0#
+ where
+ unpack nh = do
+ ch <- readCharOffAddr addr (I# nh)
+ if ch == '\0'
+ then return []
+ else do
+ ls <- unpack (nh +# 1#)
+ return (ch : ls)
+
+-- unpack 'len' chars
+unpackCStringLenIO :: Addr -> Int -> IO String
+unpackCStringLenIO addr l@(I# len#)
+ | len# <# 0# = fail (userError ("PackedString.unpackCStringLenIO: negative length (" ++ show l ++ ")"))
+ | otherwise = unpack len#
+ where
+ unpack 0# = return []
+ unpack nh = do
+ ch <- readCharOffAddr addr (I# nh)
+ ls <- unpack (nh -# 1#)
+ return (ch : ls)
+
+
unpackCString2# addr len
-- This one is called by the compiler to unpack literal strings with NULs in them; rare.
= unpackPS (packCBytes (I# len) (A# addr))
--
GitLab