[project @ 2005-03-04 19:19:56 by sof]

[ghc-hetmet.git] / ghc / compiler / utils / PrimPacked.lhs

diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs
index aa582e7..1a47e30 100644 (file)
--- a/ghc/compiler/utils/PrimPacked.lhs
+++ b/ghc/compiler/utils/PrimPacked.lhs
@@ -11,18 +11,15 @@ subsystem, mostly.
 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
 
 module PrimPacked (
-       Ptr(..), nullPtr, writeCharOffPtr, plusAddr#,
-       BA(..), MBA(..),
+       Ptr(..), nullPtr, plusAddr#,
+       BA(..),
        packString,        -- :: String -> (Int, BA)
-       unpackCStringBA,   -- :: BA -> Int -> [Char]
+       unpackNBytesBA,    -- :: BA -> Int -> [Char]
         strLength,        -- :: Ptr CChar -> Int
         copyPrefixStr,    -- :: Addr# -> Int -> BA
-        copySubStr,       -- :: Addr# -> Int -> Int -> BA
         copySubStrBA,     -- :: BA -> Int -> Int -> BA
         eqStrPrefix,      -- :: Addr# -> ByteArray# -> Int# -> Bool
-        eqCharStrPrefix,   -- :: Addr# -> Addr# -> Int# -> Bool
         eqStrPrefixBA,    -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
-        eqCharStrPrefixBA, -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
  ) where
 
 -- This #define suppresses the "import FastString" that
@@ -70,11 +67,6 @@ nullPtr = Ptr (int2Addr# 0#)
 plusAddr# :: Addr# -> Int# -> Addr#
 plusAddr# a# i# = int2Addr# (addr2Int# a# +# i#)
 #endif
-
--- more compatibility: in 5.00+ we would use the Storable class for this,
--- but 4.08 doesn't have it.
-writeCharOffPtr (Ptr a#) (I# i#) (C# c#) = IO $ \s# ->
-  case writeCharOffAddr# a# i# c# s# of { s# -> (# s#, () #) }
 \end{code}
 
 Wrapper types for bytearrays
@@ -91,7 +83,7 @@ packString str = (l, arr)
   l@(I# length#) = length str
 
   arr = runST (do
-    ch_array <- new_ps_array (length# +# 1#)
+    ch_array <- new_ps_array length#
       -- fill in packed string from "str"
     fill_in ch_array 0# str
       -- freeze the puppy:
@@ -100,9 +92,7 @@ packString str = (l, arr)
 
   fill_in :: MBA s -> Int# -> [Char] -> ST s ()
   fill_in arr_in# idx [] =
-   write_ps_array arr_in# idx (chr# 0#) >>
    return ()
-
   fill_in arr_in# idx (C# c : cs) =
    write_ps_array arr_in# idx c         >>
    fill_in arr_in# (idx +# 1#) cs
@@ -111,21 +101,18 @@ packString str = (l, arr)
 Unpacking a string
 
 \begin{code}
-unpackCStringBA :: BA -> Int -> [Char]
-unpackCStringBA (BA bytes) (I# len)
+unpackNBytesBA :: BA -> Int -> [Char]
+unpackNBytesBA (BA bytes) (I# len)
  = unpack 0#
  where
     unpack nh
-      | nh >=# len         || 
-        ch `eqChar#` '\0'#    = []
-      | otherwise            = C# ch : unpack (nh +# 1#)
+      | nh >=# len  = []
+      | otherwise   = C# ch : unpack (nh +# 1#)
       where
        ch = indexCharArray# bytes nh
 \end{code}
 
-Copying a char string prefix into a byte array,
-{\em assuming} the prefix does not contain any
-NULs.
+Copying a char string prefix into a byte array.
 
 \begin{code}
 copyPrefixStr :: Addr# -> Int -> BA
@@ -133,9 +120,8 @@ copyPrefixStr a# len@(I# length#) = copy' length#
  where
    copy' length# = runST (do
      {- allocate an array that will hold the string
-       (not forgetting the NUL at the end)
      -}
-     ch_array <- new_ps_array (length# +# 1#)
+     ch_array <- new_ps_array length#
      {- Revert back to Haskell-only solution for the moment.
        _ccall_ memcpy ch_array (A# a) len        >>=  \ () ->
        write_ps_array ch_array length# (chr# 0#) >>
@@ -149,8 +135,7 @@ copyPrefixStr a# len@(I# length#) = copy' length#
    fill_in :: MBA s -> Int# -> ST s ()
    fill_in arr_in# idx
       | idx ==# length#
-      = write_ps_array arr_in# idx (chr# 0#) >>
-       return ()
+      = return ()
       | otherwise
       = case (indexCharOffAddr# a# idx) of { ch ->
        write_ps_array arr_in# idx ch >>
@@ -161,18 +146,18 @@ Copying out a substring, assume a 0-indexed string:
 (and positive lengths, thank you).
 
 \begin{code}
+#ifdef UNUSED
 copySubStr :: Addr# -> Int -> Int -> BA
 copySubStr a# (I# start#) length =
   copyPrefixStr (a# `plusAddr#` start#)  length
+#endif
 
 copySubStrBA :: BA -> Int -> Int -> BA
 copySubStrBA (BA barr#) (I# start#) len@(I# length#) = ba
  where
   ba = runST (do
-    {- allocate an array that will hold the string
-      (not forgetting the NUL at the end)
-    -}
-    ch_array <- new_ps_array (length# +# 1#)
+     -- allocate an array that will hold the string
+    ch_array <- new_ps_array length#
      -- fill in packed string from "addr"
     fill_in ch_array 0#
      -- freeze the puppy:
@@ -182,8 +167,7 @@ copySubStrBA (BA barr#) (I# start#) len@(I# length#) = ba
   fill_in :: MBA s -> Int# -> ST s ()
   fill_in arr_in# idx
       | idx ==# length#
-      = write_ps_array arr_in# idx (chr# 0#) >>
-       return ()
+      = return ()
       | otherwise
       = case (indexCharArray# barr# (start# +# idx)) of { ch ->
        write_ps_array arr_in# idx ch >>
@@ -228,12 +212,13 @@ eqStrPrefix a# barr# len# =
    x <- memcmp_ba a# barr# (I# len#)
    return (x == 0)
 
--- unused???
+#ifdef UNUSED
 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
 eqCharStrPrefix a1# a2# len# = 
   unsafePerformIO $ do
    x <- memcmp a1# a2# (I# len#)
    return (x == 0)
+#endif
 
 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
 eqStrPrefixBA b1# b2# start# len# = 
@@ -241,11 +226,13 @@ eqStrPrefixBA b1# b2# start# len# =
     x <- memcmp_baoff_ba b2# (I# start#) b1# (I# len#)
     return (x == 0)
 
+#ifdef UNUSED
 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
 eqCharStrPrefixBA a# b2# start# len# = 
   unsafePerformIO $ do
     x <- memcmp_baoff b2# (I# start#) a# (I# len#) 
     return (x == 0)
+#endif
 \end{code}
 
 \begin{code}