Skip to content

Make primMapListBounded into a good consumer #469

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Make primMapListBounded into a good consumer #469

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
43 changes: 23 additions & 20 deletions Data/ByteString/Builder/Prim.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -512,12 +512,6 @@ primMapByteStringFixed = primMapByteStringBounded . toB
primMapLazyByteStringFixed :: FixedPrim Word8 -> (L.ByteString -> Builder)
primMapLazyByteStringFixed = primMapLazyByteStringBounded . toB

-- IMPLEMENTATION NOTE: Sadly, 'encodeListWith' cannot be used for foldr/build
-- fusion. Its performance relies on hoisting several variables out of the
-- inner loop. That's not possible when writing 'encodeListWith' as a 'foldr'.
-- If we had stream fusion for lists, then we could fuse 'encodeListWith', as
-- 'encodeWithStream' can keep control over the execution.


-- | Create a 'Builder' that encodes values with the given 'BoundedPrim'.
--
Expand Down Expand Up @@ -578,20 +572,29 @@ primBounded w x =
--
-- because it moves several variables out of the inner loop.
{-# INLINE primMapListBounded #-}
primMapListBounded :: BoundedPrim a -> [a] -> Builder
primMapListBounded w xs0 =
builder $ step xs0
where
step xs1 k (BufferRange op0 ope0) =
go xs1 op0
where
go [] !op = k (BufferRange op ope0)
go xs@(x':xs') !op
| op `plusPtr` bound <= ope0 = runB w x' op >>= go xs'
| otherwise =
return $ bufferFull bound op (step xs k)

bound = I.sizeBound w
primMapListBounded :: forall a. BoundedPrim a -> [a] -> Builder
primMapListBounded w = let
bound = I.sizeBound w

adjustRange :: (Ptr Word8 -> Ptr Word8 -> IO (BuildSignal r)) -> BuildStep r
adjustRange action (BufferRange bufStart bufEnd)
= action (bufEnd `plusPtr` negate bound) bufStart

augmentContinuation
:: a -> (Ptr Word8 -> Ptr Word8 -> IO (BuildSignal r))
-> Ptr Word8 -> Ptr Word8 -> IO (BuildSignal r)
augmentContinuation x kont = \stop start -> if start <= stop
then runB w x start >>= kont stop
else return $ bufferFull bound start $ adjustRange $
\newStop newStart -> runB w x newStart >>= kont newStop

finalContinuation
:: BuildStep r -> Ptr Word8 -> Ptr Word8 -> IO (BuildSignal r)
finalContinuation kont
= \stop start -> kont (BufferRange start $ stop `plusPtr` bound)

in \xs -> builder $ \kont ->
adjustRange $ foldr augmentContinuation (finalContinuation kont) xs

-- TODO: Add 'foldMap/encodeWith' its variants
-- TODO: Ensure rewriting 'primBounded w . f = primBounded (w #. f)'
Expand Down