fast-builder 0.0.1.0 → 0.1.0.0

raw patch · 4 files changed

+77/−81 lines, 4 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/ByteString/FastBuilder/Internal.hs +66/−75
• benchmarks/aeson/HashMapExts.hs +4/−4
• fast-builder.cabal +2/−2
• tests/prop.hs +5/−0

@@ -3,13 +3,14 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}  -- | This is an internal module; its interface is unstable. module Data.ByteString.FastBuilder.Internal   (   -- * Builder and related types     Builder(..)-  , BuilderState(..)+  , BuilderState   , DataSink(..)   , DynamicSink(..)   , Queue(..)@@ -21,10 +22,7 @@   , ChunkOverflowException(..)    -- * Builder building blocks-  , Builder_   , BuildM(..)-  , toBuilder_-  , fromBuilder_   , mkBuilder   , useBuilder   , getSink@@ -69,7 +67,7 @@ import qualified Data.ByteString.Unsafe as S import qualified Data.ByteString.Lazy as L import Data.IORef-import Data.Monoid+import Data.Semigroup as Sem import Data.String import Data.Word import Foreign.C.String@@ -102,21 +100,31 @@   -- the next location to put bytes to, and "end" points to the end of the   -- buffer. --- | This datatype exists only to work around the limitation that 'oneShot'--- cannot work with unboxed argument types.-data BuilderState = BuilderState-  !(Ptr Word8) -- "cur" pointer-  !(Ptr Word8) -- "end" pointer-  (State# RealWorld)+-- | The state of a builder. The components are:+--+-- * The "cur" pointer+-- * The "end" pointer+-- * The state token+type BuilderState = (# Addr#, Addr#, State# RealWorld #) +instance Sem.Semigroup Builder where+  (<>) = appendBuilder+  {-# INLINE (<>) #-}++appendBuilder :: Builder -> Builder -> Builder+appendBuilder (Builder a) (Builder b)+  = rebuild $ Builder $ \dex bs -> b dex (a dex bs)+{-# INLINE[1] appendBuilder #-}++{-# RULES "appendBuilder/assoc"+  forall x y z.+    appendBuilder (appendBuilder x y) z = appendBuilder x (appendBuilder y z)+  #-}+ instance Monoid Builder where   mempty = Builder $ \_ bs -> bs   {-# INLINE mempty #-}-  mappend (Builder a) (Builder b) = rebuild $-      -- This rebuild means we basically give up on write/write rewrites.-      -- However this can make a big difference in some cases, and seems-      -- important enough. TODO: get rid of it once GHC 8.0 is out.-    Builder $ \dex bs -> b dex (a dex bs)+  mappend = (<>)   {-# INLINE mappend #-}   mconcat xs = foldr mappend mempty xs   {-# INLINE mconcat #-}@@ -200,24 +208,6 @@ ---------------------------------------------------------------- -- Builder building blocks --- | An internal type that is isomorphic to 'Builder'. This is a--- maximaly efficient representation for NOINLINE functions.-type Builder_-  = DataSink -> Addr# -> Addr# -> State# RealWorld-  -> (# Addr#, Addr#, State# RealWorld #)---- | Convert a 'Builder' into a 'Builder_'.-toBuilder_ :: Builder -> Builder_-toBuilder_ (Builder f) dex cur end s =-  case f dex (BuilderState (Ptr cur) (Ptr end) s) of-    BuilderState (Ptr cur') (Ptr end') s' -> (# cur', end', s' #)---- | Convert a 'Builder_' into a 'Builder'.-fromBuilder_ :: Builder_ -> Builder-fromBuilder_ f = Builder $ \dex (BuilderState (Ptr cur) (Ptr end) s) ->-  case f dex cur end s of-    (# cur', end', s' #) -> BuilderState (Ptr cur') (Ptr end') s'- -- | An internal type for making it easier to define builders. A value of -- @'BuildM' a@ can do everything a 'Builder' can do, and in addition, -- returns a value of type @a@ upon completion.@@ -246,33 +236,33 @@  -- | Get the 'DataSink'. getSink :: BuildM DataSink-getSink = BuildM $ \k -> Builder $ \dex (BuilderState cur end s) ->-  unBuilder (k dex) dex (BuilderState cur end s)+getSink = BuildM $ \k -> Builder $ \dex (# cur, end, s #) ->+  unBuilder (k dex) dex (# cur, end, s #)  -- | Get the current pointer. getCur :: BuildM (Ptr Word8)-getCur = BuildM $ \k -> Builder $ \dex (BuilderState cur end s) ->-  unBuilder (k cur) dex (BuilderState cur end s)+getCur = BuildM $ \k -> Builder $ \dex (# cur, end, s #) ->+  unBuilder (k (Ptr cur)) dex (# cur, end, s #)  -- | Get the end-of-buffer pointer. getEnd :: BuildM (Ptr Word8)-getEnd = BuildM $ \k -> Builder $ \dex (BuilderState cur end s) ->-  unBuilder (k end) dex (BuilderState cur end s)+getEnd = BuildM $ \k -> Builder $ \dex (# cur, end, s #) ->+  unBuilder (k (Ptr end)) dex (# cur, end, s #)  -- | Set the current pointer. setCur :: Ptr Word8 -> BuildM ()-setCur p = BuildM $ \k -> Builder $ \dex (BuilderState _ end s) ->-  unBuilder (k ()) dex (BuilderState p end s)+setCur (Ptr p) = BuildM $ \k -> Builder $ \dex (# _, end, s #) ->+  unBuilder (k ()) dex (# p, end, s #)  -- | Set the end-of-buffer pointer. setEnd :: Ptr Word8 -> BuildM ()-setEnd p = BuildM $ \k -> Builder $ \dex (BuilderState cur _ s) ->-  unBuilder (k ()) dex (BuilderState cur p s)+setEnd (Ptr p) = BuildM $ \k -> Builder $ \dex (# cur, _, s #) ->+  unBuilder (k ()) dex (# cur, p, s #)  -- | Perform IO. io :: IO a -> BuildM a-io (IO x) = BuildM $ \k -> Builder $ \dex (BuilderState cur end s) -> case x s of-  (# s', val #) -> unBuilder (k val) dex (BuilderState cur end s')+io (IO x) = BuildM $ \k -> Builder $ \dex (# cur, end, s #) -> case x s of+  (# s', val #) -> unBuilder (k val) dex (# cur, end, s' #)  -- | Embed a 'BuilderState' transformer into `BuildM`. updateState :: (BuilderState -> BuilderState) -> BuildM ()@@ -284,16 +274,20 @@ -- is sufficient for each 'Write'. data Write = Write !Int (BuilderState -> BuilderState) +instance Sem.Semigroup Write where+  Write s0 w0 <> Write s1 w1 = Write (s0 + s1) (\s -> w1 (w0 s))+ instance Monoid Write where-  mempty = Write 0 id-  mappend (Write s0 w0) (Write s1 w1) = Write (s0 + s1) (w1 . w0)+  mempty = Write 0 (\s -> s)+  mappend = (<>)+  {-# INLINE mappend #-}  -- | Turn a 'PI.BoundedPrim' into a 'Write'. writeBoundedPrim :: PI.BoundedPrim a -> a -> Write writeBoundedPrim prim x =-  Write (PI.sizeBound prim) $ \(BuilderState cur end s) ->-    case unIO (PI.runB prim x cur) s of-      (# s', cur' #) -> BuilderState cur' end s'+  Write (PI.sizeBound prim) $ \(# cur, end, s #) ->+    case unIO (PI.runB prim x (Ptr cur)) s of+      (# s', Ptr cur' #) -> (# cur', end, s' #)  ---------------------------------------------------------------- --@@ -301,9 +295,9 @@  -- | Run a builder. runBuilder :: Builder -> DataSink -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)-runBuilder (Builder f) sink !cur !end = IO $ \s ->-  case f sink (BuilderState cur end s) of-    BuilderState cur' _ s' -> (# s', cur' #)+runBuilder (Builder f) sink (Ptr cur) (Ptr end) = IO $ \s ->+  case f sink (# cur, end, s #) of+    (# cur', _, s' #) -> (# s', Ptr cur' #)  -- | Turn a 'Builder' into a lazy 'L.ByteString'. --@@ -503,24 +497,25 @@  -- | Turn a 'Write' into a 'Builder'. write :: Write -> Builder-write w = oneShotBuilder $ Builder $ \sink s -> write' w sink s-{-# INLINE write #-}---- | 'write' as a state transformer. Used for RULES.-write' :: Write -> DataSink -> BuilderState -> BuilderState-write' (Write size w) = unBuilder $ rebuild $ mkBuilder $ do+write (Write size w) = rebuild $ mkBuilder $ do   useBuilder $ ensureBytes size   updateState w-{-# INLINE[0] write' #-}+{-# INLINE[1] write #-}  {-# RULES "fast-builder: write/write"-  forall w0 w1 sink s.-    write' w0 sink (write' w1 sink s) = write' (w0 <> w1) sink s+  forall w0 w1.+    appendBuilder (write w0) (write w1) = write (w0 <> w1)   #-} +{-# RULES "fast-builder: write/write/x"+  forall w0 w1 x.+    appendBuilder (write w0) (appendBuilder (write w1) x)+      = appendBuilder (write (w0 <> w1)) x+  #-}+ -- | Turn a value of type @a@ into a 'Builder', using the given 'PI.FixedPrim'. primFixed :: PI.FixedPrim a -> a -> Builder-primFixed prim x = primBounded (PI.toB prim) x+primFixed prim = \x -> primBounded (PI.toB prim) x {-# INLINE primFixed #-}  -- | Turn a list of values of type @a@ into a 'Builder', using the given@@ -573,11 +568,11 @@ -- 'S.ByteString' will not be copied, and inserted directly into the output -- instead. byteStringInsert :: S.ByteString -> Builder-byteStringInsert !bstr = fromBuilder_ $ byteStringInsert_ bstr+byteStringInsert !bstr = byteStringInsert_ bstr  -- | The body of the 'byteStringInsert', worker-wrappered manually.-byteStringInsert_ :: S.ByteString -> Builder_-byteStringInsert_ bstr = toBuilder_ $ mkBuilder $ do+byteStringInsert_ :: S.ByteString -> Builder+byteStringInsert_ bstr = mkBuilder $ do   sink <- getSink   case sink of     DynamicSink dRef -> do@@ -633,11 +628,11 @@  -- | @'getBytes' n@ allocates a new buffer, containing at least @n@ bytes. getBytes :: Int -> Builder-getBytes (I# n) = fromBuilder_ (getBytes_ n)+getBytes (I# n) = getBytes_ n  -- | The body of the 'getBytes' function, worker-wrappered manually.-getBytes_ :: Int# -> Builder_-getBytes_ n = toBuilder_ $ mkBuilder $ do+getBytes_ :: Int# -> Builder+getBytes_ n = mkBuilder $ do   sink <- getSink   case sink of     DynamicSink dRef -> do@@ -677,11 +672,7 @@ --  @rebuild $ case x of ... @ rebuild :: Builder -> Builder rebuild (Builder f) = Builder $ oneShot $ \dex -> oneShot $-  \(BuilderState cur end s) -> f dex (BuilderState cur end s)---- | Tell GHC that the builder will be only used once.-oneShotBuilder :: Builder -> Builder-oneShotBuilder (Builder f) = Builder $ oneShot $ \dex -> oneShot $ \s -> f dex s+  \(# cur, end, s #) -> f dex (# cur, end, s #)  ---------------------------------------------------------------- -- ThreadedSink

@@ -6,7 +6,7 @@  import Data.HashMap.Strict (HashMap) import Data.Monoid-import GHC.Exts (Array#, sizeofArray#, indexArray#, Int(..))+import GHC.Exts (SmallArray#, sizeofSmallArray#, indexSmallArray#, Int(..)) import Unsafe.TrueName (truename)  foldMapWithKey :: (Monoid m) => (k -> a -> m) -> HashMap k a -> m@@ -26,11 +26,11 @@     (a -> m) -> [truename| ''HashMap Full Array |] a -> m foldMapArray f [truename| ''HashMap Full Array Array | a |] = foldMapArray' f a -foldMapArray' :: (Monoid m) => (a -> m) -> Array# a -> m+foldMapArray' :: (Monoid m) => (a -> m) -> SmallArray# a -> m foldMapArray' f arr = go 0   where     go k@(I# k#)-      | k >= I# (sizeofArray# arr) = mempty-      | otherwise = case indexArray# arr k# of+      | k >= I# (sizeofSmallArray# arr) = mempty+      | otherwise = case indexSmallArray# arr k# of         (# v #) -> f v <> go (k + 1) {-# INLINE foldMapArray' #-}

@@ -1,5 +1,5 @@ name:                fast-builder-version:             0.0.1.0+version:             0.1.0.0 synopsis:            Fast ByteString Builder description:         An efficient implementation of ByteString builder. It should be faster than                      the standard implementation in most cases.@@ -25,7 +25,7 @@   other-modules:       Data.ByteString.FastBuilder.Internal.Prim    -- other-extensions:-  build-depends:       base >= 4.8 && < 4.11, bytestring >= 0.10.6.0, ghc-prim+  build-depends:       base >= 4.8 && < 4.13, bytestring >= 0.10.6.0, ghc-prim   -- hs-source-dirs:   default-language:    Haskell2010   ghc-options:         -Wall -g

@@ -191,6 +191,11 @@   r1 <- timeout 100000 $ atomically $ guard . not =<< readTVar inNontermV   return $ (r, r1) == (Left ex, Just ()) +-- | Write/write optimization does not break semantics.+prop_writeWrite :: Word8 -> Word8 -> Bool+prop_writeWrite w0 w1+  = toStrictByteString (word8 w0 <> word8 w1) == BS.pack [w0, w1]+ return []  main :: IO ()