git.iko.soy/typeable/attoparsec
on master help sign in
Add a pappend function that does a little less wrapping
34c4a47Bryan O'Sullivan
Data/Attoparsec/ByteString/Buffer.hs+38−29
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
1-- |
2-- |
2-- Module : Data.Attoparsec.ByteString.Buffer
3-- Module : Data.Attoparsec.ByteString.Buffer
3-- Copyright : Bryan O'Sullivan 2007-2014
4-- Copyright : Bryan O'Sullivan 2007-2014
@@ -45,6 +46,7 @@ module Data.Attoparsec.ByteString.Buffer
45 Buffer
46 Buffer
46 , buffer
47 , buffer
47 , unbuffer
48 , unbuffer
49+ , pappend
48 , length
50 , length
49 , unsafeIndex
51 , unsafeIndex
50 , substring
52 , substring
@@ -86,39 +88,46 @@ unbuffer (Buf fp off len _ _) = PS fp off len
86instance Monoid Buffer where
88instance Monoid Buffer where
87 mempty = Buf nullForeignPtr 0 0 0 0
89 mempty = Buf nullForeignPtr 0 0 0 0
88
90
89− mappend (Buf _ _ _ 0 _) b = b
91+ mappend (Buf _ _ _ 0 _) b = b
90− mappend a (Buf _ _ _ 0 _) = a
92+ mappend a (Buf _ _ _ 0 _) = a
91− mappend (Buf fp0 off0 len0 cap0 gen0) (Buf fp1 off1 len1 _ _) =
93+ mappend buf (Buf fp off len _ _) = append buf fp off len
92− inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
93− withForeignPtr fp1 $ \ptr1 -> do
94− let genSize = sizeOf (0::Int)
95− newlen = len0 + len1
96− gen <- if gen0 == 0
97− then return 0
98− else peek (castPtr ptr0)
99− if gen == gen0 && newlen <= cap0
100− then do
101− let newgen = gen + 1
102− poke (castPtr ptr0) newgen
103− memcpy (ptr0 `plusPtr` (off0+len0))
104− (ptr1 `plusPtr` off1)
105− (fromIntegral len1)
106− return (Buf fp0 off0 newlen cap0 newgen)
107− else do
108− let newcap = newlen * 2
109− fp <- mallocPlainForeignPtrBytes (newcap + genSize)
110− withForeignPtr fp $ \ptr_ -> do
111− let ptr = ptr_ `plusPtr` genSize
112− newgen = 1
113− poke (castPtr ptr_) newgen
114− memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)
115− memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)
116− (fromIntegral len1)
117− return (Buf fp genSize newlen newcap newgen)
118
94
119 mconcat [] = mempty
95 mconcat [] = mempty
120 mconcat xs = foldl1' mappend xs
96 mconcat xs = foldl1' mappend xs
121
97
98+pappend :: Buffer -> ByteString -> Buffer
99+pappend (Buf _ _ _ 0 _) (PS fp off len) = Buf fp off len 0 0
100+pappend buf (PS fp off len) = append buf fp off len
101+
102+append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer
103+append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 =
104+ inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
105+ withForeignPtr fp1 $ \ptr1 -> do
106+ let genSize = sizeOf (0::Int)
107+ newlen = len0 + len1
108+ gen <- if gen0 == 0
109+ then return 0
110+ else peek (castPtr ptr0)
111+ if gen == gen0 && newlen <= cap0
112+ then do
113+ let newgen = gen + 1
114+ poke (castPtr ptr0) newgen
115+ memcpy (ptr0 `plusPtr` (off0+len0))
116+ (ptr1 `plusPtr` off1)
117+ (fromIntegral len1)
118+ return (Buf fp0 off0 newlen cap0 newgen)
119+ else do
120+ let newcap = newlen * 2
121+ fp <- mallocPlainForeignPtrBytes (newcap + genSize)
122+ withForeignPtr fp $ \ptr_ -> do
123+ let ptr = ptr_ `plusPtr` genSize
124+ newgen = 1
125+ poke (castPtr ptr_) newgen
126+ memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)
127+ memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)
128+ (fromIntegral len1)
129+ return (Buf fp genSize newlen newcap newgen)
130+
122length :: Buffer -> Int
131length :: Buffer -> Int
123length (Buf _ _ len _ _) = len
132length (Buf _ _ len _ _) = len
124{-# INLINE length #-}
133{-# INLINE length #-}
Data/Attoparsec/ByteString/Internal.hs+1−1
@@ -479,7 +479,7 @@ prompt :: Buffer -> Pos -> More
479prompt t pos _more lose succ = Partial $ \s ->
479prompt t pos _more lose succ = Partial $ \s ->
480 if B.null s
480 if B.null s
481 then lose t pos Complete
481 then lose t pos Complete
482− else succ (t <> buffer s) pos Incomplete
482+ else succ (Buf.pappend t s) pos Incomplete
483
483
484-- | Immediately demand more input via a 'Partial' continuation
484-- | Immediately demand more input via a 'Partial' continuation
485-- result.
485-- result.