[project @ 1999-12-20 10:34:27 by simonpj]

[ghc-hetmet.git] / ghc / lib / std / PrelPack.lhs

diff --git a/ghc/lib/std/PrelPack.lhs b/ghc/lib/std/PrelPack.lhs
index b9f2527..187d2a7 100644 (file)
--- a/ghc/lib/std/PrelPack.lhs
+++ b/ghc/lib/std/PrelPack.lhs
@@ -23,6 +23,7 @@ module PrelPack
        packNBytesST,      -- :: Int -> [Char] -> ST s (ByteArray Int)
 
        unpackCString,     -- :: Addr -> [Char]
+       unpackCStringST,   -- :: Addr -> ST s [Char]
        unpackNBytes,      -- :: Addr -> Int -> [Char]
        unpackNBytesST,    -- :: Addr -> Int -> ST s [Char]
        unpackNBytesAccST, -- :: Addr -> Int -> [Char] -> ST s [Char]
@@ -50,7 +51,9 @@ import PrelBase
 import {-# SOURCE #-} PrelErr ( error )
 import PrelList ( length )
 import PrelST
+import PrelNum
 import PrelArr
+import PrelByteArr
 import PrelAddr
 
 \end{code}
@@ -66,11 +69,22 @@ 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 a@(A# addr)
+  | a == nullAddr  = []
+  | otherwise     = unpackCString# addr
+     
+unpackCStringST  :: Addr{- ptr. to NUL terminated string-} -> ST s [Char]
+unpackCStringST a@(A# addr)
+  | a == nullAddr  = return []
+  | otherwise     = unpack 0#
+  where
+    unpack nh
+      | ch `eqChar#` '\0'# = return []
+      | otherwise         = do
+               ls <- unpack (nh +# 1#)
+               return ((C# ch ) : ls)
+      where
+       ch = indexCharOffAddr# addr nh
 
 unpackCString# :: Addr#  -> [Char]
 unpackCString# addr 
@@ -94,8 +108,8 @@ 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#)
+unpackNBytes# _addr 0#   = []
+unpackNBytes#  addr len# = unpack [] (len# -# 1#)
     where
      unpack acc i#
       | i# <# 0#  = acc
@@ -107,8 +121,8 @@ 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
@@ -128,7 +142,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#)
 
@@ -147,7 +161,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#
@@ -155,8 +169,8 @@ unpackNBytesBA (ByteArray (l,u) bytes) i
         | 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
@@ -177,7 +191,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)
@@ -188,7 +202,7 @@ 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)
@@ -219,18 +233,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}