on master help sign in
Added RULES to merge adjacent bounds checks.
a4bd028Johan Tibell
Data/Text/Lazy/Builder.hs+21−3
@@ -97,7 +97,7 @@ singleton c = putChar c
97--
97--
98append :: Builder -> Builder -> Builder
98append :: Builder -> Builder -> Builder
99append (Builder f) (Builder g) = Builder (f . g)
99append (Builder f) (Builder g) = Builder (f . g)
100−{-# INLINE append #-}
100+{-# INLINE [1] append #-}
101
101
102-- TODO: Experiment to find the right threshold.
102-- TODO: Experiment to find the right threshold.
103copyLimit :: Int
103copyLimit :: Int
@@ -201,13 +201,13 @@ ensureFree !n = withSize $ \ l ->
201 if n <= l
201 if n <= l
202 then empty
202 then empty
203 else flush `append` withBuffer (const (newBuffer (max n defaultChunkSize)))
203 else flush `append` withBuffer (const (newBuffer (max n defaultChunkSize)))
204−{-# INLINE ensureFree #-}
204+{-# INLINE [1] ensureFree #-}
205
205
206-- | Ensure that @n@ many elements are available, and then use @f@ to
206-- | Ensure that @n@ many elements are available, and then use @f@ to
207-- write some elements into the memory.
207-- write some elements into the memory.
208writeN :: Int -> (forall s. A.MArray s Word16 -> Int -> ST s ()) -> Builder
208writeN :: Int -> (forall s. A.MArray s Word16 -> Int -> ST s ()) -> Builder
209writeN n f = ensureFree 1 `append` withBuffer (writeNBuffer n f)
209writeN n f = ensureFree 1 `append` withBuffer (writeNBuffer n f)
210−{-# INLINE writeN #-}
210+{-# INLINE [1] writeN #-}
211
211
212writeNBuffer :: Int -> (A.MArray s Word16 -> Int -> ST s ()) -> (Buffer s)
212writeNBuffer :: Int -> (A.MArray s Word16 -> Int -> ST s ()) -> (Buffer s)
213 -> ST s (Buffer s)
213 -> ST s (Buffer s)
@@ -235,3 +235,21 @@ unsafeCopy src sidx dest didx count =
235 | otherwise = do A.unsafeWrite dest j (A.unsafeIndex src i)
235 | otherwise = do A.unsafeWrite dest j (A.unsafeIndex src i)
236 copy_loop (i+1) (j+1) (c+1)
236 copy_loop (i+1) (j+1) (c+1)
237{-# INLINE unsafeCopy #-}
237{-# INLINE unsafeCopy #-}
238+
239+------------------------------------------------------------------------
240+-- Some nice rules for Builder
241+
242+{-# RULES
243+
244+"writeN/combine" forall a b (f::forall s. A.MArray s Word16 -> Int -> ST s ())
245+ (g::forall s. A.MArray s Word16 -> Int -> ST s ()).
246+ append (writeN a f) (writeN b g) =
247+ (writeN (a+b) (\marr o -> f marr o >> g marr (o+a)))
248+
249+"ensureFree/combine" forall a b .
250+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)
251+
252+"flush/combine"
253+ append flush flush = flush
254+
255+ #-}
tests/Benchmarks.hs+9
@@ -393,6 +393,7 @@ main = do
393 ],
393 ],
394 bgroup "builder" [
394 bgroup "builder" [
395 bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000,
395 bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000,
396+ bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a',
396 bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
397 bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
397 ]
398 ]
398 ]
399 ]
@@ -424,6 +425,14 @@ mappendNChar c n = go 0 mempty
424 | i < n = go (i+1) (acc `mappend` TB.singleton c)
425 | i < n = go (i+1) (acc `mappend` TB.singleton c)
425 | otherwise = acc
426 | otherwise = acc
426
427
428+-- Gives more opportunity for inlining and elimination of unnecesary
429+-- bounds checks.
430+mappend8Char :: Char -> TB.Builder
431+mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
432+ TB.singleton c `mappend` TB.singleton c `mappend`
433+ TB.singleton c `mappend` TB.singleton c `mappend`
434+ TB.singleton c `mappend` TB.singleton c
435+
427mappendNText :: TS.Text -> Int -> TB.Builder
436mappendNText :: TS.Text -> Int -> TB.Builder
428mappendNText t n = go 0 mempty
437mappendNText t n = go 0 mempty
429 where
438 where