@@ -31,9 +31,11 @@ module Data.Attoparsec.ByteString.Buffer
3131 , unsafeDrop
3232 ) where
3333
34+import Control.Applicative ((<$>))
3435import Control.Exception (assert)
3536import Data.Attoparsec.ByteString.Fhthagn (inlinePerformIO)
3637import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
38+import Data.IORef (IORef, atomicModifyIORef, newIORef)
3739import Data.List (foldl1')
3840import Data.Monoid (Monoid(..))
3941import Data.Word (Word8)
@@ -42,12 +44,15 @@ import Foreign.Ptr (plusPtr)
4244import Foreign.Storable (peekByteOff)
4345import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
4446import Prelude hiding (length)
47+import System.IO.Unsafe (unsafePerformIO)
4548
4649data Buffer = Buf {
4750 _fp :: {-# UNPACK #-} !(ForeignPtr Word8)
4851 , _off :: {-# UNPACK #-} !Int
4952 , _len :: {-# UNPACK #-} !Int
5053 , _cap :: {-# UNPACK #-} !Int
54+ , _gen :: {-# UNPACK #-} !Int
55+ , _ref :: {-# UNPACK #-} !(IORef Int)
5156 }
5257
5358instance Show Buffer where
@@ -57,55 +62,58 @@ instance Show Buffer where
5762-- copies in the (hopefully) common case of no further input being fed
5863-- to us.
5964buffer :: ByteString -> Buffer
60−buffer (PS fp off len) = Buf fp off len len
65+buffer (PS fp off len) = inlinePerformIO $
66+ Buf fp off len len 0 <$> newIORef 0
6167
6268unbuffer :: Buffer -> ByteString
63−unbuffer (Buf fp off len _cap) = PS fp off len
69+unbuffer (Buf fp off len _cap _gen _ref) = PS fp off len
6470
6571instance Monoid Buffer where
66− mempty = Buf nullForeignPtr 0 0 0
72+ mempty = unsafePerformIO $ Buf nullForeignPtr 0 0 0 0 <$> newIORef 0
73+ {-# NOINLINE mempty #-}
6774
68− mappend (Buf _ _ _ 0) b = b
69− mappend a (Buf _ _ _ 0) = a
70− mappend (Buf fp0 off0 len0 cap0) (Buf fp1 off1 len1 _cap1) =
75+ mappend (Buf _ _ _ 0 _ _) b = b
76+ mappend a (Buf _ _ _ 0 _ _) = a
77+ mappend (Buf fp0 off0 len0 cap0 gen ref) (Buf fp1 off1 len1 _ _ _) =
7178 inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
7279 withForeignPtr fp1 $ \ptr1 -> do
80+ gen' <- atomicModifyIORef ref (\a -> let a' = a+1 in (a',a'))
7381 let newlen = len0 + len1
74− if newlen <= cap0
82+ if gen' == gen+1 && newlen <= cap0
7583 then do
7684 memcpy (ptr0 `plusPtr` (off0+len0))
7785 (ptr1 `plusPtr` off1)
7886 len1
79− return (Buf fp0 off0 newlen cap0)
87+ return (Buf fp0 off0 newlen cap0 gen' ref)
8088 else do
8189 let newcap = newlen * 2
8290 fp <- mallocPlainForeignPtrBytes newcap
8391 withForeignPtr fp $ \ptr -> do
8492 memcpy ptr (ptr0 `plusPtr` off0) len0
8593 memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) len1
86− return (Buf fp 0 newlen newcap)
94+ return (Buf fp 0 newlen newcap gen' ref)
8795
8896 mconcat [] = mempty
8997 mconcat xs = foldl1' mappend xs
9098
9199length :: Buffer -> Int
92−length (Buf _ _ len _) = len
100+length (Buf _ _ len _ _ _) = len
93101{-# INLINE length #-}
94102
95103unsafeIndex :: Buffer -> Int -> Word8
96−unsafeIndex (Buf fp off len _cap) i = assert (i >= 0 && i < len) .
104+unsafeIndex (Buf fp off len _ _ _) i = assert (i >= 0 && i < len) .
97105 inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)
98106{-# INLINE unsafeIndex #-}
99107
100108substring :: Int -> Int -> Buffer -> ByteString
101−substring s l (Buf fp off len _cap) =
109+substring s l (Buf fp off len _ _ _) =
102110 assert (s >= 0 && s <= len) .
103111 assert (l >= 0 && l <= len-s) $
104112 PS fp (off+s) l
105113{-# INLINE substring #-}
106114
107115unsafeDrop :: Int -> Buffer -> ByteString
108−unsafeDrop s (Buf fp off len _cap) =
116+unsafeDrop s (Buf fp off len _ _ _) =
109117 assert (s >= 0 && s <= len) $
110118 PS fp (off+s) (len-s)
111119{-# INLINE unsafeDrop #-}