More modules that need LANGUAGE BangPatterns

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

diff --git a/compiler/utils/StringBuffer.lhs b/compiler/utils/StringBuffer.lhs
index 1a30edb..5d1bfa6 100644 (file)
--- a/compiler/utils/StringBuffer.lhs
+++ b/compiler/utils/StringBuffer.lhs
@@ -6,6 +6,11 @@
 Buffers for scanning string input stored in external arrays.
 
 \begin{code}
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -O -funbox-strict-fields #-}
+-- We always optimise this, otherwise performance of a non-optimised
+-- compiler is severely affected
+
 module StringBuffer
        (
         StringBuffer(..),
@@ -49,15 +54,7 @@ import System.IO                ( hGetBuf, hFileSize,IOMode(ReadMode), hClose
 
 import GHC.Exts
 
-#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ >= 601
 import System.IO                ( openBinaryFile )
-#else
-import IOExts                   ( openFileEx, IOModeEx(..) )
-#endif
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 601
-openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
-#endif
 
 -- -----------------------------------------------------------------------------
 -- The StringBuffer type
@@ -83,7 +80,7 @@ data StringBuffer
 instance Show StringBuffer where
         showsPrec _ s = showString "<stringbuffer("
                       . shows (len s) . showString "," . shows (cur s)
-                      . showString ">"
+                      . showString ")>"
 
 -- -----------------------------------------------------------------------------
 -- Creation / Destruction
@@ -133,15 +130,18 @@ appendStringBuffers sb1 sb2
          withForeignPtr newBuf $ \ptr ->
           withForeignPtr (buf sb1) $ \sb1Ptr ->
            withForeignPtr (buf sb2) $ \sb2Ptr ->
-             do copyArray (sb1Ptr `advancePtr` cur sb1) ptr (calcLen sb1)
-                copyArray (sb2Ptr `advancePtr` cur sb2) (ptr `advancePtr` cur sb1) (calcLen sb2)
+             do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len
+                copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len
                 pokeArray (ptr `advancePtr` size) [0,0,0]
                 return (StringBuffer newBuf size 0)
-    where calcLen sb = len sb - cur sb
-          size = calcLen sb1 + calcLen sb2
-
-stringToStringBuffer :: String -> IO StringBuffer
-stringToStringBuffer str = do
+    where sb1_len = calcLen sb1
+          sb2_len = calcLen sb2
+          calcLen sb = len sb - cur sb
+          size =  sb1_len + sb2_len
+
+stringToStringBuffer :: String -> StringBuffer
+stringToStringBuffer str =
+ unsafePerformIO $ do
   let size = utf8EncodedLength str
   buf <- mallocForeignPtrArray (size+3)
   withForeignPtr buf $ \ptr -> do
@@ -226,7 +226,7 @@ parseUnsignedInteger (StringBuffer buf _ cur) len radix char_to_int
     --LOL, in implementations where the indexing needs slow unsafePerformIO,
     --this is less (not more) efficient than using the IO monad explicitly
     --here.
-    ptr' = pUnbox ptr
+    !ptr' = pUnbox ptr
     byteOff i = cBox (indexWord8OffFastPtrAsFastChar ptr' (iUnbox (cur + i)))
     go i x | i == len  = x
            | otherwise = case byteOff i of