Buffers for scanning string input stored in external arrays.
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -O -funbox-strict-fields #-}
+-- We always optimise this, otherwise performance of a non-optimised
+-- compiler is severely affected
module StringBuffer
(
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
instance Show StringBuffer where
showsPrec _ s = showString "<stringbuffer("
. shows (len s) . showString "," . shows (cur s)
- . showString ">"
+ . showString ")>"
-- -----------------------------------------------------------------------------
-- Creation / Destruction
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
currentChar = fst . nextChar
prevChar :: StringBuffer -> Char -> Char
-prevChar (StringBuffer buf len 0) deflt = deflt
-prevChar (StringBuffer buf len cur) deflt =
+prevChar (StringBuffer _ _ 0) deflt = deflt
+prevChar (StringBuffer buf _ cur) _ =
inlinePerformIO $ do
withForeignPtr buf $ \p -> do
p' <- utf8PrevChar (p `plusPtr` cur)
--LOL, in implementations where the indexing needs slow unsafePerformIO,
--this is less (not more) efficient than using the IO monad explicitly
--here.
- byteOff p i = cBox (indexWord8OffFastPtrAsFastChar
- (pUnbox ptr) (iUnbox (cur+i)))
+ !ptr' = pUnbox ptr
+ byteOff i = cBox (indexWord8OffFastPtrAsFastChar ptr' (iUnbox (cur + i)))
go i x | i == len = x
- | otherwise = case byteOff ptr i of
- char -> go (i+1) (x * radix + toInteger (char_to_int char))
+ | otherwise = case byteOff i of
+ char -> go (i + 1) (x * radix + toInteger (char_to_int char))
in go 0 0
\end{code}