git.iko.soy/typeable/attoparsec
on master help sign in
Back out the repeated-append-to-same-Buffer changes

I'm torn over this. The use-counting changes obviously improve safety, but they do so for a case that should never arise in practice, and they come with a *steep* cost in performance (many benchmarks regress to slower than 0.11). I am inclined to either try to find a near-zero-cost alternative that preserves safety, or to document the API as "this is a single-use continuation, so don't call it more than once".

commitc9c1279275ef95a47b3b472f29307c873ef2f50d authorBryan O'Sullivan <bos@serpentine.com> dateTue 27 May 2014, 09:23 (12 years ago) parent12979ef
3 files changed+44−76
compare with master
unifiedsplit
Data/Attoparsec/ByteString/Buffer.hs+27−42 Data/Attoparsec/ByteString/Internal.hs+1−1 Data/Attoparsec/Text/Buffer.hs+16−33
Data/Attoparsec/ByteString/Buffer.hs+27−42
@@ -26,17 +26,14 @@ module Data.Attoparsec.ByteString.Buffer
2626 , buffer
2727 , unbuffer
2828 , length
29− , pappend
3029 , unsafeIndex
3130 , substring
3231 , unsafeDrop
3332 ) where
3433
35−import Control.Applicative ((<$>))
3634import Control.Exception (assert)
3735import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
3836import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
39−import Data.IORef (IORef, atomicModifyIORef, newIORef)
4037import Data.List (foldl1')
4138import Data.Monoid (Monoid(..))
4239import Data.Word (Word8)
@@ -45,15 +42,12 @@ import Foreign.Ptr (plusPtr)
4542import Foreign.Storable (peekByteOff)
4643import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
4744import Prelude hiding (length)
48−import System.IO.Unsafe (unsafePerformIO)
4945
5046data Buffer = Buf {
5147 _fp :: {-# UNPACK #-} !(ForeignPtr Word8)
5248 , _off :: {-# UNPACK #-} !Int
5349 , _len :: {-# UNPACK #-} !Int
5450 , _cap :: {-# UNPACK #-} !Int
55− , _gen :: {-# UNPACK #-} !Int
56− , _ref :: {-# UNPACK #-} !(IORef Int)
5751 }
5852
5953instance Show Buffer where
@@ -63,64 +57,55 @@ instance Show Buffer where
6357-- copies in the (hopefully) common case of no further input being fed
6458-- to us.
6559buffer :: ByteString -> Buffer
66−buffer (PS fp off len) = inlinePerformIO $
67− Buf fp off len len 0 <$> newIORef 0
60+buffer (PS fp off len) = Buf fp off len len
6861
6962unbuffer :: Buffer -> ByteString
70−unbuffer (Buf fp off len _cap _gen _ref) = PS fp off len
63+unbuffer (Buf fp off len _cap) = PS fp off len
7164
7265instance Monoid Buffer where
73− mempty = unsafePerformIO $ Buf nullForeignPtr 0 0 0 0 <$> newIORef 0
74− {-# NOINLINE mempty #-}
75−
76− mappend (Buf _ _ _ 0 _ _) b = b
77− mappend a (Buf _ _ _ 0 _ _) = a
78− mappend buf (Buf fp off len _ _ _) = append buf fp off len
66+ mempty = Buf nullForeignPtr 0 0 0
67+
68+ mappend (Buf _ _ _ 0) b = b
69+ mappend a (Buf _ _ _ 0) = a
70+ mappend (Buf fp0 off0 len0 cap0) (Buf fp1 off1 len1 _cap1) =
71+ inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
72+ withForeignPtr fp1 $ \ptr1 -> do
73+ let newlen = len0 + len1
74+ if newlen <= cap0
75+ then do
76+ memcpy (ptr0 `plusPtr` (off0+len0))
77+ (ptr1 `plusPtr` off1)
78+ len1
79+ return (Buf fp0 off0 newlen cap0)
80+ else do
81+ let newcap = newlen * 2
82+ fp <- mallocPlainForeignPtrBytes newcap
83+ withForeignPtr fp $ \ptr -> do
84+ memcpy ptr (ptr0 `plusPtr` off0) len0
85+ memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) len1
86+ return (Buf fp 0 newlen newcap)
7987
8088 mconcat [] = mempty
8189 mconcat xs = foldl1' mappend xs
8290
83−pappend :: Buffer -> ByteString -> Buffer
84−pappend buf (PS fp off len) = append buf fp off len
85−
86−append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer
87−append (Buf fp0 off0 len0 cap0 gen ref) fp1 off1 len1 =
88− inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
89− withForeignPtr fp1 $ \ptr1 -> do
90− gen' <- atomicModifyIORef ref (\a -> let a' = a+1 in (a',a'))
91− let newlen = len0 + len1
92− if gen' == gen+1 && newlen <= cap0
93− then do
94− memcpy (ptr0 `plusPtr` (off0+len0))
95− (ptr1 `plusPtr` off1)
96− len1
97− return (Buf fp0 off0 newlen cap0 gen' ref)
98− else do
99− let newcap = newlen * 2
100− fp <- mallocPlainForeignPtrBytes newcap
101− withForeignPtr fp $ \ptr -> do
102− memcpy ptr (ptr0 `plusPtr` off0) len0
103− memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) len1
104− return (Buf fp 0 newlen newcap gen' ref)
105−
10691length :: Buffer -> Int
107−length (Buf _ _ len _ _ _) = len
92+length (Buf _ _ len _) = len
10893{-# INLINE length #-}
10994
11095unsafeIndex :: Buffer -> Int -> Word8
111−unsafeIndex (Buf fp off len _ _ _) i = assert (i >= 0 && i < len) .
96+unsafeIndex (Buf fp off len _cap) i = assert (i >= 0 && i < len) .
11297 inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)
11398{-# INLINE unsafeIndex #-}
11499
115100substring :: Int -> Int -> Buffer -> ByteString
116−substring s l (Buf fp off len _ _ _) =
101+substring s l (Buf fp off len _cap) =
117102 assert (s >= 0 && s <= len) .
118103 assert (l >= 0 && l <= len-s) $
119104 PS fp (off+s) l
120105{-# INLINE substring #-}
121106
122107unsafeDrop :: Int -> Buffer -> ByteString
123−unsafeDrop s (Buf fp off len _ _ _) =
108+unsafeDrop s (Buf fp off len _cap) =
124109 assert (s >= 0 && s <= len) $
125110 PS fp (off+s) (len-s)
126111{-# INLINE unsafeDrop #-}
Data/Attoparsec/ByteString/Internal.hs+1−1
@@ -471,7 +471,7 @@ prompt :: Buffer -> Pos -> More
471471prompt t pos _more lose succ = Partial $ \s ->
472472 if B.null s
473473 then lose t pos Complete
474− else succ (Buf.pappend t s) pos Incomplete
474+ else succ (t <> buffer s) pos Incomplete
475475
476476-- | Immediately demand more input via a 'Partial' continuation
477477-- result.
Data/Attoparsec/Text/Buffer.hs+16−33
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, MagicHash, RankNTypes, RecordWildCards, UnboxedTuples #-}
1+{-# LANGUAGE MagicHash, RankNTypes, RecordWildCards, UnboxedTuples #-}
22
33-- |
44-- Module : Data.Attoparsec.Text.Buffer
@@ -34,10 +34,7 @@ module Data.Attoparsec.Text.Buffer
3434 , dropWord16
3535 ) where
3636
37−import Control.Applicative ((<$>))
3837import Control.Exception (assert)
39−import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
40−import Data.IORef (IORef, atomicModifyIORef, newIORef)
4138import Data.List (foldl1')
4239import Data.Monoid (Monoid(..))
4340import Data.Text ()
@@ -48,22 +45,13 @@ import Data.Text.Unsafe (Iter(..))
4845import GHC.Base (unsafeCoerce#)
4946import GHC.ST (ST(..), runST)
5047import Prelude hiding (length)
51−import System.IO.Unsafe (unsafePerformIO)
5248import qualified Data.Text.Array as A
5349
54−#if __GLASGOW_HASKELL__ >= 702
55−import Control.Monad.ST.Unsafe (unsafeIOToST)
56−#else
57−import Control.Monad.ST (unsafeIOToST)
58−#endif
59−
6050data Buffer = Buf {
6151 _arr :: {-# UNPACK #-} !A.Array
6252 , _off :: {-# UNPACK #-} !Int
6353 , _len :: {-# UNPACK #-} !Int
6454 , _cap :: {-# UNPACK #-} !Int
65− , _gen :: {-# UNPACK #-} !Int
66− , _ref :: {-# UNPACK #-} !(IORef Int)
6755 }
6856
6957instance Show Buffer where
@@ -73,53 +61,48 @@ instance Show Buffer where
7361-- copies in the (hopefully) common case of no further input being fed
7462-- to us.
7563buffer :: Text -> Buffer
76−buffer (Text arr off len) = inlinePerformIO $
77− Buf arr off len len 0 <$> newIORef 0
64+buffer (Text arr off len) = Buf arr off len len
7865
7966unbuffer :: Buffer -> Text
80−unbuffer (Buf arr off len _ _ _) = Text arr off len
67+unbuffer (Buf arr off len _cap) = Text arr off len
8168
8269instance Monoid Buffer where
83− mempty = unsafePerformIO $ Buf A.empty 0 0 0 0 <$> newIORef 0
84− {-# NOINLINE mempty #-}
85−
86− mappend (Buf _ _ _ 0 _ _) b = b
87− mappend a (Buf _ _ _ 0 _ _) = a
88− mappend (Buf arr0 off0 len0 cap0 gen ref)
89− (Buf arr1 off1 len1 _ _ _) = runST $ do
90− gen' <- unsafeIOToST $
91− atomicModifyIORef ref (\a -> let a' = a+1 in (a',a'))
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
9275 let newlen = len0 + len1
93− if gen' == gen+1 && newlen <= cap0
76+ if newlen <= cap0
9477 then do
9578 marr <- unsafeThaw arr0
9679 A.copyI marr (off0+len0) arr1 off1 (off0+newlen)
9780 arr2 <- A.unsafeFreeze marr
98− return (Buf arr2 off0 newlen cap0 gen' ref)
81+ return (Buf arr2 off0 newlen cap0)
9982 else do
10083 let newcap = newlen * 2
10184 marr <- A.new newcap
10285 A.copyI marr 0 arr0 off0 len0
10386 A.copyI marr len0 arr1 off1 newlen
10487 arr2 <- A.unsafeFreeze marr
105− return (Buf arr2 0 newlen newcap gen' ref)
88+ return (Buf arr2 0 newlen newcap)
10689
10790 mconcat [] = mempty
10891 mconcat xs = foldl1' mappend xs
10992
11093length :: Buffer -> Int
111−length (Buf _ _ len _ _ _) = len
94+length (Buf _ _ len _) = len
11295{-# INLINE length #-}
11396
11497substring :: Int -> Int -> Buffer -> Text
115−substring s l (Buf arr off len _ _ _) =
98+substring s l (Buf arr off len _cap) =
11699 assert (s >= 0 && s <= len) .
117100 assert (l >= 0 && l <= len-s) $
118101 Text arr (off+s) l
119102{-# INLINE substring #-}
120103
121104dropWord16 :: Int -> Buffer -> Text
122−dropWord16 s (Buf arr off len _ _ _) =
105+dropWord16 s (Buf arr off len _cap) =
123106 assert (s >= 0 && s <= len) $
124107 Text arr (off+s) (len-s)
125108{-# INLINE dropWord16 #-}
@@ -128,7 +111,7 @@ dropWord16 s (Buf arr off len _ _ _) =
128111-- array, returning the current character and the delta to add to give
129112-- the next offset to iterate at.
130113iter :: Buffer -> Int -> Iter
131−iter (Buf arr off _len _ _ _) i
114+iter (Buf arr off _len _cap) i
132115 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
133116 | otherwise = Iter (chr2 m n) 2
134117 where m = A.unsafeIndex arr j
@@ -140,7 +123,7 @@ iter (Buf arr off _len _ _ _) i
140123-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
141124-- delta to add to give the next offset to iterate at.
142125iter_ :: Buffer -> Int -> Int
143−iter_ (Buf arr off _len _ _ _) i | m < 0xD800 || m > 0xDBFF = 1
126+iter_ (Buf arr off _len _cap) i | m < 0xD800 || m > 0xDBFF = 1
144127 | otherwise = 2
145128 where m = A.unsafeIndex arr (off+i)
146129{-# INLINE iter_ #-}