Skip to content

Commit

Permalink
Apply the one-shot trick to Builder
Browse files Browse the repository at this point in the history
See the new comment in response to
https://gitlab.haskell.org/ghc/ghc/-/issues/23822.
  • Loading branch information
sgraf812 committed Aug 11, 2023
1 parent e8a9b52 commit f0a3db2
Showing 1 changed file with 27 additions and 1 deletion.
28 changes: 27 additions & 1 deletion Data/ByteString/Builder/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, RankNTypes, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, RankNTypes, TupleSections,
PatternSynonyms #-}
{-# LANGUAGE Unsafe #-}
{-# OPTIONS_HADDOCK not-home #-}
-- | Copyright : (c) 2010 - 2011 Simon Meier
Expand Down Expand Up @@ -137,6 +138,7 @@ import qualified Data.ByteString.Internal.Type as S
import qualified Data.ByteString.Lazy.Internal as L
import qualified Data.ByteString.Short.Internal as Sh

import qualified GHC.Exts

Check warning on line 141 in Data/ByteString/Builder/Internal.hs

View workflow job for this annotation

GitHub Actions / build (ubuntu-latest, 8.0)

The qualified import of ‘GHC.Exts’ is redundant

Check warning on line 141 in Data/ByteString/Builder/Internal.hs

View workflow job for this annotation

GitHub Actions / build (ubuntu-latest, 8.0)

The qualified import of ‘GHC.Exts’ is redundant
import qualified GHC.IO.Buffer as IO (Buffer(..), newByteBuffer)
import GHC.IO.Handle.Internals (wantWritableHandle, flushWriteBuffer)
import GHC.IO.Handle.Types (Handle__, haByteBuffer, haBufferMode)
Expand Down Expand Up @@ -326,7 +328,31 @@ fillWithBuildStep step fDone fFull fChunk !br = do
-- They are 'Monoid's where
-- 'mempty' is the zero-length sequence and
-- 'mappend' is concatenation, which runs in /O(1)/.
#if (MIN_VERSION_base(4,10,0))
newtype Builder = Builder' (forall r. BuildStep r -> BuildStep r)
pattern Builder :: (forall r. BuildStep r -> BuildStep r) -> Builder
pattern Builder f <- Builder' f
where
-- We want to tell the compiler to eta-expand over the BufferRange of a
-- BuildStep the same as it eta-expands over State# tokens.
-- This is important for loops such as `foldMap (B.word8 . fromIntegral) xs`
-- (see https://gitlab.haskell.org/ghc/ghc/-/issues/23822#note_520437)
-- where otherwise the compiler thinks `empty bs` is worth sharing.
-- The usual way to do that is via GHC.Exts.oneShot on `\br`.
--
-- By contrast, we refrain from marking the BuildStep argument as one-shot,
-- because that could lead to undesirable duplication of work in an
-- expression like
--
-- > let t = expensive 42 in stimes 1000 (Builder $ \bs br -> ... t ...)
--
-- Marking `\bs` one-shot as well tells the compiler that it's fine to float
-- the definition of `t` inside the builder -- thus executing `expensive`
-- 1000 times instead of just once.
Builder f = Builder' (\bs -> GHC.Exts.oneShot $ \br -> f bs br)
#else
newtype Builder = Builder (forall r. BuildStep r -> BuildStep r)
#endif

-- | Construct a 'Builder'. In contrast to 'BuildStep's, 'Builder's are
-- referentially transparent.
Expand Down

0 comments on commit f0a3db2

Please sign in to comment.