@@ -38,8 +38,8 @@ import Data.List (foldl1')
3838import Data.Monoid (Monoid(..))
3939import Data.Word (Word8)
4040import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
41−import Foreign.Ptr (plusPtr)
42−import Foreign.Storable (peekByteOff)
41+import Foreign.Ptr (castPtr, plusPtr)
42+import Foreign.Storable (peek, peekByteOff, poke, sizeOf)
4343import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
4444import Prelude hiding (length)
4545
@@ -48,6 +48,7 @@ data Buffer = Buf {
4848 , _off :: {-# UNPACK #-} !Int
4949 , _len :: {-# UNPACK #-} !Int
5050 , _cap :: {-# UNPACK #-} !Int
51+ , _gen :: {-# UNPACK #-} !Int
5152 }
5253
5354instance Show Buffer where
@@ -57,56 +58,65 @@ instance Show Buffer where
5758-- copies in the (hopefully) common case of no further input being fed
5859-- to us.
5960buffer :: ByteString -> Buffer
60−buffer (PS fp off len) = Buf fp off len len
61+buffer (PS fp off len) = Buf fp off len len 0
6162
6263unbuffer :: Buffer -> ByteString
63−unbuffer (Buf fp off len _cap) = PS fp off len
64+unbuffer (Buf fp off len _ _) = PS fp off len
6465
6566instance Monoid Buffer where
66− mempty = Buf nullForeignPtr 0 0 0
67+ mempty = Buf nullForeignPtr 0 0 0 0
6768
68− mappend (Buf _ _ _ 0) b = b
69− mappend a (Buf _ _ _ 0) = a
70− mappend (Buf fp0 off0 len0 cap0) (Buf fp1 off1 len1 _cap1) =
69+ mappend (Buf _ _ _ 0 _) b = b
70+ mappend a (Buf _ _ _ 0 _) = a
71+ mappend (Buf fp0 off0 len0 cap0 gen0) (Buf fp1 off1 len1 _ _) =
7172 inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
7273 withForeignPtr fp1 $ \ptr1 -> do
73− let newlen = len0 + len1
74− if newlen <= cap0
74+ let genSize = sizeOf (0::Int)
75+ newlen = len0 + len1
76+ gen <- if gen0 == 0
77+ then return 0
78+ else peek (castPtr ptr0)
79+ if gen == gen0 && newlen <= cap0
7580 then do
81+ let newgen = gen + 1
82+ poke (castPtr ptr0) newgen
7683 memcpy (ptr0 `plusPtr` (off0+len0))
7784 (ptr1 `plusPtr` off1)
7885 (fromIntegral len1)
79− return (Buf fp0 off0 newlen cap0)
86+ return (Buf fp0 off0 newlen cap0 newgen)
8087 else do
8188 let newcap = newlen * 2
82− fp <- mallocPlainForeignPtrBytes newcap
83− withForeignPtr fp $ \ptr -> do
89+ fp <- mallocPlainForeignPtrBytes (newcap + genSize)
90+ withForeignPtr fp $ \ptr_ -> do
91+ let ptr = ptr_ `plusPtr` genSize
92+ newgen = 1
93+ poke (castPtr ptr_) newgen
8494 memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)
8595 memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)
8696 (fromIntegral len1)
87− return (Buf fp 0 newlen newcap)
97+ return (Buf fp genSize newlen newcap newgen)
8898
8999 mconcat [] = mempty
90100 mconcat xs = foldl1' mappend xs
91101
92102length :: Buffer -> Int
93−length (Buf _ _ len _) = len
103+length (Buf _ _ len _ _) = len
94104{-# INLINE length #-}
95105
96106unsafeIndex :: Buffer -> Int -> Word8
97−unsafeIndex (Buf fp off len _cap) i = assert (i >= 0 && i < len) .
107+unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) .
98108 inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)
99109{-# INLINE unsafeIndex #-}
100110
101111substring :: Int -> Int -> Buffer -> ByteString
102−substring s l (Buf fp off len _cap) =
112+substring s l (Buf fp off len _ _) =
103113 assert (s >= 0 && s <= len) .
104114 assert (l >= 0 && l <= len-s) $
105115 PS fp (off+s) l
106116{-# INLINE substring #-}
107117
108118unsafeDrop :: Int -> Buffer -> ByteString
109−unsafeDrop s (Buf fp off len _cap) =
119+unsafeDrop s (Buf fp off len _ _) =
110120 assert (s >= 0 && s <= len) $
111121 PS fp (off+s) (len-s)
112122{-# INLINE unsafeDrop #-}