b9db7e7 · typeable/attoparsec

38import Data.Monoid (Monoid(..))

39import Data.Word (Word8)

40import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)

41−import Foreign.Ptr (plusPtr)

41+import Foreign.Ptr (castPtr, plusPtr)

42−import Foreign.Storable (peekByteOff)

42+import Foreign.Storable (peek, peekByteOff, poke, sizeOf)

43import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

44import Prelude hiding (length)

45

48 , _off :: {-# UNPACK #-} !Int

49 , _len :: {-# UNPACK #-} !Int

50 , _cap :: {-# UNPACK #-} !Int

51+ , _gen :: {-# UNPACK #-} !Int

51 }

52 }

52

53

53instance Show Buffer where

54instance Show Buffer where

57-- copies in the (hopefully) common case of no further input being fed

58-- copies in the (hopefully) common case of no further input being fed

58-- to us.

59-- to us.

59buffer :: ByteString -> Buffer

60buffer :: 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

61

62

62unbuffer :: Buffer -> ByteString

63unbuffer :: Buffer -> ByteString

63−unbuffer (Buf fp off len _cap) = PS fp off len

64+unbuffer (Buf fp off len _ _) = PS fp off len

64

65

65instance Monoid Buffer where

66instance Monoid Buffer where

66− mempty = Buf nullForeignPtr 0 0 0

67+ mempty = Buf nullForeignPtr 0 0 0 0

67

68

68− mappend (Buf _ _ _ 0) b = b

69+ mappend (Buf _ _ _ 0 _) b = b

69− mappend a (Buf _ _ _ 0) = a

70+ mappend a (Buf _ _ _ 0 _) = a

70− mappend (Buf fp0 off0 len0 cap0) (Buf fp1 off1 len1 _cap1) =

71+ mappend (Buf fp0 off0 len0 cap0 gen0) (Buf fp1 off1 len1 _ _) =

71 inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->

72 inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->

72 withForeignPtr fp1 $ \ptr1 -> do

73 withForeignPtr fp1 $ \ptr1 -> do

74+ let genSize = sizeOf (0::Int)

73− let newlen = len0 + len1

75+ newlen = len0 + len1

76+ gen <- if gen0 == 0

77+ then return 0

78+ else peek (castPtr ptr0)

74− if newlen <= cap0

79+ if gen == gen0 && newlen <= cap0

75 then do

80 then do

81+ let newgen = gen + 1

82+ poke (castPtr ptr0) newgen

76 memcpy (ptr0 `plusPtr` (off0+len0))

83 memcpy (ptr0 `plusPtr` (off0+len0))

77 (ptr1 `plusPtr` off1)

84 (ptr1 `plusPtr` off1)

78 (fromIntegral len1)

85 (fromIntegral len1)

79− return (Buf fp0 off0 newlen cap0)

86+ return (Buf fp0 off0 newlen cap0 newgen)

80 else do

87 else do

81 let newcap = newlen * 2

88 let newcap = newlen * 2

82− fp <- mallocPlainForeignPtrBytes newcap

89+ fp <- mallocPlainForeignPtrBytes (newcap + genSize)

83− withForeignPtr fp $ \ptr -> do

90+ withForeignPtr fp $ \ptr_ -> do

91+ let ptr = ptr_ `plusPtr` genSize

92+ newgen = 1

93+ poke (castPtr ptr_) newgen

84 memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)

94 memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)

85 memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)

95 memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)

86 (fromIntegral len1)

96 (fromIntegral len1)

87− return (Buf fp 0 newlen newcap)

97+ return (Buf fp genSize newlen newcap newgen)

88

98

89 mconcat [] = mempty

99 mconcat [] = mempty

90 mconcat xs = foldl1' mappend xs

100 mconcat xs = foldl1' mappend xs

91

101

92length :: Buffer -> Int

102length :: Buffer -> Int

93−length (Buf _ _ len _) = len

103+length (Buf _ _ len _ _) = len

94{-# INLINE length #-}

104{-# INLINE length #-}

95

105

96unsafeIndex :: Buffer -> Int -> Word8

106unsafeIndex :: 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) .

98 inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)

108 inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)

99{-# INLINE unsafeIndex #-}

109{-# INLINE unsafeIndex #-}

100

110

101substring :: Int -> Int -> Buffer -> ByteString

111substring :: Int -> Int -> Buffer -> ByteString

102−substring s l (Buf fp off len _cap) =

112+substring s l (Buf fp off len _ _) =

103 assert (s >= 0 && s <= len) .

113 assert (s >= 0 && s <= len) .

104 assert (l >= 0 && l <= len-s) $

114 assert (l >= 0 && l <= len-s) $

105 PS fp (off+s) l

115 PS fp (off+s) l

106{-# INLINE substring #-}

116{-# INLINE substring #-}

107

117

108unsafeDrop :: Int -> Buffer -> ByteString

118unsafeDrop :: Int -> Buffer -> ByteString

109−unsafeDrop s (Buf fp off len _cap) =

119+unsafeDrop s (Buf fp off len _ _) =

110 assert (s >= 0 && s <= len) $

120 assert (s >= 0 && s <= len) $

111 PS fp (off+s) (len-s)

121 PS fp (off+s) (len-s)

112{-# INLINE unsafeDrop #-}

122{-# INLINE unsafeDrop #-}