@@ -1,4 +1,5 @@
1−{-# LANGUAGE MagicHash, RankNTypes, RecordWildCards, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, MagicHash, RankNTypes, RecordWildCards,
2+ UnboxedTuples #-}
23
34-- |
45-- Module : Data.Attoparsec.Text.Buffer
@@ -35,6 +36,7 @@ module Data.Attoparsec.Text.Buffer
3536 ) where
3637
3738import Control.Exception (assert)
39+import Data.Bits (shiftR)
3840import Data.List (foldl1')
3941import Data.Monoid (Monoid(..))
4042import Data.Text ()
@@ -42,7 +44,8 @@ import Data.Text.Internal (Text(..))
4244import Data.Text.Internal.Encoding.Utf16 (chr2)
4345import Data.Text.Internal.Unsafe.Char (unsafeChr)
4446import Data.Text.Unsafe (Iter(..))
45−import GHC.Base (unsafeCoerce#)
47+import Foreign.Storable (sizeOf)
48+import GHC.Base (Int(..), indexIntArray#, unsafeCoerce#, writeIntArray#)
4649import GHC.ST (ST(..), runST)
4750import Prelude hiding (length)
4851import qualified Data.Text.Array as A
@@ -52,6 +55,7 @@ data Buffer = Buf {
5255 , _off :: {-# UNPACK #-} !Int
5356 , _len :: {-# UNPACK #-} !Int
5457 , _cap :: {-# UNPACK #-} !Int
58+ , _gen :: {-# UNPACK #-} !Int
5559 }
5660
5761instance Show Buffer where
@@ -61,48 +65,54 @@ instance Show Buffer where
6165-- copies in the (hopefully) common case of no further input being fed
6266-- to us.
6367buffer :: Text -> Buffer
64−buffer (Text arr off len) = Buf arr off len len
68+buffer (Text arr off len) = Buf arr off len len 0
6569
6670unbuffer :: Buffer -> Text
67−unbuffer (Buf arr off len _cap) = Text arr off len
71+unbuffer (Buf arr off len _ _) = Text arr off len
6872
6973instance Monoid Buffer where
70− mempty = Buf A.empty 0 0 0
71−
72− mappend (Buf _ _ _ 0) b = b
73− mappend a (Buf _ _ _ 0) = a
74− mappend (Buf arr0 off0 len0 cap0) (Buf arr1 off1 len1 _cap1) = runST $ do
75− let newlen = len0 + len1
76− if newlen <= cap0
74+ mempty = Buf A.empty 0 0 0 0
75+
76+ mappend (Buf _ _ _ 0 _) b = b
77+ mappend a (Buf _ _ _ 0 _) = a
78+ mappend (Buf arr0 off0 len0 cap0 gen0) (Buf arr1 off1 len1 _ _) = runST $ do
79+ let woff = sizeOf (0::Int) `shiftR` 1
80+ newlen = len0 + len1
81+ !gen = if gen0 == 0 then 0 else readGen arr0
82+ if gen == gen0 && newlen <= cap0
7783 then do
84+ let newgen = gen + 1
7885 marr <- unsafeThaw arr0
86+ writeGen marr newgen
7987 A.copyI marr (off0+len0) arr1 off1 (off0+newlen)
8088 arr2 <- A.unsafeFreeze marr
81− return (Buf arr2 off0 newlen cap0)
89+ return (Buf arr2 off0 newlen cap0 newgen)
8290 else do
8391 let newcap = newlen * 2
84− marr <- A.new newcap
85− A.copyI marr 0 arr0 off0 len0
86− A.copyI marr len0 arr1 off1 newlen
92+ newgen = 1
93+ marr <- A.new (newcap + woff)
94+ writeGen marr newgen
95+ A.copyI marr woff arr0 off0 (woff+len0)
96+ A.copyI marr (woff+len0) arr1 off1 (woff+newlen)
8797 arr2 <- A.unsafeFreeze marr
88− return (Buf arr2 0 newlen newcap)
98+ return (Buf arr2 woff newlen newcap newgen)
8999
90100 mconcat [] = mempty
91101 mconcat xs = foldl1' mappend xs
92102
93103length :: Buffer -> Int
94−length (Buf _ _ len _) = len
104+length (Buf _ _ len _ _) = len
95105{-# INLINE length #-}
96106
97107substring :: Int -> Int -> Buffer -> Text
98−substring s l (Buf arr off len _cap) =
108+substring s l (Buf arr off len _ _) =
99109 assert (s >= 0 && s <= len) .
100110 assert (l >= 0 && l <= len-s) $
101111 Text arr (off+s) l
102112{-# INLINE substring #-}
103113
104114dropWord16 :: Int -> Buffer -> Text
105−dropWord16 s (Buf arr off len _cap) =
115+dropWord16 s (Buf arr off len _ _) =
106116 assert (s >= 0 && s <= len) $
107117 Text arr (off+s) (len-s)
108118{-# INLINE dropWord16 #-}
@@ -111,7 +121,7 @@ dropWord16 s (Buf arr off len _cap) =
111121-- array, returning the current character and the delta to add to give
112122-- the next offset to iterate at.
113123iter :: Buffer -> Int -> Iter
114−iter (Buf arr off _len _cap) i
124+iter (Buf arr off _ _ _) i
115125 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
116126 | otherwise = Iter (chr2 m n) 2
117127 where m = A.unsafeIndex arr j
@@ -123,7 +133,7 @@ iter (Buf arr off _len _cap) i
123133-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
124134-- delta to add to give the next offset to iterate at.
125135iter_ :: Buffer -> Int -> Int
126−iter_ (Buf arr off _len _cap) i | m < 0xD800 || m > 0xDBFF = 1
136+iter_ (Buf arr off _ _ _) i | m < 0xD800 || m > 0xDBFF = 1
127137 | otherwise = 2
128138 where m = A.unsafeIndex arr (off+i)
129139{-# INLINE iter_ #-}
@@ -131,3 +141,11 @@ iter_ (Buf arr off _len _cap) i | m < 0xD800 || m > 0xDBFF = 1
131141unsafeThaw :: A.Array -> ST s (A.MArray s)
132142unsafeThaw A.Array{..} = ST $ \s# ->
133143 (# s#, A.MArray (unsafeCoerce# aBA) #)
144+
145+readGen :: A.Array -> Int
146+readGen a = case indexIntArray# (A.aBA a) 0# of r# -> I# r#
147+
148+writeGen :: A.MArray s -> Int -> ST s ()
149+writeGen a (I# gen#) = ST $ \s0# ->
150+ case writeIntArray# (A.maBA a) 0# gen# s0# of
151+ s1# -> (# s1#, () #)