X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FPrimPacked.lhs;h=f2d034dcee619b86e0b92fd5fb78763130cdaf86;hb=2a2efb720c0fdc06fe749f96f284b00b30f8f3f7;hp=aa582e7fd73ecc2741195fee7a045e84fd2310fc;hpb=b3e4cb91c4386c4d1456b896da1abb964f2124a6;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs
index aa582e7..f2d034d 100644
--- 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 >>
@@ -201,7 +185,7 @@ freeze_ps_array :: MBA s -> Int# -> ST s BA
 #if __GLASGOW_HASKELL__ < 411
 #define NEW_BYTE_ARRAY newCharArray#
 #else 
-#define NEW_BYTE_ARRAY newByteArray#
+#define NEW_BYTE_ARRAY newPinnedByteArray#
 #endif
 
 new_ps_array size = ST $ \ s ->
@@ -224,49 +208,58 @@ Compare two equal-length strings for equality:
 \begin{code}
 eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
 eqStrPrefix a# barr# len# = 
-  unsafePerformIO $ do
+  inlinePerformIO $ do
    x <- memcmp_ba a# barr# (I# len#)
    return (x == 0)
 
--- unused???
+#ifdef UNUSED
 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
 eqCharStrPrefix a1# a2# len# = 
-  unsafePerformIO $ do
+  inlinePerformIO $ do
    x <- memcmp a1# a2# (I# len#)
    return (x == 0)
+#endif
 
 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
 eqStrPrefixBA b1# b2# start# len# = 
-  unsafePerformIO $ do
+  inlinePerformIO $ do
     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
+  inlinePerformIO $ do
     x <- memcmp_baoff b2# (I# start#) a# (I# len#) 
     return (x == 0)
+#endif
 \end{code}
 
 \begin{code}
+-- Just like unsafePerformIO, but we inline it.  This is safe when
+-- there are no side effects, and improves performance.
+{-# INLINE inlinePerformIO #-}
+inlinePerformIO :: IO a -> a
+inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
+
 #if __GLASGOW_HASKELL__ <= 408
 strLength (Ptr a#) = ghc_strlen a#
-foreign import ccall "ghc_strlen" unsafe
+foreign import ccall unsafe "ghc_strlen" 
   ghc_strlen :: Addr# -> Int
 #else
-foreign import ccall "ghc_strlen" unsafe
+foreign import ccall unsafe "ghc_strlen" 
   strLength :: Ptr () -> Int
 #endif
 
-foreign import ccall "ghc_memcmp" unsafe 
+foreign import ccall unsafe "ghc_memcmp"
   memcmp :: Addr# -> Addr# -> Int -> IO Int
 
-foreign import ccall "ghc_memcmp" unsafe 
+foreign import ccall unsafe "ghc_memcmp" 
   memcmp_ba :: Addr# -> ByteArray# -> Int -> IO Int
 
-foreign import ccall "ghc_memcmp_off" unsafe
+foreign import ccall unsafe "ghc_memcmp_off"
   memcmp_baoff :: ByteArray# -> Int -> Addr# -> Int -> IO Int
 
-foreign import ccall "ghc_memcmp_off" unsafe
+foreign import ccall unsafe "ghc_memcmp_off"
   memcmp_baoff_ba :: ByteArray# -> Int -> ByteArray# -> Int -> IO Int
 \end{code}