From 4be8b8b3051b020ef813176b75c21d11ebaab1d9 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 17 Dec 2002 11:39:42 +0000
Subject: [PATCH] [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
---
 ghc/compiler/utils/FastString.lhs   |    2 +-
 ghc/compiler/utils/PrimPacked.lhs   |   34 ++++++++++++----------------------
 ghc/compiler/utils/StringBuffer.lhs |    7 +++----
 3 files changed, 16 insertions(+), 27 deletions(-)

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index ea36957..eadbd96 100644
--- 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
--- 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
--- 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
-- 
1.7.10.4