[project @ 2002-12-17 11:39:41 by simonmar]

Fix recent breakage on the HEAD.  This was caused by the fix to
Lex.lhs to treat primitive strings as "narrow" FastStrings in all
cases, rather than Unicode ("wide") FastStrings if the string
contained a '\0'.  The problem is that narrow FastStrings aren't set
up to handle strings containing '\0'.  They used to be, but it got
broken somewhere along the line.

This commit:

 - remove the '\0' test from unpackCStringBA (it takes a length
   argument anyway), and rename it to unpackNBytesBA.  This fixes
   the bug.

 - remove the '\0' terminator from all strings generated by the
   functions in PrimPacked.  The terminators aren't required,
   as far as I can tell.  This should have a tiny but positive
   effect on compile times.

MERGE TO STABLE

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index ea36957..eadbd96 100644 (file)
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -126,7 +126,7 @@ nullFastString (UnicodeStr _ []) = True
 nullFastString (UnicodeStr _ (_:_)) = False
 
 unpackFS :: FastString -> String
-unpackFS (FastString _ l# ba#) = unpackCStringBA (BA ba#) (I# l#)
+unpackFS (FastString _ l# ba#) = unpackNBytesBA (BA ba#) (I# l#)
 unpackFS (UnicodeStr _ s) = map chr s
 
 unpackIntFS :: FastString -> [Int]

diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs
index aa582e7..f7f0201 100644 (file)
--- a/ghc/compiler/utils/PrimPacked.lhs
+++ b/ghc/compiler/utils/PrimPacked.lhs
@@ -14,7 +14,7 @@ module PrimPacked (
        Ptr(..), nullPtr, writeCharOffPtr, plusAddr#,
        BA(..), MBA(..),
        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
@@ -91,7 +91,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 +100,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 +109,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 +128,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 +143,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 >>
@@ -169,10 +162,8 @@ 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 +173,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 >>

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 60bca85..d7cfddd 100644 (file)
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -504,10 +504,9 @@ lexemeToString (StringBuffer fo len# start_pos# current#) =
  if start_pos# ==# current# then
     ""
  else
-    unpackCStringBA
-       (copySubStr fo (I# start_pos#) (I# (current# -# start_pos#)))
-       (I# len#)
-    
+    let len = I# (current# -# start_pos#) in
+    unpackNBytesBA (copySubStr fo (I# start_pos#) len) len
+
 lexemeToFastString :: StringBuffer -> FastString
 lexemeToFastString (StringBuffer fo l# start_pos# current#) =
  if start_pos# ==# current# then