+% ------------------------------------------------------------------------------
+% $Id: PrelPack.lhs,v 1.16 2001/01/11 17:25:57 simonmar Exp $
%
-% (c) The GRASP/AQUA Project, Glasgow University, 1997
+% (c) The University of Glasgow, 1997-2000
%
+
\section[PrelPack]{Packing/unpacking bytes}
This module provides a small set of low-level functions for packing
packStringST, -- :: [Char] -> ST s (ByteArray Int)
packNBytesST, -- :: Int -> [Char] -> ST s (ByteArray Int)
- unpackCString, -- :: Addr -> [Char]
- unpackNBytes, -- :: Addr -> Int -> [Char]
- unpackNBytesST, -- :: Addr -> Int -> ST s [Char]
- unpackNBytesAccST, -- :: Addr -> Int -> [Char] -> ST s [Char]
+ unpackCString, -- :: Ptr a -> [Char]
+ unpackCStringST, -- :: Ptr a -> ST s [Char]
+ unpackNBytes, -- :: Ptr a -> Int -> [Char]
+ unpackNBytesST, -- :: Ptr a -> Int -> ST s [Char]
+ unpackNBytesAccST, -- :: Ptr a -> Int -> [Char] -> ST s [Char]
+ unpackNBytesAccST#,-- :: Ptr a -> Int -> [Char] -> ST s [Char]
unpackCString#, -- :: Addr# -> [Char] **
unpackNBytes#, -- :: Addr# -> Int# -> [Char] **
unpackNBytesST#, -- :: Addr# -> Int# -> ST s [Char]
write_ps_array, -- MutableByteArray s Int -> Int# -> Char# -> ST s ()
freeze_ps_array -- MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
-
)
where
import {-# SOURCE #-} PrelErr ( error )
import PrelList ( length )
import PrelST
-import PrelArr
-import PrelAddr
+import PrelNum
+import PrelByteArr
+import PrelPtr
\end{code}
%*********************************************************
%* *
-\subsection{Unpacking Addrs}
+\subsection{Unpacking Ptrs}
%* *
%*********************************************************
sequence of bytes into a list of @Char@s:
\begin{code}
-unpackCString :: Addr{- ptr. to NUL terminated string-} -> [Char]
-unpackCString a@(A# addr) =
- if a == ``NULL'' then
- []
- else
- unpackCString# addr
-
-unpackCString# :: Addr# -> [Char]
-unpackCString# addr
- = unpack 0#
+unpackCString :: Ptr a -> [Char]
+unpackCString a@(Ptr addr)
+ | a == nullPtr = []
+ | otherwise = unpackCString# addr
+
+unpackNBytes :: Ptr a -> Int -> [Char]
+unpackNBytes (Ptr addr) (I# l) = unpackNBytes# addr l
+
+unpackCStringST :: Ptr a{- ptr. to NUL terminated string-} -> ST s [Char]
+unpackCStringST a@(Ptr addr)
+ | a == nullPtr = return []
+ | otherwise = unpack 0#
where
unpack nh
- | ch `eqChar#` '\0'# = []
- | otherwise = C# ch : unpack (nh +# 1#)
+ | ch `eqChar#` '\0'# = return []
+ | otherwise = do
+ ls <- unpack (nh +# 1#)
+ return ((C# ch ) : ls)
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 []
+unpackNBytesST :: Ptr a -> Int -> ST s [Char]
+unpackNBytesST (Ptr 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#)
+unpackNBytesAccST :: Ptr a -> Int -> [Char] -> ST s [Char]
+unpackNBytesAccST (Ptr addr) (I# l) rest = unpackNBytesAccST# addr l rest
unpackNBytesST# :: Addr# -> Int# -> ST s [Char]
unpackNBytesST# addr# l# = unpackNBytesAccST# addr# l# []
unpackNBytesAccST# :: Addr# -> Int# -> [Char] -> ST s [Char]
-unpackNBytesAccST# addr 0# rest = return rest
-unpackNBytesAccST# addr len# rest = unpack rest (len# -# 1#)
+unpackNBytesAccST# _addr 0# rest = return rest
+unpackNBytesAccST# addr len# rest = unpack rest (len# -# 1#)
where
unpack acc i#
| i# <# 0# = return acc
\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#)
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#
- len | u > l = 0
+ len | l > u = 0
| otherwise = u-l+1
unpackNBytesBA# :: ByteArray# -> Int# -> [Char]
-unpackNBytesBA# bytes 0# = []
-unpackNBytesBA# bytes len# = unpack [] (len# -# 1#)
+unpackNBytesBA# _bytes 0# = []
+unpackNBytesBA# bytes len# = unpack [] (len# -# 1#)
where
unpack acc i#
| i# <# 0# = acc
\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)
packNBytesST len str
packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
-packNBytesST len@(I# length#) str =
+packNBytesST (I# length#) str =
{-
allocate an array that will hold the string
(not forgetting the NUL byte at the end)
freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
new_ps_array size = ST $ \ s ->
- case (newCharArray# size s) of { StateAndMutableByteArray# s2# barr# ->
- STret s2# (MutableByteArray bot barr#) }
+ case (newByteArray# size s) of { (# s2#, 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# ->
- STret s2# () }
+ (# s2#, () #) }
-- same as unsafeFreezeByteArray
-freeze_ps_array (MutableByteArray _ arr#) len# = ST $ \ s# ->
- case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
- STret s2# (ByteArray (0,I# len#) frozen#) }
+freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
+ case unsafeFreezeByteArray# arr# s# of { (# s2#, 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}