text-builder-linear 0.1.2 → 0.1.3
raw patch · 16 files changed
+1320/−553 lines, 16 filesdep +ghc-bignumdep ~tasty-benchdep ~tasty-quickcheck
Dependencies added: ghc-bignum
Dependency ranges changed: tasty-bench, tasty-quickcheck
Files
- bench/BenchDecimal.hs +100/−32
- bench/BenchDecimalUnbounded.hs +174/−0
- bench/Main.hs +15/−11
- changelog.md +4/−0
- src/Data/Text/Builder/Linear.hs +16/−2
- src/Data/Text/Builder/Linear/Buffer.hs +15/−8
- src/Data/Text/Builder/Linear/Char.hs +2/−2
- src/Data/Text/Builder/Linear/Core.hs +1/−312
- src/Data/Text/Builder/Linear/Dec.hs +0/−172
- src/Data/Text/Builder/Linear/Dec/Bounded.hs +180/−0
- src/Data/Text/Builder/Linear/Dec/Unbounded.hs +314/−0
- src/Data/Text/Builder/Linear/Double.hs +13/−2
- src/Data/Text/Builder/Linear/Hex.hs +7/−5
- src/Data/Text/Builder/Linear/Internal.hs +428/−0
- test/Main.hs +40/−0
- text-builder-linear.cabal +11/−7
bench/BenchDecimal.hs view
@@ -2,17 +2,16 @@ -- Copyright: (c) 2022 Andrew Lelechenko -- Licence: BSD3 -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>- module BenchDecimal (benchDecimal) where -import qualified Data.ByteString as B-import qualified Data.ByteString.Builder as B-import qualified Data.Text as T-import Data.Text.Builder.Linear.Buffer+import Data.ByteString qualified as B+import Data.ByteString.Builder qualified as B+import Data.Text qualified as T+import Data.Text.Builder.Linear.Buffer (Buffer, runBuffer, ($$<|), ($<|), (|>$), (|>$$)) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.Int (decimal)-import Test.Tasty.Bench+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf) #ifdef MIN_VERSION_text_builder import qualified Text.Builder@@ -22,56 +21,125 @@ import qualified ByteString.StrictBuilder #endif -int :: Int+benchDecimal ∷ Benchmark+benchDecimal = bgroup "Decimal" [benchBoundedDecimal, benchUnboundedDecimal]++--------------------------------------------------------------------------------+-- Bounded+--------------------------------------------------------------------------------++int ∷ Int int = 123456789123456789 -benchLazyBuilder ∷ Int → T.Text-benchLazyBuilder = toStrict . toLazyText . go mempty+benchLazyBuilder ∷ Integral a ⇒ a → Int → T.Text+benchLazyBuilder k = toStrict . toLazyText . go mempty where go !acc 0 = acc- go !acc n = let i = n * int in go (decimal i <> (acc <> decimal i)) (n - 1)+ go !acc n = let i = fromIntegral n * k in go (decimal i <> (acc <> decimal i)) (n - 1)+{-# SPECIALIZE benchLazyBuilder ∷ Int → Int → T.Text #-}+{-# SPECIALIZE benchLazyBuilder ∷ Integer → Int → T.Text #-} -benchLazyBuilderBS ∷ Int → B.ByteString-benchLazyBuilderBS = B.toStrict . B.toLazyByteString . go mempty+benchLazyBuilderBS ∷ Int → Int → B.ByteString+benchLazyBuilderBS k = B.toStrict . B.toLazyByteString . go mempty where go !acc 0 = acc- go !acc n = let i = n * int in go (B.intDec i <> (acc <> B.intDec i)) (n - 1)+ go !acc n = let i = n * k in go (B.intDec i <> (acc <> B.intDec i)) (n - 1) #ifdef MIN_VERSION_text_builder-benchStrictBuilder ∷ Int → T.Text-benchStrictBuilder = Text.Builder.run . go mempty+benchStrictBuilder ∷ (Integral a) ⇒ a → Int → T.Text+benchStrictBuilder k = Text.Builder.run . go mempty where go !acc 0 = acc- go !acc n = let i = n * int in go (Text.Builder.decimal i <> (acc <> Text.Builder.decimal i)) (n - 1)+ go !acc n = let i = fromIntegral n * k in go (Text.Builder.decimal i <> (acc <> Text.Builder.decimal i)) (n - 1)+{-# SPECIALIZE benchStrictBuilder ∷ Int → Int → T.Text #-}+{-# SPECIALIZE benchStrictBuilder ∷ Integer → Int → T.Text #-} #endif #ifdef MIN_VERSION_bytestring_strict_builder-benchStrictBuilderBS ∷ Int → B.ByteString-benchStrictBuilderBS = ByteString.StrictBuilder.builderBytes . go mempty+benchStrictBuilderBS ∷ (Integral a) ⇒ a → Int → B.ByteString+benchStrictBuilderBS k = ByteString.StrictBuilder.builderBytes . go mempty where go !acc 0 = acc- go !acc n = let i = n * int in go (ByteString.StrictBuilder.asciiIntegral i <> (acc <> ByteString.StrictBuilder.asciiIntegral i)) (n - 1)+ go !acc n = let i = fromIntegral n * k in go (ByteString.StrictBuilder.asciiIntegral i <> (acc <> ByteString.StrictBuilder.asciiIntegral i)) (n - 1)+{-# SPECIALIZE benchStrictBuilderBS ∷ Int → Int → B.ByteString #-}+{-# SPECIALIZE benchStrictBuilderBS ∷ Integer → Int → B.ByteString #-} #endif -benchLinearBuilder ∷ Int → T.Text-benchLinearBuilder m = runBuffer (\b → go b m)+benchBoundedLinearBuilder ∷ Int → Int → T.Text+benchBoundedLinearBuilder k m = runBuffer (\b → go b m) where go ∷ Buffer ⊸ Int → Buffer go !acc 0 = acc- go !acc n = let i = n * int in go (i $<| (acc |>$ i)) (n - 1)+ go !acc n = let i = n * k in go (i $<| (acc |>$ i)) (n - 1) -benchDecimal ∷ Benchmark-benchDecimal = bgroup "Decimal" $ map mkGroup [1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6]+benchBoundedDecimal ∷ Benchmark+benchBoundedDecimal = bgroup "Bounded" $ map mkBoundedGroup [1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6] -mkGroup :: Int → Benchmark-mkGroup n = bgroup (show n)- [ bench "Data.Text.Lazy.Builder" $ nf benchLazyBuilder n- , bench "Data.ByteString.Builder" $ nf benchLazyBuilderBS n+mkBoundedGroup ∷ Int → Benchmark+mkBoundedGroup n =+ bgroup+ (show n)+ [ bench "Data.Text.Lazy.Builder" $ nf (benchLazyBuilder int) n+ , bench "Data.ByteString.Builder" $ nf (benchLazyBuilderBS int) n #ifdef MIN_VERSION_text_builder- , bench "Text.Builder" $ nf benchStrictBuilder n+ , bench "Text.Builder" $ nf (benchStrictBuilder int) n #endif #ifdef MIN_VERSION_bytestring_strict_builder- , bench "ByteString.StrictBuilder" $ nf benchStrictBuilderBS n+ , bench "ByteString.StrictBuilder" $ nf (benchStrictBuilderBS int) n #endif- , bench "Data.Text.Builder.Linear" $ nf benchLinearBuilder n- ]+ , bench "Data.Text.Builder.Linear" $ nf (benchBoundedLinearBuilder int) n+ ]++--------------------------------------------------------------------------------+-- Unbounded+--------------------------------------------------------------------------------++integerSmall ∷ Integer+integerSmall = toInteger (div @Word maxBound 20)++integerBig ∷ Integer+integerBig = toInteger (maxBound @Word - 1) ^ (10 ∷ Word)++integerHuge ∷ Integer+integerHuge = toInteger (maxBound @Word - 1) ^ (100 ∷ Word)++benchUnboundedDecimal ∷ Benchmark+benchUnboundedDecimal =+ bgroup+ "Unbounded"+ [ bgroup "Small" $ map (mkUnboundedGroup integerSmall) [1e0, 1e1, 1e2, 1e3, 1e4, 1e5]+ , bgroup "Big" $ map (mkUnboundedGroup integerBig) [1e0, 1e1, 1e2, 1e3, 1e4]+ , bgroup "Huge" $ map (mkUnboundedGroup integerHuge) [1e0, 1e1, 1e2, 1e3]+ ]++-- NOTE: In the following benchmarks, the ByteString builder would share work+-- if the prepender and the appender are identical, while our linear buffer does+-- not. So we increment the appender to get a fair benchmark.++benchUnboundedLazyBuilderBS ∷ Integer → Int → B.ByteString+benchUnboundedLazyBuilderBS k = B.toStrict . B.toLazyByteString . go mempty+ where+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (B.integerDec i <> (acc <> B.integerDec (i + 1))) (n - 1)++benchUnboundedLinearBuilder ∷ Integer → Int → T.Text+benchUnboundedLinearBuilder k m = runBuffer (\b → go b m)+ where+ go ∷ Buffer ⊸ Int → Buffer+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (i $$<| (acc |>$$ (i + 1))) (n - 1)++mkUnboundedGroup ∷ Integer → Int → Benchmark+mkUnboundedGroup integer n =+ bgroup+ (show n)+ [ bench "Data.Text.Lazy.Builder" $ nf (benchLazyBuilder integer) n+ , bench "Data.ByteString.Builder" $ nf (benchUnboundedLazyBuilderBS integer) n+#ifdef MIN_VERSION_text_builder+ , bench "Text.Builder" $ nf (benchStrictBuilder integer) n+#endif+#ifdef MIN_VERSION_bytestring_strict_builder+ , bench "ByteString.StrictBuilder" $ nf (benchStrictBuilderBS integer) n+#endif+ , bench "Data.Text.Builder.Linear" $ nf (benchUnboundedLinearBuilder integer) n+ ]
+ bench/BenchDecimalUnbounded.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE NumDecimals #-}++-- |+-- Copyright: (c) 2022 Andrew Lelechenko+-- Licence: BSD3+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+module BenchDecimalUnbounded (benchDecimalUnbounded) where++import Data.ByteString qualified as B+import Data.ByteString.Builder qualified as B+import Data.Text qualified as T+import Data.Text.Builder.Linear.Buffer (Buffer, runBuffer, ($$<|), (|>$$))+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB+import Data.Text.Lazy.Builder.Int qualified as TB+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf)++benchUnboundedLinearBuilderAppend ∷ Integer → Int → T.Text+benchUnboundedLinearBuilderAppend k m = runBuffer (`go` m)+ where+ go ∷ Buffer ⊸ Int → Buffer+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (acc |>$$ i) (n - 1)++benchUnboundedLinearBuilderPrepend ∷ Integer → Int → T.Text+benchUnboundedLinearBuilderPrepend k m = runBuffer (`go` m)+ where+ go ∷ Buffer ⊸ Int → Buffer+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (i $$<| acc) (n - 1)++-- NOTE: In the following benchmark, the ByteString builder would share work+-- if the prepender and the appender are identical, while our linear buffer does+-- not. So we increment the appender to get a fair benchmark.++benchUnboundedLinearBuilder ∷ Integer → Int → T.Text+benchUnboundedLinearBuilder k m = runBuffer (`go` m)+ where+ go ∷ Buffer ⊸ Int → Buffer+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (i $$<| (acc |>$$ (i + 1))) (n - 1)++benchUnboundedLazyBuilderBSAppend ∷ Integer → Int → B.ByteString+benchUnboundedLazyBuilderBSAppend k = B.toStrict . B.toLazyByteString . go mempty+ where+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (acc <> B.integerDec i) (n - 1)++benchUnboundedLazyBuilderBSPrepend ∷ Integer → Int → B.ByteString+benchUnboundedLazyBuilderBSPrepend k = B.toStrict . B.toLazyByteString . go mempty+ where+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (B.integerDec i <> acc) (n - 1)++benchUnboundedLazyBuilderBS ∷ Integer → Int → B.ByteString+benchUnboundedLazyBuilderBS k = B.toStrict . B.toLazyByteString . go mempty+ where+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (B.integerDec i <> (acc <> B.integerDec (i + 1))) (n - 1)++benchLazyBuilderAppend ∷ Integer → Int → T.Text+benchLazyBuilderAppend k = TL.toStrict . TB.toLazyText . go mempty+ where+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (acc <> TB.decimal i) (n - 1)++benchLazyBuilderPrepend ∷ Integer → Int → T.Text+benchLazyBuilderPrepend k = TL.toStrict . TB.toLazyText . go mempty+ where+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (TB.decimal i <> acc) (n - 1)++benchLazyBuilder ∷ Integer → Int → T.Text+benchLazyBuilder k = TL.toStrict . TB.toLazyText . go mempty+ where+ go !acc 0 = acc+ go !acc n = let i = fromIntegral n * k in go (TB.decimal i <> (acc <> TB.decimal (i + 1))) (n - 1)++data NamedInteger = I !String !Integer++mkGroup+ ∷ String+ → [Int]+ → (Integer → Int → T.Text)+ → (Integer → Int → B.ByteString)+ → (Integer → Int → T.Text)+ → [NamedInteger]+ → Benchmark+mkGroup name counts f g h = bgroup name . map mkBenches+ where+ mkBenches (I benchName i) =+ bgroup+ benchName+ (map (\count → bgroup (show count) (mkBench i count)) counts)+ mkBench i count =+ [ bench "Data.Text.Lazy.Builder" $ nf (f i) count+ , bench "Data.ByteString.Builder" $ nf (g i) count+ , bench "Data.Text.Builder.Linear" $ nf (h i) count+ ]+{-# INLINE mkGroup #-}++integers ∷ [NamedInteger]+integers =+ [ I "Small" (toInteger (div @Word maxBound 20)) -- ~ 9e17+ , I "Big01" (toInteger (maxBound @Word - 1) ^ (2 ∷ Word)) -- ~3e38+ , I "Big02" (toInteger (maxBound @Word - 1) ^ (5 ∷ Word)) -- ~2e96+ , I "Big03" (toInteger (maxBound @Word - 1) ^ (10 ∷ Word)) -- ~5e192+ , I "Big04" (toInteger (maxBound @Word - 1) ^ (15 ∷ Word)) -- ~1e289+ , I "Big05" (toInteger (maxBound @Word - 1) ^ (20 ∷ Word)) -- ~2e385+ -- , I "Big05a" (toInteger (maxBound @Word - 1) ^ (21 ∷ Word)) -- ~4e404+ -- , I "Big05b" (toInteger (maxBound @Word - 1) ^ (22 ∷ Word)) -- ~7e423+ -- , I "Big05c" (toInteger (maxBound @Word - 1) ^ (23 ∷ Word)) -- ~1e443+ -- , I "Big05d" (toInteger (maxBound @Word - 1) ^ (24 ∷ Word)) -- ~2e462+ , I "Big06" (toInteger (maxBound @Word - 1) ^ (25 ∷ Word)) -- ~4e481+ -- , I "Big06a" (toInteger (maxBound @Word - 1) ^ (26 ∷ Word)) -- ~8e500+ -- , I "Big06b" (toInteger (maxBound @Word - 1) ^ (27 ∷ Word)) -- ~2e520+ -- , I "Big06c" (toInteger (maxBound @Word - 1) ^ (28 ∷ Word))+ -- , I "Big06d" (toInteger (maxBound @Word - 1) ^ (29 ∷ Word))+ , I "Big07" (toInteger (maxBound @Word - 1) ^ (30 ∷ Word)) -- ~ 9e577+ , I "Big08" (toInteger (maxBound @Word - 1) ^ (35 ∷ Word)) -- ~ 2e674+ , I "Big09" (toInteger (maxBound @Word - 1) ^ (40 ∷ Word)) -- ~ 4e770+ , I "Big10" (toInteger (maxBound @Word - 1) ^ (45 ∷ Word)) -- ~ 9e866+ , I "Big11" (toInteger (maxBound @Word - 1) ^ (50 ∷ Word)) -- ~ 2e963+ , I "Huge01" (toInteger (maxBound @Word - 1) ^ (75 ∷ Word)) -- ~9e1444+ , I "Huge02" (toInteger (maxBound @Word - 1) ^ (100 ∷ Word)) -- ~4e1926+ , I "Huge03" (toInteger (maxBound @Word - 1) ^ (200 ∷ Word)) -- ~2e3853+ , I "Huge04" (toInteger (maxBound @Word - 1) ^ (300 ∷ Word)) -- ~6e5779+ , I "Huge05" (toInteger (maxBound @Word - 1) ^ (400 ∷ Word)) -- ~2e7706+ -- , I "Huge05a" (toInteger (maxBound @Word - 1) ^ (450 ∷ Word))+ , I "Huge06" (toInteger (maxBound @Word - 1) ^ (500 ∷ Word)) -- ~9e9632+ -- , I "Huge06b" (toInteger (maxBound @Word - 1) ^ (600 ∷ Word))+ , I "Huge07" (toInteger (maxBound @Word - 1) ^ (700 ∷ Word)) -- ~1e13486+ , I "Huge08" (toInteger (maxBound @Word - 1) ^ (1000 ∷ Word)) -- ~8e19265+ , I "Huge09" (toInteger (maxBound @Word - 1) ^ (3000 ∷ Word)) -- ~6e57797+ , I "Huge10" (toInteger (maxBound @Word - 1) ^ (5000 ∷ Word)) -- ~4e96329+ , I "Huge11" (toInteger (maxBound @Word - 1) ^ (10000 ∷ Word)) -- ~2e192659+ , I "Huge12" (toInteger (maxBound @Word - 1) ^ (100000 ∷ Word)) -- ~9e1926591+ -- , I "Huge13" (toInteger (maxBound @Word - 1) ^ (1000000 ∷ Word))+ , I "1e20" 1e20+ , I "1e100" 1e100+ , I "1e300" (10 ^ (300 ∷ Word))+ , I "1e500" (10 ^ (500 ∷ Word))+ , I "1e1000" (10 ^ (1000 ∷ Word))+ ]++benchDecimalUnbounded ∷ Benchmark+benchDecimalUnbounded =+ bgroup+ "Decimal: detailed unbounded"+ [ mkGroup+ "Append"+ counts+ benchLazyBuilderAppend+ benchUnboundedLazyBuilderBSAppend+ benchUnboundedLinearBuilderAppend+ integers+ , mkGroup+ "Prepend"+ counts+ benchLazyBuilderPrepend+ benchUnboundedLazyBuilderBSPrepend+ benchUnboundedLinearBuilderPrepend+ integers+ , mkGroup+ "Both"+ counts+ benchLazyBuilder+ benchUnboundedLazyBuilderBS+ benchUnboundedLinearBuilder+ integers+ ]+ where+ counts ∷ [Int]+ counts = [1e0, 1e1, 1e2]
bench/Main.hs view
@@ -2,7 +2,6 @@ -- Copyright: (c) 2022 Andrew Lelechenko -- Licence: BSD3 -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>- module Main where import Test.Tasty.Bench@@ -10,23 +9,28 @@ import BenchChar import BenchDecimal+import BenchDecimalUnbounded (benchDecimalUnbounded) import BenchDouble import BenchHexadecimal import BenchText main ∷ IO ()-main = defaultMain $ map (mapLeafBenchmarks addCompare) $- [ benchText- , benchChar- , benchDecimal- , benchHexadecimal- , benchDouble- ]+main =+ defaultMain $+ map (mapLeafBenchmarks addCompare) $+ [ benchText+ , benchChar+ , benchDecimal+ , benchDecimalUnbounded+ , benchHexadecimal+ , benchDouble+ ] -textBenchName :: String-textBenchName = "Data.Text.Lazy.Builder"+textBenchName ∷ String+-- textBenchName = "Data.Text.Lazy.Builder"+textBenchName = "Data.ByteString.Builder" -addCompare :: ([String] -> Benchmark -> Benchmark)+addCompare ∷ ([String] → Benchmark → Benchmark) addCompare (name : path) | name /= textBenchName = bcompare (printAwkExpr (locateBenchmark (textBenchName : path))) addCompare _ = id
changelog.md view
@@ -1,3 +1,7 @@+## 0.1.3++* Add decimal builders for unbounded inputs: `fromUnboundedDec`, `(|>$$)` and `($$<|)`.+ ## 0.1.2 * Fix unsound behaviour caused by inlining of `runBuffer` / `runBufferBS`
src/Data/Text/Builder/Linear.hs view
@@ -15,6 +15,7 @@ fromChar, fromAddr, fromDec,+ fromUnboundedDec, fromHex, fromDouble, ) where@@ -68,6 +69,7 @@ mempty = Builder (\b → b) {-# INLINE mempty #-} +-- | Use 'fromString' to create 'Builder' from 'String'. instance IsString Builder where fromString = fromText . fromString {-# INLINE fromString #-}@@ -77,6 +79,8 @@ -- >>> :set -XOverloadedStrings -- >>> fromText "foo" <> fromText "bar" -- "foobar"+--+-- For literal strings it is faster to use 'fromAddr' instead of 'fromText'. fromText ∷ Text → Builder fromText x = Builder $ \b → b |> x {-# INLINE fromText #-}@@ -98,19 +102,29 @@ -- >>> fromAddr "foo"# <> fromAddr "bar"# -- "foobar" ----- The literal string must not contain zero bytes @\\0@ and must be a valid UTF-8,+-- The literal string must not contain zero bytes @\\NUL@ and must be a valid UTF-8, -- these conditions are not checked. fromAddr ∷ Addr# → Builder fromAddr x = Builder $ \b → b |># x {-# INLINE fromAddr #-} --- | Create 'Builder', containing decimal representation of a given integer.+-- | Create 'Builder', containing decimal representation of a given /bounded/ integer. -- -- >>> fromChar 'x' <> fromDec (123 :: Int) -- "x123" fromDec ∷ (Integral a, FiniteBits a) ⇒ a → Builder fromDec x = Builder $ \b → b |>$ x {-# INLINE fromDec #-}++-- | Create 'Builder', containing decimal representation of a given /unbounded/ integer.+--+-- >>> fromChar 'x' <> fromUnboundedDec (1e24 :: Integer)+-- "x1000000000000000000000000"+--+-- @since 0.1.3+fromUnboundedDec ∷ Integral a ⇒ a → Builder+fromUnboundedDec x = Builder $ \b → b |>$$ x+{-# INLINE fromUnboundedDec #-} -- | Create 'Builder', containing hexadecimal representation of a given integer. --
src/Data/Text/Builder/Linear/Buffer.hs view
@@ -48,9 +48,15 @@ -- * Number formatting -- ** Decimal++ -- *** Bounded numbers (|>$), ($<|), + -- *** Unbounded numbers+ (|>$$),+ ($$<|),+ -- ** Hexadecimal -- *** Lower-case@@ -72,7 +78,8 @@ import Data.Text.Builder.Linear.Char import Data.Text.Builder.Linear.Core-import Data.Text.Builder.Linear.Dec+import Data.Text.Builder.Linear.Dec.Bounded+import Data.Text.Builder.Linear.Dec.Unbounded import Data.Text.Builder.Linear.Double import Data.Text.Builder.Linear.Hex @@ -113,7 +120,7 @@ -- >>> runBuffer (\b -> b |># "foo"# |># "bar"#) -- "foobar" ----- The literal string must not contain zero bytes @\\0@ and must be a valid UTF-8,+-- The literal string must not contain zero bytes @\\NUL@ and must be a valid UTF-8, -- these conditions are not checked. (|>#) ∷ Buffer ⊸ Addr# → Buffer @@ -133,13 +140,13 @@ -- >>> runBuffer (\b -> "foo"# #<| "bar"# #<| b) -- "foobar" ----- The literal string must not contain zero bytes @\\0@ and must be a valid UTF-8,+-- The literal string must not contain zero bytes @\\NUL@ and must be a valid UTF-8, -- these conditions are not checked. -- -- /Note:/ When the syntactic extensions @UnboxedTuples@ or @UnboxedSums@ are -- enabled, extra spaces are required when using parentheses: i.e. use @( '#<|' )@ -- instead of @('#<|')@. See the GHC User Guide chapter--- “[Unboxed types and primitive operations](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/primitives.html#unboxed-tuples)”+-- “<https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/primitives.html#unboxed-tuples Unboxed types and primitive operations>” -- for further information. ( #<| ) ∷ Addr# → Buffer ⊸ Buffer @@ -201,7 +208,7 @@ -- $custom_hexadecimal ----- Note that no /upper/ case hexadecimal formatting is provided. This package--- provides a minimal API with utility functions only for common cases. For--- other use cases, please adapt the code of this package, e.g. as shown in--- the [Unicode code point example](https://github.com/Bodigrim/linear-builder/examples/src/Examples/Unicode.hs).+-- Note that neither /upper/ case nor padded hexadecimal formatting is provided.+-- This package provides a minimal API with utility functions only for common cases.+-- For other use cases, please adapt the code of this package, e.g. as shown in+-- the [Unicode code point example](https://github.com/Bodigrim/linear-builder/blob/master/examples/src/Examples/Unicode.hs).
src/Data/Text/Builder/Linear/Char.hs view
@@ -162,8 +162,8 @@ -- (# b', empty #) -> b' >< justifyRight 12 ' ' (empty |> t) -- :} ----- >>> runBuffer (\b -> (b |> "Test:") `appendJustified` "foo" `appendJustified` "bar")--- "Test: foo bar"+-- >>> runBuffer (\b -> (b |> "Test:") `appendJustified` "AAA" `appendJustified` "BBBBBBB")+-- "Test: AAA BBBBBBB" justifyRight ∷ Word → Char → Buffer ⊸ Buffer justifyRight n ch buff = case lengthOfBuffer buff of (# buff', len #) →
src/Data/Text/Builder/Linear/Core.hs view
@@ -29,315 +29,4 @@ (><), ) where -import Data.ByteString.Internal (ByteString (..))-import Data.Text qualified as T-import Data.Text.Array qualified as A-import Data.Text.Internal (Text (..))-import GHC.Exts (Int (..), Levity (..), RuntimeRep (..), TYPE, byteArrayContents#, plusAddr#, unsafeCoerce#)-import GHC.ForeignPtr (ForeignPtr (..), ForeignPtrContents (..))-import GHC.ST (ST (..), runST)--import Data.Text.Builder.Linear.Array---- | Internally 'Buffer' is a mutable buffer.--- If a client gets hold of a variable of type 'Buffer',--- they'd be able to pass a mutable buffer to concurrent threads.--- That's why API below is carefully designed to prevent such possibility:--- clients always work with linear functions 'Buffer' ⊸ 'Buffer' instead--- and run them on an empty 'Buffer' to extract results.------ In terms of [@linear-base@](https://hackage.haskell.org/package/linear-base)--- 'Buffer' is [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)--- (see 'consumeBuffer')--- and [@Dupable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Dupable)--- (see 'dupBuffer'),--- but not [@Movable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Movable).------ >>> :set -XOverloadedStrings -XLinearTypes--- >>> import Data.Text.Builder.Linear.Buffer--- >>> runBuffer (\b -> '!' .<| "foo" <| (b |> "bar" |>. '.'))--- "!foobar."------ Remember: this is a strict builder, so on contrary to "Data.Text.Lazy.Builder"--- for optimal performance you should use strict left folds instead of lazy right ones.------ 'Buffer' is an unlifted datatype,--- so you can put it into an unboxed tuple @(# ..., ... #)@,--- but not into @(..., ...)@.-data Buffer ∷ TYPE ('BoxedRep 'Unlifted) where- Buffer ∷ {-# UNPACK #-} !Text → Buffer---- | Unwrap 'Buffer', no-op.--- Most likely, this is not the function you're looking for--- and you need 'runBuffer' instead.-unBuffer ∷ Buffer ⊸ Text-unBuffer (Buffer x) = x---- | Run a linear function on an empty 'Buffer', producing a strict 'Text'.------ Be careful to write @runBuffer (\\b -> ...)@ instead of @runBuffer $ \\b -> ...@,--- because current implementation of linear types lacks special support for '($)'.--- Another option is to enable @{-# LANGUAGE BlockArguments #-}@--- and write @runBuffer \\b -> ...@.--- Alternatively, you can import--- [@($)@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#v:-36-)--- from [@linear-base@](https://hackage.haskell.org/package/linear-base).------ 'runBuffer' is similar in spirit to mutable arrays API in--- [@Data.Array.Mutable.Linear@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html),--- which provides functions like--- [@fromList@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html#v:fromList) ∷ [@a@] → (@Vector@ @a@ ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) b) ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) @b@.--- Here the initial buffer is always empty and @b@ is 'Text'. Since 'Text' is--- [@Movable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Movable),--- 'Text' and [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) 'Text' are equivalent.-runBuffer ∷ (Buffer ⊸ Buffer) ⊸ Text-runBuffer f = unBuffer (shrinkBuffer (f (Buffer mempty)))-{-# NOINLINE runBuffer #-}--{-- See https://github.com/Bodigrim/linear-builder/issues/19- and https://github.com/tweag/linear-base/pull/187#discussion_r489081926- for the discussion why NOINLINE here and below in 'runBufferBS' is necessary.- Without it CSE (common subexpression elimination) can pull out 'Buffer's from- different 'runBuffer's and share them, which is absolutely not what we want.--}---- | Same as 'runBuffer', but returning a UTF-8 encoded strict 'ByteString'.-runBufferBS ∷ (Buffer ⊸ Buffer) ⊸ ByteString-runBufferBS f = case shrinkBuffer (f (Buffer memptyPinned)) of- Buffer (Text (A.ByteArray arr) (I# from) len) → BS fp len- where- addr# = byteArrayContents# arr `plusAddr#` from- fp = ForeignPtr addr# (PlainPtr (unsafeCoerce# arr))-{-# NOINLINE runBufferBS #-}--shrinkBuffer ∷ Buffer ⊸ Buffer-shrinkBuffer (Buffer (Text arr from len)) = Buffer $ runST $ do- arrM ← unsafeThaw arr- A.shrinkM arrM (from + len)- arr' ← A.unsafeFreeze arrM- pure $ Text arr' from len--memptyPinned ∷ Text-memptyPinned = runST $ do- marr ← A.newPinned 0- arr ← A.unsafeFreeze marr- pure $ Text arr 0 0---- | Create an empty 'Buffer'.------ The first 'Buffer' is the input and the second is a new empty 'Buffer'.------ This function is needed in some situations, e.g. with--- 'Data.Text.Builder.Linear.Buffer.justifyRight'. The following example creates--- a utility function that justify a text and then append it to a buffer.------ >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples--- >>> import Data.Text.Builder.Linear.Buffer--- >>> import Data.Text (Text)--- >>> :{--- appendJustified :: Buffer %1 -> Text -> Buffer--- appendJustified b t = case newEmptyBuffer b of--- -- Note that we need to create a new buffer from the text, in order--- -- to justify only the text and not the input buffer.--- (# b', empty #) -> b' >< justifyRight 12 ' ' (empty |> t)--- :}------ >>> runBuffer (\b -> (b |> "Test:") `appendJustified` "foo" `appendJustified` "bar")--- "Test: foo bar"------ Note: a previous buffer is necessary in order to create an empty buffer with--- the same characteristics.-newEmptyBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)-newEmptyBuffer (Buffer t@(Text arr _ _)) =- (# Buffer t, Buffer (if isPinned arr then memptyPinned else mempty) #)---- | Duplicate builder. Feel free to process results in parallel threads.--- Similar to--- [@Dupable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Dupable)--- from [@linear-base@](https://hackage.haskell.org/package/linear-base).------ It is a bit tricky to use because of--- <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/linear_types.html#limitations current limitations>--- of linear types with regards to @let@ and @where@. E. g., one cannot write------ > let (# b1, b2 #) = dupBuffer b in ("foo" <| b1) >< (b2 |> "bar")------ Instead write:------ >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples--- >>> import Data.Text.Builder.Linear.Buffer--- >>> runBuffer (\b -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))--- "foobar"------ Note the unboxed tuple: 'Buffer' is an unlifted datatype,--- so it cannot be put into @(..., ...)@.-dupBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)-dupBuffer (Buffer x) = (# Buffer x, Buffer (T.copy x) #)---- | Consume buffer linearly,--- similar to--- [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)--- from [@linear-base@](https://hackage.haskell.org/package/linear-base).-consumeBuffer ∷ Buffer ⊸ ()-consumeBuffer Buffer {} = ()---- | Erase buffer's content, replacing it with an empty 'Text'.-eraseBuffer ∷ Buffer ⊸ Buffer-eraseBuffer (Buffer (Text arr _ _)) =- Buffer (if isPinned arr then memptyPinned else mempty)---- | Return buffer's size in __bytes__ (not in 'Char's).--- This could be useful to implement a lazy builder atop of a strict one.-byteSizeOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)-byteSizeOfBuffer (Buffer t@(Text _ _ len)) = (# Buffer t, fromIntegral len #)---- | Return buffer's length in 'Char's (not in bytes).--- This could be useful to implement @dropEndBuffer@ and @takeEndBuffer@, e. g.,------ @--- import Data.Unrestricted.Linear------ dropEndBuffer :: Word -> Buffer %1 -> Buffer--- dropEndBuffer n buf = case lengthOfBuffer buf of--- (# buf', len #) -> case move len of--- Ur len' -> takeBuffer (len' - n) buf'--- @-lengthOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)-lengthOfBuffer (Buffer t) = (# Buffer t, fromIntegral (T.length t) #)---- | Slice 'Buffer' by dropping given number of 'Char's.-dropBuffer ∷ Word → Buffer ⊸ Buffer-dropBuffer nChar (Buffer t@(Text arr off len))- | nByte <= 0 = Buffer (Text arr (off + len) 0)- | otherwise = Buffer (Text arr (off + nByte) (len - nByte))- where- nByte = T.measureOff (fromIntegral nChar) t---- | Slice 'Buffer' by taking given number of 'Char's.-takeBuffer ∷ Word → Buffer ⊸ Buffer-takeBuffer nChar (Buffer t@(Text arr off _))- | nByte <= 0 = Buffer t- | otherwise = Buffer (Text arr off nByte)- where- nByte = T.measureOff (fromIntegral nChar) t---- | Low-level routine to append data of unknown size to a 'Buffer'.-appendBounded- ∷ Int- -- ^ Upper bound for the number of bytes, written by an action- → (∀ s. A.MArray s → Int → ST s Int)- -- ^ Action, which writes bytes __starting__ from the given offset- -- and returns an actual number of bytes written.- → Buffer- ⊸ Buffer-appendBounded maxSrcLen appender (Buffer (Text dst dstOff dstLen)) = Buffer $ runST $ do- let dstFullLen = sizeofByteArray dst- newFullLen = dstOff + 2 * (dstLen + maxSrcLen)- newM ←- if dstOff + dstLen + maxSrcLen <= dstFullLen- then unsafeThaw dst- else do- tmpM ← (if isPinned dst then A.newPinned else A.new) newFullLen- A.copyI dstLen tmpM dstOff dst dstOff- pure tmpM- srcLen ← appender newM (dstOff + dstLen)- new ← A.unsafeFreeze newM- pure $ Text new dstOff (dstLen + srcLen)-{-# INLINE appendBounded #-}---- | Low-level routine to append data of known size to a 'Buffer'.-appendExact- ∷ Int- -- ^ Exact number of bytes, written by an action- → (∀ s. A.MArray s → Int → ST s ())- -- ^ Action, which writes bytes __starting__ from the given offset- → Buffer- ⊸ Buffer-appendExact srcLen appender =- appendBounded- srcLen- (\dst dstOff → appender dst dstOff >> pure srcLen)-{-# INLINE appendExact #-}---- | Low-level routine to prepend data of unknown size to a 'Buffer'.-prependBounded- ∷ Int- -- ^ Upper bound for the number of bytes, written by an action- → (∀ s. A.MArray s → Int → ST s Int)- -- ^ Action, which writes bytes __finishing__ before the given offset- -- and returns an actual number of bytes written.- → (∀ s. A.MArray s → Int → ST s Int)- -- ^ Action, which writes bytes __starting__ from the given offset- -- and returns an actual number of bytes written.- → Buffer- ⊸ Buffer-prependBounded maxSrcLen prepender appender (Buffer (Text dst dstOff dstLen))- | maxSrcLen <= dstOff = Buffer $ runST $ do- newM ← unsafeThaw dst- srcLen ← prepender newM dstOff- new ← A.unsafeFreeze newM- pure $ Text new (dstOff - srcLen) (srcLen + dstLen)- | otherwise = Buffer $ runST $ do- let dstFullLen = sizeofByteArray dst- newOff = dstLen + maxSrcLen- newFullLen = 2 * newOff + (dstFullLen - dstOff - dstLen)- newM ← (if isPinned dst then A.newPinned else A.new) newFullLen- srcLen ← appender newM newOff- A.copyI dstLen newM (newOff + srcLen) dst dstOff- new ← A.unsafeFreeze newM- pure $ Text new newOff (dstLen + srcLen)-{-# INLINE prependBounded #-}---- | Low-level routine to append data of known size to a 'Buffer'.-prependExact- ∷ Int- -- ^ Exact number of bytes, written by an action- → (∀ s. A.MArray s → Int → ST s ())- -- ^ Action, which writes bytes __starting__ from the given offset- → Buffer- ⊸ Buffer-prependExact srcLen appender =- prependBounded- srcLen- (\dst dstOff → appender dst (dstOff - srcLen) >> pure srcLen)- (\dst dstOff → appender dst dstOff >> pure srcLen)-{-# INLINE prependExact #-}---- | Concatenate two 'Buffer's, potentially mutating both of them.------ You likely need to use 'dupBuffer' to get hold on two builders at once:------ >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples--- >>> import Data.Text.Builder.Linear.Buffer--- >>> runBuffer (\b -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))--- "foobar"-(><) ∷ Buffer ⊸ Buffer ⊸ Buffer--infix 6 ><-Buffer (Text left leftOff leftLen) >< Buffer (Text right rightOff rightLen) = Buffer $ runST $ do- let leftFullLen = sizeofByteArray left- rightFullLen = sizeofByteArray right- canCopyToLeft = leftOff + leftLen + rightLen <= leftFullLen- canCopyToRight = leftLen <= rightOff- shouldCopyToLeft = canCopyToLeft && (not canCopyToRight || leftLen >= rightLen)- if shouldCopyToLeft- then do- newM ← unsafeThaw left- A.copyI rightLen newM (leftOff + leftLen) right rightOff- new ← A.unsafeFreeze newM- pure $ Text new leftOff (leftLen + rightLen)- else- if canCopyToRight- then do- newM ← unsafeThaw right- A.copyI leftLen newM (rightOff - leftLen) left leftOff- new ← A.unsafeFreeze newM- pure $ Text new (rightOff - leftLen) (leftLen + rightLen)- else do- let fullLen = leftOff + leftLen + rightLen + (rightFullLen - rightOff - rightLen)- newM ← (if isPinned left || isPinned right then A.newPinned else A.new) fullLen- A.copyI leftLen newM leftOff left leftOff- A.copyI rightLen newM (leftOff + leftLen) right rightOff- new ← A.unsafeFreeze newM- pure $ Text new leftOff (leftLen + rightLen)+import Data.Text.Builder.Linear.Internal
− src/Data/Text/Builder/Linear/Dec.hs
@@ -1,172 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}---- |--- Copyright: (c) 2022 Andrew Lelechenko--- Licence: BSD3--- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>-#ifdef aarch64_HOST_ARCH-{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-}-#endif--module Data.Text.Builder.Linear.Dec (- (|>$),- ($<|),-) where--#include "MachDeps.h"--import Data.Bits (Bits (..), FiniteBits (..))-import Data.Int (Int16, Int32, Int8)-import Data.Text.Array qualified as A-import Data.Word (Word16, Word32, Word8)-import GHC.Exts (Addr#, Int (..), Ptr (..), dataToTag#, (>=#))-import GHC.Ptr (plusPtr)-import GHC.ST (ST)-import Numeric.QuoteQuot (assumeNonNegArg, astQuot, quoteAST, quoteQuot)--import Data.Text.Builder.Linear.Core---- | Append decimal number.-(|>$) ∷ (Integral a, FiniteBits a) ⇒ Buffer ⊸ a → Buffer--infixl 6 |>$-buffer |>$ n =- appendBounded- (maxDecLen n)- (\dst dstOff → unsafeAppendDec dst dstOff n)- buffer-{-# INLINEABLE (|>$) #-}---- | Prepend decimal number.-($<|) ∷ (Integral a, FiniteBits a) ⇒ a → Buffer ⊸ Buffer--infixr 6 $<|-n $<| buffer =- prependBounded- (maxDecLen n)- (\dst dstOff → unsafePrependDec dst dstOff n)- (\dst dstOff → unsafeAppendDec dst dstOff n)- buffer-{-# INLINEABLE ($<|) #-}---- | ceiling (fbs a * logBase 10 2) < ceiling (fbs a * 5 / 16) < 1 + floor (fbs a * 5 / 16)-maxDecLen ∷ FiniteBits a ⇒ a → Int-maxDecLen a- | isSigned a = 2 + (finiteBitSize a * 5) `shiftR` 4- | otherwise = 1 + (finiteBitSize a * 5) `shiftR` 4-{-# INLINEABLE maxDecLen #-}--exactDecLen ∷ (Integral a, FiniteBits a) ⇒ a → Int-exactDecLen n- | n < 0 =- go 2 (complement n + fromIntegral (I# (dataToTag# (n > bit (finiteBitSize n - 1)))))- | otherwise =- go 1 n- where- go ∷ (Integral a, FiniteBits a) ⇒ Int → a → Int- go acc k- | finiteBitSize k >= if isSigned k then 31 else 30, k >= 1e9 = go (acc + 9) (quotBillion k)- | otherwise = acc + goInt (fromIntegral k)-- goInt l@(I# l#)- | l >= 1e5 = 5 + I# (l# >=# 100_000_000#) + I# (l# >=# 10_000_000#) + I# (l# >=# 1_000_000#)- | otherwise = I# (l# >=# 10_000#) + I# (l# >=# 1_000#) + I# (l# >=# 100#) + I# (l# >=# 10#)-{-# INLINEABLE exactDecLen #-}--unsafeAppendDec ∷ (Integral a, FiniteBits a) ⇒ A.MArray s → Int → a → ST s Int-unsafeAppendDec marr off n = unsafePrependDec marr (off + exactDecLen n) n-{-# INLINEABLE unsafeAppendDec #-}--unsafePrependDec ∷ ∀ s a. (Integral a, FiniteBits a) ⇒ A.MArray s → Int → a → ST s Int-unsafePrependDec marr !off n- | n < 0- , n == bit (finiteBitSize n - 1) = do- A.unsafeWrite marr (off - 1) (fromIntegral (0x30 + minBoundLastDigit n))- go (off - 2) (abs (bit (finiteBitSize n - 1) `quot` 10)) >>= sign- | n == 0 = do- A.unsafeWrite marr (off - 1) 0x30 >> pure 1- | otherwise = go (off - 1) (abs n) >>= sign- where- sign !o- | n > 0 = pure (off - o)- | otherwise = do- A.unsafeWrite marr (o - 1) 0x2d -- '-'- pure (off - o + 1)-- go ∷ Int → a → ST s Int- go o k- | k >= 10 = do- let (q, r) = quotRem100 k- A.copyFromPointer marr (o - 1) (Ptr digits `plusPtr` (fromIntegral r `shiftL` 1)) 2- if k < 100 then pure (o - 1) else go (o - 2) q- | otherwise = do- A.unsafeWrite marr o (fromIntegral (0x30 + k))- pure o-- digits ∷ Addr#- digits = "00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899"#-{-# INLINEABLE unsafePrependDec #-}---- Compute rem minBound 10 efficiently. Given that:--- • minBound = 1 `shiftL` (finiteBitSize a - 1) = -2^(finiteBitSize a - 1)--- • the last digit of 2^k forms a cycle for k≥1: 2,4,8,6--- Then it is enough to pattern-match rem (finiteBitSize a) 4,--- i.e. finiteBitSize a .&. 3-minBoundLastDigit ∷ FiniteBits a ⇒ a → Int-minBoundLastDigit a = case finiteBitSize a .&. 3 of- 0 → 8- 1 → 6- 2 → 2- _ → 4-{-# INLINEABLE minBoundLastDigit #-}--quotRem100 ∷ (Integral a, FiniteBits a) ⇒ a → (a, a)---- https://gitlab.haskell.org/ghc/ghc/-/issues/22933-#ifdef aarch64_HOST_ARCH-quotRem100 a = a `quotRem` 100-#else-quotRem100 a = let q = quot100 a in (q, a - 100 * q)-#endif-{-# INLINEABLE quotRem100 #-}--quot100 ∷ (Integral a, FiniteBits a) ⇒ a → a-quot100 a = case (finiteBitSize a, isSigned a) of- (64, True)- | finiteBitSize (0 ∷ Int) == 64 →- cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int))- (64, False)- | finiteBitSize (0 ∷ Word) == 64 →- cast $$(quoteQuot (100 ∷ Word))- (32, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int32))- (32, False) → cast $$(quoteQuot (100 ∷ Word32))- (16, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int16))- (16, False) → cast $$(quoteQuot (100 ∷ Word16))- (8, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int8))- (8, False) → cast $$(quoteQuot (100 ∷ Word8))- _ → a `quot` 100- where- cast ∷ (Integral a, Integral b) ⇒ (b → b) → a- cast f = fromIntegral (f (fromIntegral a))-{-# INLINEABLE quot100 #-}--quotBillion ∷ (Integral a, FiniteBits a) ⇒ a → a-#ifdef aarch64_HOST_ARCH-quotBillion a = a `quot` 1e9-#else-quotBillion a = case (finiteBitSize a, isSigned a) of- (64, True)- | finiteBitSize (0 :: Int) == 64- → cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int))- (64, False)- | finiteBitSize (0 :: Word) == 64- → cast $$(quoteQuot (1e9 :: Word))- (32, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int32))- (32, False) → cast $$(quoteQuot (1e9 :: Word32))- _ → a `quot` 1e9- where- cast :: (Integral a, Integral b) => (b → b) → a- cast f = fromIntegral (f (fromIntegral a))-#endif-{-# INLINEABLE quotBillion #-}
+ src/Data/Text/Builder/Linear/Dec/Bounded.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Copyright: (c) 2022 Andrew Lelechenko+-- Licence: BSD3+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+#ifdef aarch64_HOST_ARCH+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-}+#endif++module Data.Text.Builder.Linear.Dec.Bounded (+ (|>$),+ ($<|),+ unsafePrependDec,+ unsafeAppendDec,+ maxDecLen,+ quotRem100,+ digits,+) where++#include "MachDeps.h"++import Data.Bits (Bits (..), FiniteBits (..))+import Data.Int (Int16, Int32, Int8)+import Data.Text.Array qualified as A+import Data.Word (Word16, Word32, Word8)+import Foreign.C.String (CString)+import GHC.Exts (Int (..), Ptr (..), dataToTag#, (>=#))+import GHC.Ptr (plusPtr)+import GHC.ST (ST (..))+import Numeric.QuoteQuot (assumeNonNegArg, astQuot, quoteAST, quoteQuot)++import Data.Text.Builder.Linear.Core++-- | Append the decimal representation of a /bounded/ integral number.+(|>$) ∷ (Integral a, FiniteBits a) ⇒ Buffer ⊸ a → Buffer++infixl 6 |>$+buffer |>$ n =+ appendBounded+ (maxDecLen n)+ (\dst dstOff → unsafeAppendDec dst dstOff n)+ buffer+{-# INLINEABLE (|>$) #-}++-- | Prepend the decimal representation of a /bounded/ integral number.+($<|) ∷ (Integral a, FiniteBits a) ⇒ a → Buffer ⊸ Buffer++infixr 6 $<|+n $<| buffer =+ prependBounded+ (maxDecLen n)+ (\dst dstOff → unsafePrependDec dst dstOff n)+ (\dst dstOff → unsafeAppendDec dst dstOff n)+ buffer+{-# INLINEABLE ($<|) #-}++-- | ceiling (fbs a * logBase 10 2) < ceiling (fbs a * 5 / 16) < 1 + floor (fbs a * 5 / 16)+maxDecLen ∷ FiniteBits a ⇒ a → Int+maxDecLen a+ | isSigned a = 2 + (finiteBitSize a * 5) `shiftR` 4+ | otherwise = 1 + (finiteBitSize a * 5) `shiftR` 4+{-# INLINEABLE maxDecLen #-}++exactDecLen ∷ (Integral a, FiniteBits a) ⇒ a → Int+exactDecLen n+ | n < 0 =+ go 2 (complement n + fromIntegral (I# (dataToTag# (n > bit (finiteBitSize n - 1)))))+ | otherwise =+ go 1 n+ where+ go ∷ (Integral a, FiniteBits a) ⇒ Int → a → Int+ go acc k+ | finiteBitSize k >= if isSigned k then 31 else 30, k >= 1e9 = go (acc + 9) (quotBillion k)+ | otherwise = acc + exactIntDecLen (fromIntegral k)++ exactIntDecLen ∷ Int → Int+ exactIntDecLen l@(I# l#)+ | l >= 1e5 = 5 + I# (l# >=# 100_000_000#) + I# (l# >=# 10_000_000#) + I# (l# >=# 1_000_000#)+ | otherwise = I# (l# >=# 10_000#) + I# (l# >=# 1_000#) + I# (l# >=# 100#) + I# (l# >=# 10#)+{-# INLINEABLE exactDecLen #-}++unsafeAppendDec ∷ (Integral a, FiniteBits a) ⇒ A.MArray s → Int → a → ST s Int+unsafeAppendDec marr off n = unsafePrependDec marr (off + exactDecLen n) n+{-# INLINEABLE unsafeAppendDec #-}++unsafePrependDec ∷ ∀ s a. (Integral a, FiniteBits a) ⇒ A.MArray s → Int → a → ST s Int+unsafePrependDec marr !off n+ | n < 0+ , n == bit (finiteBitSize n - 1) = do+ A.unsafeWrite marr (off - 1) (fromIntegral (0x30 + minBoundLastDigit n))+ go (off - 2) (abs (bit (finiteBitSize n - 1) `quot` 10)) >>= sign+ | n == 0 = do+ A.unsafeWrite marr (off - 1) 0x30 >> pure 1+ | otherwise = go (off - 1) (abs n) >>= sign+ where+ sign !o+ | n > 0 = pure (off - o)+ | otherwise = do+ A.unsafeWrite marr (o - 1) 0x2d -- '-'+ pure (off - o + 1)++ go ∷ Int → a → ST s Int+ go o k+ | k >= 10 = do+ let (q, r) = quotRem100 k+ A.copyFromPointer marr (o - 1) (digits `plusPtr` (fromIntegral r `shiftL` 1)) 2+ if k < 100 then pure (o - 1) else go (o - 2) q+ | otherwise = do+ A.unsafeWrite marr o (fromIntegral (0x30 + k))+ pure o+{-# INLINEABLE unsafePrependDec #-}++digits ∷ CString+digits = Ptr "00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899"#+{-# NOINLINE digits #-}++-- Compute rem minBound 10 efficiently. Given that:+-- • minBound = 1 `shiftL` (finiteBitSize a - 1) = -2^(finiteBitSize a - 1)+-- • the last digit of 2^k forms a cycle for k≥1: 2,4,8,6+-- Then it is enough to pattern-match rem (finiteBitSize a) 4,+-- i.e. finiteBitSize a .&. 3+minBoundLastDigit ∷ FiniteBits a ⇒ a → Int+minBoundLastDigit a = case finiteBitSize a .&. 3 of+ 0 → 8+ 1 → 6+ 2 → 2+ _ → 4+{-# INLINEABLE minBoundLastDigit #-}++quotRem100 ∷ (Integral a, FiniteBits a) ⇒ a → (a, a)++-- https://gitlab.haskell.org/ghc/ghc/-/issues/22933+#ifdef aarch64_HOST_ARCH+quotRem100 a = a `quotRem` 100+#else+quotRem100 a = let q = quot100 a in (q, a - 100 * q)+#endif+{-# INLINEABLE quotRem100 #-}++quot100 ∷ (Integral a, FiniteBits a) ⇒ a → a+quot100 a = case (finiteBitSize a, isSigned a) of+ (64, True)+ | finiteBitSize (0 ∷ Int) == 64 →+ cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int))+ (64, False)+ | finiteBitSize (0 ∷ Word) == 64 →+ cast $$(quoteQuot (100 ∷ Word))+ (32, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int32))+ (32, False) → cast $$(quoteQuot (100 ∷ Word32))+ (16, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int16))+ (16, False) → cast $$(quoteQuot (100 ∷ Word16))+ (8, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int8))+ (8, False) → cast $$(quoteQuot (100 ∷ Word8))+ _ → a `quot` 100+ where+ cast ∷ (Integral a, Integral b) ⇒ (b → b) → a+ cast f = fromIntegral (f (fromIntegral a))+{-# INLINEABLE quot100 #-}++quotBillion ∷ (Integral a, FiniteBits a) ⇒ a → a+#ifdef aarch64_HOST_ARCH+quotBillion a = a `quot` 1e9+#else+quotBillion a = case (finiteBitSize a, isSigned a) of+ (64, True)+ | finiteBitSize (0 :: Int) == 64+ → cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int))+ (64, False)+ | finiteBitSize (0 :: Word) == 64+ → cast $$(quoteQuot (1e9 :: Word))+ (32, True) → cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int32))+ (32, False) → cast $$(quoteQuot (1e9 :: Word32))+ _ → a `quot` 1e9+ where+ cast :: (Integral a, Integral b) => (b → b) → a+ cast f = fromIntegral (f (fromIntegral a))+#endif+{-# INLINEABLE quotBillion #-}
+ src/Data/Text/Builder/Linear/Dec/Unbounded.hs view
@@ -0,0 +1,314 @@+-- |+-- Copyright: (c) 2024 Pierre Le Marre+-- Licence: BSD3+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+module Data.Text.Builder.Linear.Dec.Unbounded (+ (|>$$),+ ($$<|),+ -- prependUnboundedDecimal,+ -- Strategy (..),+)+where++import Data.Bits (Bits (..), FiniteBits (..))+import Data.Text.Array qualified as A+import Data.Word (Word64)+import GHC.Exts (+ Int (..),+ Int#,+ State#,+ Word (..),+ Word#,+ word2Int#,+ (-#),+ )+import GHC.Num.BigNat qualified as BN+import GHC.Num.Integer qualified as I+import GHC.Num.Natural qualified as N+import GHC.Ptr (plusPtr)+import GHC.ST (ST (..))++import Data.Text.Builder.Linear.Array (unsafeReplicate)+import Data.Text.Builder.Linear.Core (Buffer)+import Data.Text.Builder.Linear.Dec.Bounded (digits, maxDecLen, quotRem100)+import Data.Text.Builder.Linear.Dec.Bounded qualified as Bounded+import Data.Text.Builder.Linear.Internal (appendBounded', prependBounded')++--------------------------------------------------------------------------------+-- Append+--------------------------------------------------------------------------------++-- | Append the decimal representation of an /unbounded/ integral number.+--+-- @since 0.1.3+(|>$$) ∷ Integral a ⇒ Buffer ⊸ a → Buffer++infixl 6 |>$$+buffer |>$$ n = case toInteger n of+ !n' →+ appendBounded'+ (maxIntegerDecLen n')+ (unsafeAppendDec n')+ buffer+{-# INLINEABLE (|>$$) #-}++-- • For small 'Integers', `unsafeAppendDec`+-- • For 'BigNat's, use a buffer with `unsafePrependUnboundedDec`, then copy it.+--+-- For *bounded* integers we used the exact size of the decimal representation to+-- compute the offset from which we can use the prepend action to actually append.+--+-- But the exact size of an (unbounded) 'Integer' could be expensive to compute.+-- So it is faster to use a buffer and then copy it.+unsafeAppendDec+ ∷ ∀ s x+ . Integer+ → ((A.MArray s → Int → ST s Int) → ST s x)+ → ((A.MArray s → Int → ST s Int) → ST s x)+ → ST s x+unsafeAppendDec n = case n of+ I.IS i# → \append _ → append (\marr off → Bounded.unsafeAppendDec marr off (I# i#))+ _ → \_ prepend → prepend (\marr off → unsafePrependDec marr off n)+{-# INLINEABLE unsafeAppendDec #-}++--------------------------------------------------------------------------------+-- Prepend+--------------------------------------------------------------------------------++-- | Prepend the decimal representation of an /unbounded/ integral number.+--+-- @since 0.1.3+($$<|) ∷ Integral a ⇒ a → Buffer ⊸ Buffer++infixr 6 $$<|+n $$<| buffer = case toInteger n of+ !n' →+ prependBounded'+ (maxIntegerDecLen n')+ (\dst dstOff → unsafePrependDec dst dstOff n')+ buffer+{-# INLINEABLE ($$<|) #-}++unsafePrependDec ∷ ∀ s. A.MArray s → Int → Integer → ST s Int+unsafePrependDec marr off@(I# off#) n = case n of+ I.IS i# → Bounded.unsafePrependDec marr off (I# i#)+ _ → unsafePrependBigNatDec marr (off# -# 1#) (integerToBigNat# n) >>= prependSign+ where+ prependSign !off' =+ if n < 0+ then do+ A.unsafeWrite marr (off' - 1) 0x2d -- '-'+ pure (off - off' + 1)+ else pure (off - off')+{-# INLINEABLE unsafePrependDec #-}++type DigitsWriter s = Int# → BN.BigNat# → ST s Int++-- Use the fastest writer depending on the BigNat size+unsafePrependBigNatDec ∷ ∀ s. A.MArray s → DigitsWriter s+unsafePrependBigNatDec marr !off0 !n0+ | BN.bigNatSize n0 < hugeSizeThreshold = prependSmallNat marr off0 n0+ | otherwise = prependHugeNat marr off0 n0+ where+ hugeSizeThreshold ∷ Word+ hugeSizeThreshold = 80++-- Writer for “small” 'BigNat's.+--+-- Divide repeatedly by poweredBase.+prependSmallNat ∷ ∀ s. A.MArray s → DigitsWriter s+prependSmallNat marr = go+ where+ !(# power, poweredBase, _poweredBase² #) = selectPower (# #)++ go ∷ DigitsWriter s+ go !o1 !n = case n `BN.bigNatQuotRemWord#` poweredBase of+ (# q, r #) → do+ !o2 ← unsafePrependWordDec marr (I# o1) (W# r)+ if BN.bigNatIsZero q+ then pure o2+ else do+ let !o3 = o1 -# (word2Int# power -# 1#)+ padWithZeros marr (I# o3) (o2 - I# o3)+ go (o3 -# 1#) q++-- Use the raw state in order to avoid boxed Int in `scaleWriter`+type DigitsWriter# s = Int# → BN.BigNat# → State# s → (# State# s, Int# #)++-- Writer for “huge” 'BigNat's.+--+-- Algorithm used in bytestring-0.12.1 (simplified):+--+-- 1. Find k0 = min k such that pow10 ^ (2 ^ (k + 1)) > n0+-- 2. Set k to k0 and n to n0+-- 3. Set (q, r) = n `quotRem` (pow10 ^ (2 ^ k))+-- 4. if k = 0, then write decimal representation of q and r+-- else repeat recursively 3 and 4 with n = {q,r} and k = k - 1+prependHugeNat ∷ ∀ s. A.MArray s → DigitsWriter s+prependHugeNat marr off n = ST $ \s1 →+ case go prependTiny# poweredBase² off n s1 of+ (# s2, off'# #) → (# s2, I# off'# #)+ where+ !(# power, poweredBase, poweredBase² #) = selectPower (# #)++ go ∷ (Bool → DigitsWriter# s) → BN.BigNat# → DigitsWriter# s+ go !write !pow10 !o !n# =+ if BN.bigNatLt n# pow10+ then write True o n#+ else go (scaleWriter write pow10) (BN.bigNatMul pow10 pow10) o n#++ scaleWriter ∷ (Bool → DigitsWriter# s) → BN.BigNat# → Bool → DigitsWriter# s+ scaleWriter !write !pow10 = \ !high !o1 !n# s1 →+ case BN.bigNatQuotRem# n# pow10 of+ (# q, r #)+ | high && BN.bigNatIsZero q → write high o1 r s1+ | otherwise → case write False o1 r s1 of+ (# s2, o2 #) → write high (o2 -# 1#) q s2++ prependTiny# ∷ Bool → DigitsWriter# s+ prependTiny# !high !o1 !n# = case prependTiny high o1 n# of+ ST f → \s1 → case f s1 of+ (# s2, I# o2 #) → (# s2, o2 #)++ -- Use ST instead of raw state as the utils functions do.+ -- `prependTiny` must inline to leave no boxing/unboxing roundtrip.+ {-# INLINE prependTiny #-}+ prependTiny ∷ Bool → DigitsWriter s+ prependTiny !high !o1 !n# =+ case BN.bigNatQuotRemWord# n# poweredBase of+ (# q, r #) → do+ !o2 ← unsafePrependWordDec marr (I# o1) (W# r)+ if high && BN.bigNatIsZero q+ then pure o2+ else do+ let !o3 = I# o1 - (fromIntegral (W# power) - 1)+ padWithZeros marr o3 (o2 - o3)+ !o4 ← unsafePrependWordDec marr (o3 - 1) (BN.bigNatToWord q)+ if high+ then pure o4+ else do+ let !o5 = o3 - fromIntegral (W# power)+ padWithZeros marr o5 (o4 - o5)+ pure o5++--------------------------------------------------------------------------------+-- Prepend word+--------------------------------------------------------------------------------++unsafePrependWordDec ∷ ∀ s. A.MArray s → Int → Word → ST s Int+unsafePrependWordDec = f+ where+ f marr !o !k+ | k >= 10 = do+ let (q, r) = quotRem100 k+ A.copyFromPointer marr (o - 1) (digits `plusPtr` (fromIntegral r `shiftL` 1)) 2+ if k < 100 then pure (o - 1) else f marr (o - 2) q+ | otherwise = do+ A.unsafeWrite marr o (fromIntegral (0x30 + k))+ pure o++--------------------------------------------------------------------------------+-- Utils+--------------------------------------------------------------------------------++maxIntegerDecLen ∷ Integer → Int+maxIntegerDecLen a = case a of+ I.IS i# → maxDecLen (I# i#)+ I.IP n# → maxBitNatDecLen n#+ I.IN n# → 1 + maxBitNatDecLen n#+{-# INLINEABLE maxIntegerDecLen #-}++-- | ceiling (fbs a * logBase 10 2) < ceiling (fbs a * 5 / 16) < 1 + floor (fbs a * 5 / 16)+--+-- We approximate @fbs a@ to @bigNatSize a * word_size@.+maxBitNatDecLen ∷ BN.BigNat# → Int+maxBitNatDecLen n#+ -- This can overflow in theory, but in practice it would overflow for a BigNat#+ -- of at least:+ --+ -- • On 32 bits platform: 6.4 GiB, out of max 4 GiB RAM+ -- → BN.bigNatSize n# = 214748364 =+ -- (maxBound @Int32 - 1) `div` fromIntegral (shiftR (finiteBitSize @Word32 0 * 5) 4)+ -- • On 64 bits platform: 3276 PiB+ -- → BN.bigNatSize n# = 461168601842738790 =+ -- (maxBound @Int64 - 1) `div` fromIntegral (shiftR (finiteBitSize @Word64 0 * 5) 4)+ --+ -- These thresholds are too big to be realistic (32 bits: more than available RAM, 64+ -- bits: integer size in petabytes), so it is perfectly reasonable to have no+ -- special handling of overflow here.++ -- Word bit size is multiple of 16 (e.g. 32 and 64 bits arch)+ | rem (finiteBitSize @Word 0) 16 == 0 =+ 1 + fromIntegral (BN.bigNatSize n# * shiftR (fromIntegral (finiteBitSize @Word 0) * 5) 4)+ -- Other cases (non-standard arch)+ | otherwise =+ 1+ + fromIntegral @Word64+ ( (fromIntegral (BN.bigNatSize n#) * fromIntegral (finiteBitSize @Word 0) * 5)+ `shiftR` 4+ )+{-# INLINEABLE maxBitNatDecLen #-}++integerToBigNat# ∷ Integer → BN.BigNat#+integerToBigNat# n = case I.integerToBigNatSign# n of+ (# _, n# #) → n#+{-# INLINE integerToBigNat# #-}++-- Maximal power of 10 fitting into a 'Word':+-- • 10 ^ 9 for 32 bit words (32 * log 2 / log 10 ≈ 9.63)+-- • 10 ^ 19 for 64 bit words (64 * log 2 / log 10 ≈ 19.27)+--+-- Why (# #)? We can't have top-level unlifted bindings+-- (see: https://gitlab.haskell.org/ghc/ghc/-/issues/17521). So we use a function+-- that take an empty argument (# #) that will be discarded at compile time.+selectPower ∷ (# #) → (# Word#, Word#, BN.BigNat# #)+selectPower _ = case finiteBitSize @Word 0 of+ 64 → (# 19##, 10000000000000000000##, N.naturalToBigNat# tenPower38 #)+ -- Not 64 bits: assume 32 bits+ _ → (# 9##, 1000000000##, N.naturalToBigNat# tenPower18 #)++-- NOTE: ensure to not inline the following numbers, in order to avoid allocations.++tenPower18 ∷ N.Natural+tenPower18 = 1e18+{-# NOINLINE tenPower18 #-}++tenPower38 ∷ N.Natural+tenPower38 = 1e38+{-# NOINLINE tenPower38 #-}++padWithZeros ∷ ∀ s. A.MArray s → Int → Int → ST s ()+padWithZeros marr off count = unsafeReplicate marr off count 0x30+{-# INLINE padWithZeros #-}++--------------------------------------------------------------------------------+-- For testing purpose only+--------------------------------------------------------------------------------++-- data Strategy = SmallOnly | HugeOnly++-- prependUnboundedDecimal ∷ Integral a ⇒ Strategy → a → Buffer ⊸ Buffer+-- prependUnboundedDecimal strategy n buffer = case toInteger n of+-- !n' →+-- prependBounded'+-- (maxIntegerDecLen n')+-- (\dst dstOff → unsafePrependDec' strategy dst dstOff n')+-- buffer++-- unsafePrependDec' ∷ ∀ s. Strategy → A.MArray s → Int → Integer → ST s Int+-- unsafePrependDec' s marr off@(I# off#) n' = case n' of+-- I.IS i# → Bounded.unsafePrependDec marr off (I# i#)+-- _ → unsafePrependBigNatDec' s marr (off# -# 1#) (integerToBigNat# n') >>= prependSign+-- where+-- prependSign !off' =+-- if n' < 0+-- then do+-- A.unsafeWrite marr (off' - 1) 0x2d -- '-'+-- pure (off - off' + 1)+-- else pure (off - off')+-- {-# INLINEABLE unsafePrependDec' #-}++-- unsafePrependBigNatDec' ∷ ∀ s. Strategy → A.MArray s → DigitsWriter s+-- unsafePrependBigNatDec' strategy marr !off0 !n0 = case strategy of+-- SmallOnly → prependSmallNat marr off0 n0+-- HugeOnly → prependHugeNat marr off0 n0
src/Data/Text/Builder/Linear/Double.hs view
@@ -19,7 +19,15 @@ import Data.Text.Builder.Linear.Core --- | Append double.+-- | Append the decimal representation of a 'Double'.+--+-- Matches 'show' in displaying in standard or scientific notation:+--+-- >>> runBuffer (\b -> b |>% 123.456)+-- "123.456"+--+-- >>> runBuffer (\b -> b |>% 1.23e7)+-- "1.23e7" (|>%) ∷ Buffer ⊸ Double → Buffer infixl 6 |>%@@ -29,7 +37,10 @@ (\dst dstOff → unsafeAppendDouble dst dstOff x) buffer --- | Prepend double.+-- | Prepend the decimal representation of a 'Double'.+--+-- Matches 'show' in displaying in standard or scientific notation+-- (see examples in @'(|>%)'@). (%<|) ∷ Double → Buffer ⊸ Buffer infixr 6 %<|
src/Data/Text/Builder/Linear/Hex.hs view
@@ -15,9 +15,10 @@ import Data.Text.Builder.Linear.Core --- | Append the lower-case hexadecimal represensation of a number.+-- | Append the lower-case hexadecimal representation of a /bounded/ integral+-- number. ----- Negative numbers are interpreted as their corresponding unsigned number, e.g.+-- Negative numbers are interpreted as their corresponding unsigned number: -- -- >>> :set -XOverloadedStrings -XLinearTypes -- >>> import Data.Int (Int8, Int16)@@ -35,9 +36,10 @@ buffer {-# INLINEABLE (|>&) #-} --- | Prepend the lower-case hexadecimal representation of a number.+-- | Prepend the lower-case hexadecimal representation of a /bounded/ integral+-- number. ----- Negative numbers are interpreted as their corresponding unsigned number, e.g.+-- Negative numbers are interpreted as their corresponding unsigned number: -- -- >>> :set -XOverloadedStrings -XLinearTypes -- >>> import Data.Int (Int8, Int16)@@ -92,7 +94,7 @@ -- We don't want this behaviour here. -- -- It would suffice to clean the sign bit only once--- instead of doing it on every iteration of unsafe{Ap,Pre}pernHex.go,+-- instead of doing it on every iteration of unsafe{Ap,Pre}pendHex.go, -- but the performance impact is likely negligible. dropNibble ∷ (Integral a, FiniteBits a) ⇒ a → a dropNibble x = case (isSigned x, finiteBitSize x) of
+ src/Data/Text/Builder/Linear/Internal.hs view
@@ -0,0 +1,428 @@+-- |+-- Copyright: (c) 2022 Andrew Lelechenko+-- (c) 2023 Pierre Le Marre+-- Licence: BSD3+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Internal routines for 'Buffer' manipulations.+module Data.Text.Builder.Linear.Internal (+ -- * Type+ Buffer,++ -- * Basic interface+ runBuffer,+ runBufferBS,+ dupBuffer,+ consumeBuffer,+ eraseBuffer,+ byteSizeOfBuffer,+ lengthOfBuffer,+ dropBuffer,+ takeBuffer,+ newEmptyBuffer,++ -- * Text concatenation+ appendBounded,+ appendExact,+ prependBounded,+ prependBounded',+ appendBounded',+ prependExact,+ (><),+) where++import Data.ByteString.Internal (ByteString (..))+import Data.Text qualified as T+import Data.Text.Array qualified as A+import Data.Text.Internal (Text (..))+import GHC.Exts (Int (..), Levity (..), RuntimeRep (..), TYPE, byteArrayContents#, plusAddr#, unsafeCoerce#)+import GHC.ForeignPtr (ForeignPtr (..), ForeignPtrContents (..))+import GHC.ST (ST (..), runST)++import Data.Text.Builder.Linear.Array++-- | Internally 'Buffer' is a mutable buffer.+-- If a client gets hold of a variable of type 'Buffer',+-- they'd be able to pass a mutable buffer to concurrent threads.+-- That's why API below is carefully designed to prevent such possibility:+-- clients always work with linear functions 'Buffer' ⊸ 'Buffer' instead+-- and run them on an empty 'Buffer' to extract results.+--+-- In terms of [@linear-base@](https://hackage.haskell.org/package/linear-base)+-- 'Buffer' is [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)+-- (see 'consumeBuffer')+-- and [@Dupable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Dupable)+-- (see 'dupBuffer'),+-- but not [@Movable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Movable).+--+-- >>> :set -XOverloadedStrings -XLinearTypes+-- >>> import Data.Text.Builder.Linear.Buffer+-- >>> runBuffer (\b -> '!' .<| "foo" <| (b |> "bar" |>. '.'))+-- "!foobar."+--+-- Remember: this is a strict builder, so on contrary to "Data.Text.Lazy.Builder"+-- for optimal performance you should use strict left folds instead of lazy right ones.+--+-- 'Buffer' is an unlifted datatype,+-- so you can put it into an unboxed tuple @(# ..., ... #)@,+-- but not into @(..., ...)@.+data Buffer ∷ TYPE ('BoxedRep 'Unlifted) where+ Buffer ∷ {-# UNPACK #-} !Text → Buffer++-- | Unwrap 'Buffer', no-op.+-- Most likely, this is not the function you're looking for+-- and you need 'runBuffer' instead.+unBuffer ∷ Buffer ⊸ Text+unBuffer (Buffer x) = x++-- | Run a linear function on an empty 'Buffer', producing a strict 'Text'.+--+-- Be careful to write @runBuffer (\\b -> ...)@ instead of @runBuffer $ \\b -> ...@,+-- because current implementation of linear types lacks special support for '($)'.+-- Another option is to enable @{-# LANGUAGE BlockArguments #-}@+-- and write @runBuffer \\b -> ...@.+-- Alternatively, you can import+-- [@($)@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#v:-36-)+-- from [@linear-base@](https://hackage.haskell.org/package/linear-base).+--+-- 'runBuffer' is similar in spirit to mutable arrays API in+-- [@Data.Array.Mutable.Linear@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html),+-- which provides functions like+-- [@fromList@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html#v:fromList) ∷ [@a@] → (@Vector@ @a@ ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) b) ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) @b@.+-- Here the initial buffer is always empty and @b@ is 'Text'. Since 'Text' is+-- [@Movable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Movable),+-- 'Text' and [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) 'Text' are equivalent.+runBuffer ∷ (Buffer ⊸ Buffer) ⊸ Text+runBuffer f = unBuffer (shrinkBuffer (f (Buffer mempty)))+{-# NOINLINE runBuffer #-}++{-+ See https://github.com/Bodigrim/linear-builder/issues/19+ and https://github.com/tweag/linear-base/pull/187#discussion_r489081926+ for the discussion why NOINLINE here and below in 'runBufferBS' is necessary.+ Without it CSE (common subexpression elimination) can pull out 'Buffer's from+ different 'runBuffer's and share them, which is absolutely not what we want.+-}++-- | Same as 'runBuffer', but returning a UTF-8 encoded strict 'ByteString'.+runBufferBS ∷ (Buffer ⊸ Buffer) ⊸ ByteString+runBufferBS f = case shrinkBuffer (f (Buffer memptyPinned)) of+ Buffer (Text (A.ByteArray arr) (I# from) len) → BS fp len+ where+ addr# = byteArrayContents# arr `plusAddr#` from+ fp = ForeignPtr addr# (PlainPtr (unsafeCoerce# arr))+{-# NOINLINE runBufferBS #-}++shrinkBuffer ∷ Buffer ⊸ Buffer+shrinkBuffer (Buffer (Text arr from len)) = Buffer $ runST $ do+ arrM ← unsafeThaw arr+ A.shrinkM arrM (from + len)+ arr' ← A.unsafeFreeze arrM+ pure $ Text arr' from len++memptyPinned ∷ Text+memptyPinned = runST $ do+ marr ← A.newPinned 0+ arr ← A.unsafeFreeze marr+ pure $ Text arr 0 0++-- | Create an empty 'Buffer'.+--+-- The first 'Buffer' is the input and the second is a new empty 'Buffer'.+--+-- This function is needed in some situations, e.g. with+-- 'Data.Text.Builder.Linear.Buffer.justifyRight'. The following example creates+-- a utility function that justify a text and then append it to a buffer.+--+-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples+-- >>> import Data.Text.Builder.Linear.Buffer+-- >>> import Data.Text (Text)+-- >>> :{+-- appendJustified :: Buffer %1 -> Text -> Buffer+-- appendJustified b t = case newEmptyBuffer b of+-- -- Note that we need to create a new buffer from the text, in order+-- -- to justify only the text and not the input buffer.+-- (# b', empty #) -> b' >< justifyRight 12 ' ' (empty |> t)+-- :}+--+-- >>> runBuffer (\b -> (b |> "Test:") `appendJustified` "AAA" `appendJustified` "BBBBBBB")+-- "Test: AAA BBBBBBB"+--+-- Note: a previous buffer is necessary in order to create an empty buffer with+-- the same characteristics.+newEmptyBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)+newEmptyBuffer (Buffer t@(Text arr _ _)) =+ (# Buffer t, Buffer (if isPinned arr then memptyPinned else mempty) #)++-- | Duplicate builder. Feel free to process results in parallel threads.+-- Similar to+-- [@Dupable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Dupable)+-- from [@linear-base@](https://hackage.haskell.org/package/linear-base).+--+-- It is a bit tricky to use because of+-- <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/linear_types.html#limitations current limitations>+-- of linear types with regards to @let@ and @where@. E. g., one cannot write+--+-- > let (# b1, b2 #) = dupBuffer b in ("foo" <| b1) >< (b2 |> "bar")+--+-- Instead write:+--+-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples+-- >>> import Data.Text.Builder.Linear.Buffer+-- >>> runBuffer (\b -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))+-- "foobar"+--+-- Note the unboxed tuple: 'Buffer' is an unlifted datatype,+-- so it cannot be put into @(..., ...)@.+dupBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)+dupBuffer (Buffer x) = (# Buffer x, Buffer (T.copy x) #)++-- | Consume buffer linearly,+-- similar to+-- [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)+-- from [@linear-base@](https://hackage.haskell.org/package/linear-base).+consumeBuffer ∷ Buffer ⊸ ()+consumeBuffer Buffer {} = ()++-- | Erase buffer's content, replacing it with an empty 'Text'.+eraseBuffer ∷ Buffer ⊸ Buffer+eraseBuffer (Buffer (Text arr _ _)) =+ Buffer (if isPinned arr then memptyPinned else mempty)++-- | Return buffer's size in __bytes__ (not in 'Char's).+-- This could be useful to implement a lazy builder atop of a strict one.+byteSizeOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)+byteSizeOfBuffer (Buffer t@(Text _ _ len)) = (# Buffer t, fromIntegral len #)++-- | Return buffer's length in 'Char's (not in bytes).+-- This could be useful to implement @dropEndBuffer@ and @takeEndBuffer@, e. g.,+--+-- @+-- import Data.Unrestricted.Linear+--+-- dropEndBuffer :: Word -> Buffer %1 -> Buffer+-- dropEndBuffer n buf = case lengthOfBuffer buf of+-- (# buf', len #) -> case move len of+-- Ur len' -> takeBuffer (len' - n) buf'+-- @+lengthOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)+lengthOfBuffer (Buffer t) = (# Buffer t, fromIntegral (T.length t) #)++-- | Slice 'Buffer' by dropping given number of 'Char's.+dropBuffer ∷ Word → Buffer ⊸ Buffer+dropBuffer nChar (Buffer t@(Text arr off len))+ | nByte <= 0 = Buffer (Text arr (off + len) 0)+ | otherwise = Buffer (Text arr (off + nByte) (len - nByte))+ where+ nByte = T.measureOff (fromIntegral nChar) t++-- | Slice 'Buffer' by taking given number of 'Char's.+takeBuffer ∷ Word → Buffer ⊸ Buffer+takeBuffer nChar (Buffer t@(Text arr off _))+ | nByte <= 0 = Buffer t+ | otherwise = Buffer (Text arr off nByte)+ where+ nByte = T.measureOff (fromIntegral nChar) t++-- | Low-level routine to append data of unknown size to a 'Buffer'.+appendBounded+ ∷ Int+ -- ^ Upper bound for the number of bytes, written by an action+ → (∀ s. A.MArray s → Int → ST s Int)+ -- ^ Action, which writes bytes __starting__ from the given offset+ -- and returns an actual number of bytes written.+ → Buffer+ ⊸ Buffer+appendBounded maxSrcLen appender (Buffer (Text dst dstOff dstLen)) = Buffer $ runST $ do+ let dstFullLen = sizeofByteArray dst+ newFullLen = dstOff + 2 * (dstLen + maxSrcLen)+ newM ←+ if dstOff + dstLen + maxSrcLen <= dstFullLen+ then unsafeThaw dst+ else do+ tmpM ← (if isPinned dst then A.newPinned else A.new) newFullLen+ A.copyI dstLen tmpM dstOff dst dstOff+ pure tmpM+ srcLen ← appender newM (dstOff + dstLen)+ new ← A.unsafeFreeze newM+ pure $ Text new dstOff (dstLen + srcLen)+{-# INLINE appendBounded #-}++-- | Low-level routine to append data of unknown size to a 'Buffer', giving+-- the action the choice between two strategies.+--+-- See also: 'appendBounded'.+--+-- @since 0.1.3+appendBounded'+ ∷ Int+ -- ^ Upper bound for the number of bytes, written by an action+ → (∀ s x. ((A.MArray s → Int → ST s Int) → ST s x) → ((A.MArray s → Int → ST s Int) → ST s x) → ST s x)+ -- ^ Action, which appends bytes using one of the following strategies:+ --+ -- * writes bytes __starting__ from the given offset, using its first argument,+ -- * writes bytes __finishing__ before the given offset, using its second argument.+ --+ -- The function passed to either argument returns the actual number of bytes written.+ → Buffer+ ⊸ Buffer+appendBounded' maxSrcLen writer (Buffer (Text dst dstOff dstLen)) = Buffer $ runST $ do+ let dstFullLen = sizeofByteArray dst+ newFullLen = dstOff + 2 * (dstLen + maxSrcLen)+ newM ←+ if dstOff + dstLen + maxSrcLen <= dstFullLen+ then unsafeThaw dst+ else do+ tmpM ← (if isPinned dst then A.newPinned else A.new) newFullLen+ A.copyI dstLen tmpM dstOff dst dstOff+ pure tmpM+ let append = \appender → do+ count ← appender newM (dstOff + dstLen)+ pure (dstOff, count)+ -- Action that prepends then copies the result to the final destination, if necessary+ let prepend = \prepender → case dstLen of+ 0 → do+ -- Buffer is empty: prepend to final destination+ count ← prepender newM maxSrcLen+ pure (maxSrcLen - count, count)+ _ → do+ -- Require extra buffer + copy to final destination+ let off'+ -- Reuse space before current data (no overlap)+ | dstOff >= maxSrcLen = dstOff+ -- Reuse space after current data (overlap)+ | otherwise = dstOff + dstLen + maxSrcLen+ count ← prepender newM off'+ -- Note: we rely on copyM allowing overlaps+ A.copyM newM (dstOff + dstLen) newM (off' - count) count+ pure (dstOff, count)+ !(dstOff', srcLen) ← writer append prepend+ new ← A.unsafeFreeze newM+ pure $ Text new dstOff' (dstLen + srcLen)+{-# INLINE appendBounded' #-}++-- | Low-level routine to append data of known size to a 'Buffer'.+appendExact+ ∷ Int+ -- ^ Exact number of bytes, written by an action+ → (∀ s. A.MArray s → Int → ST s ())+ -- ^ Action, which writes bytes __starting__ from the given offset+ → Buffer+ ⊸ Buffer+appendExact srcLen appender =+ appendBounded+ srcLen+ (\dst dstOff → appender dst dstOff >> pure srcLen)+{-# INLINE appendExact #-}++-- | Low-level routine to prepend data of unknown size to a 'Buffer'.+prependBounded+ ∷ Int+ -- ^ Upper bound for the number of bytes, written by an action+ → (∀ s. A.MArray s → Int → ST s Int)+ -- ^ Action, which writes bytes __finishing__ before the given offset+ -- and returns an actual number of bytes written.+ → (∀ s. A.MArray s → Int → ST s Int)+ -- ^ Action, which writes bytes __starting__ from the given offset+ -- and returns an actual number of bytes written.+ → Buffer+ ⊸ Buffer+prependBounded maxSrcLen prepender appender (Buffer (Text dst dstOff dstLen))+ | maxSrcLen <= dstOff = Buffer $ runST $ do+ newM ← unsafeThaw dst+ srcLen ← prepender newM dstOff+ new ← A.unsafeFreeze newM+ pure $ Text new (dstOff - srcLen) (srcLen + dstLen)+ | otherwise = Buffer $ runST $ do+ let dstFullLen = sizeofByteArray dst+ newOff = dstLen + maxSrcLen+ newFullLen = 2 * newOff + (dstFullLen - dstOff - dstLen)+ newM ← (if isPinned dst then A.newPinned else A.new) newFullLen+ srcLen ← appender newM newOff+ A.copyI dstLen newM (newOff + srcLen) dst dstOff+ new ← A.unsafeFreeze newM+ pure $ Text new newOff (dstLen + srcLen)+{-# INLINE prependBounded #-}++-- | Low-level routine to prepend data of unknown size to a 'Buffer'.+--+-- Contrary to 'prependBounded', only use a prepend action.+--+-- @since 0.1.3+prependBounded'+ ∷ Int+ -- ^ Upper bound for the number of bytes, written by an action+ → (∀ s. A.MArray s → Int → ST s Int)+ -- ^ Action, which writes bytes __finishing__ before the given offset+ -- and returns an actual number of bytes written.+ → Buffer+ ⊸ Buffer+prependBounded' maxSrcLen prepender (Buffer (Text dst dstOff dstLen))+ | maxSrcLen <= dstOff = Buffer $ runST $ do+ newM ← unsafeThaw dst+ srcLen ← prepender newM dstOff+ new ← A.unsafeFreeze newM+ pure $ Text new (dstOff - srcLen) (srcLen + dstLen)+ | otherwise = Buffer $ runST $ do+ let dstFullLen = sizeofByteArray dst+ off = dstLen + 2 * maxSrcLen+ newFullLen = off + (dstFullLen - dstOff)+ newM ← (if isPinned dst then A.newPinned else A.new) newFullLen+ srcLen ← prepender newM off+ A.copyI dstLen newM off dst dstOff+ new ← A.unsafeFreeze newM+ pure $ Text new (off - srcLen) (dstLen + srcLen)+{-# INLINE prependBounded' #-}++-- | Low-level routine to append data of known size to a 'Buffer'.+prependExact+ ∷ Int+ -- ^ Exact number of bytes, written by an action+ → (∀ s. A.MArray s → Int → ST s ())+ -- ^ Action, which writes bytes __starting__ from the given offset+ → Buffer+ ⊸ Buffer+prependExact srcLen appender =+ prependBounded+ srcLen+ (\dst dstOff → appender dst (dstOff - srcLen) >> pure srcLen)+ (\dst dstOff → appender dst dstOff >> pure srcLen)+{-# INLINE prependExact #-}++-- | Concatenate two 'Buffer's, potentially mutating both of them.+--+-- You likely need to use 'dupBuffer' to get hold on two builders at once:+--+-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples+-- >>> import Data.Text.Builder.Linear.Buffer+-- >>> runBuffer (\b -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))+-- "foobar"+(><) ∷ Buffer ⊸ Buffer ⊸ Buffer++infix 6 ><+Buffer (Text left leftOff leftLen) >< Buffer (Text right rightOff rightLen) = Buffer $ runST $ do+ let leftFullLen = sizeofByteArray left+ rightFullLen = sizeofByteArray right+ canCopyToLeft = leftOff + leftLen + rightLen <= leftFullLen+ canCopyToRight = leftLen <= rightOff+ shouldCopyToLeft = canCopyToLeft && (not canCopyToRight || leftLen >= rightLen)+ if shouldCopyToLeft+ then do+ newM ← unsafeThaw left+ A.copyI rightLen newM (leftOff + leftLen) right rightOff+ new ← A.unsafeFreeze newM+ pure $ Text new leftOff (leftLen + rightLen)+ else+ if canCopyToRight+ then do+ newM ← unsafeThaw right+ A.copyI leftLen newM (rightOff - leftLen) left leftOff+ new ← A.unsafeFreeze newM+ pure $ Text new (rightOff - leftLen) (leftLen + rightLen)+ else do+ let fullLen = leftOff + leftLen + rightLen + (rightFullLen - rightOff - rightLen)+ newM ← (if isPinned left || isPinned right then A.newPinned else A.new) fullLen+ A.copyI leftLen newM leftOff left leftOff+ A.copyI rightLen newM (leftOff + leftLen) right rightOff+ new ← A.unsafeFreeze newM+ pure $ Text new leftOff (leftLen + rightLen)
test/Main.hs view
@@ -71,6 +71,8 @@ | PrependDecI Int | AppendDecI30 (IntN 30) | PrependDecI30 (IntN 30)+ | AppendDecInteger Integer+ | PrependDecInteger Integer | AppendDouble Double | PrependDouble Double | AppendSpaces Word@@ -98,6 +100,8 @@ , PrependDecI <$> arbitraryBoundedIntegral , AppendDecI30 <$> arbitraryBoundedIntegral , PrependDecI30 <$> arbitraryBoundedIntegral+ , AppendDecInteger <$> arbitraryInteger+ , PrependDecInteger <$> arbitraryInteger , pure $ HexWord minBound minBound minBound minBound , pure $ HexWord maxBound maxBound maxBound maxBound , pure $ HexInt minBound minBound minBound minBound minBound minBound minBound@@ -116,6 +120,9 @@ where arbitraryCharCount = chooseBoundedIntegral (0, 6) arbitraryTotalLength = chooseBoundedIntegral (3, 20)+ arbitraryInteger = chooseInteger + ( fromIntegral @Int minBound ^ (3 :: Word)+ , fromIntegral @Int maxBound ^ (3 :: Word) ) shrink = genericShrink @@ -165,6 +172,8 @@ go b (PrependDecI x) = toStrict (toLazyText (decimal x)) <> b go b (AppendDecI30 x) = b <> toStrict (toLazyText (decimal x)) go b (PrependDecI30 x) = toStrict (toLazyText (decimal x)) <> b+ go b (AppendDecInteger x) = b <> toStrict (toLazyText (decimal x))+ go b (PrependDecInteger x) = toStrict (toLazyText (decimal x)) <> b go b (AppendDouble x) = b <> toStrict (toLazyText (realFloat x)) go b (PrependDouble x) = toStrict (toLazyText (realFloat x)) <> b go b (AppendSpaces n) = b <> T.replicate (fromIntegral n) (T.singleton ' ')@@ -216,6 +225,8 @@ go b (PrependDecI x) = x $<| b go b (AppendDecI30 x) = b |>$ x go b (PrependDecI30 x) = x $<| b+ go b (AppendDecInteger x) = b |>$$ x+ go b (PrependDecInteger x) = x $$<| b go b (AppendDouble x) = b |>% x go b (PrependDouble x) = x %<| b go b (AppendSpaces n) = b |>… n@@ -230,6 +241,7 @@ , testProperty "bytestring builder" prop5 , testProperty "CSE 1" prop6 , testProperty "CSE 2" prop7+ , testProperty "unbounded integers" prop8 ] prop1 ∷ [Action] → Property@@ -274,6 +286,34 @@ !y = runBuffer (\buf -> (buf |>. '_' |>. 'b') |>… 5) in (x, y) === (T.pack "_a ", T.pack "_b ") +prop8 ∷ Property+prop8 =+ conjoin+ [ check 0+ , check 1e18+ , check 1e19+ , check 1e20+ , check 1e50+ , check 1e100+ , check (10 ^ (400 ∷ Word))+ , check (10 ^ (600 ∷ Word))+ , check (10 ^ (1000 ∷ Word))+ , check (toInteger @Word maxBound)+ , check (toInteger @Word maxBound + 1)+ , check (negate (toInteger @Word maxBound))+ , check (negate (toInteger @Word maxBound + 1))+ , check (toInteger @Word maxBound ^ (2 ∷ Word))+ , check (toInteger @Word maxBound ^ (20 ∷ Word))+ , check (toInteger @Word maxBound ^ (40 ∷ Word))+ ]+ where+ check ∷ Integer → Property+ check i =+ decimalText i === runBuffer (i $$<|)+ .&&.+ decimalText i === runBuffer (|>$$ i)++ decimalText = toStrict . toLazyText . decimal -------------------------------------------------------------------------------- -- IntN --------------------------------------------------------------------------------
text-builder-linear.cabal view
@@ -1,12 +1,12 @@ cabal-version: 2.4 name: text-builder-linear-version: 0.1.2+version: 0.1.3 license: BSD-3-Clause license-file: LICENSE copyright: 2022 Andrew Lelechenko maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> author: Andrew Lelechenko-tested-with: ghc ==9.2.8 ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1+tested-with: ghc ==9.2.8 ghc ==9.4.8 ghc ==9.6.6 ghc ==9.8.2 ghc ==9.10.1 homepage: https://github.com/Bodigrim/linear-builder synopsis: Builder for Text and ByteString based on linear types description:@@ -32,9 +32,11 @@ other-modules: Data.Text.Builder.Linear.Array Data.Text.Builder.Linear.Char- Data.Text.Builder.Linear.Dec+ Data.Text.Builder.Linear.Dec.Bounded+ Data.Text.Builder.Linear.Dec.Unbounded Data.Text.Builder.Linear.Double Data.Text.Builder.Linear.Hex+ Data.Text.Builder.Linear.Internal default-language: GHC2021 default-extensions:@@ -46,6 +48,7 @@ base >=4.16 && <5, text >=2.0 && <2.2, bytestring >=0.11 && <0.13,+ ghc-bignum >=1.1 && < 2.0, quote-quot >=0.2.1 && <0.3 test-suite linear-builder-tests@@ -54,7 +57,7 @@ hs-source-dirs: test default-language: GHC2021 default-extensions:- DerivingStrategies LinearTypes MagicHash PatternSynonyms+ DerivingStrategies LinearTypes MagicHash NumDecimals PatternSynonyms UnboxedTuples UnicodeSyntax ghc-options:@@ -65,7 +68,7 @@ text, text-builder-linear, tasty >=1.4 && <1.6,- tasty-quickcheck >=0.10 && <0.11+ tasty-quickcheck >=0.10 && <0.12 benchmark linear-builder-bench type: exitcode-stdio-1.0@@ -74,6 +77,7 @@ other-modules: BenchChar BenchDecimal+ BenchDecimalUnbounded BenchDouble BenchHexadecimal BenchText@@ -89,7 +93,7 @@ -- NOTE: The following packages are optional, but are not required that -- often. While they could be guarded by a flag, we prefer keeping -- the Hackage page simple. Just uncomment these lines when needed.- -- bytestring-strict-builder >= 0.4.5 && < 0.5+ -- bytestring-strict-builder >= 0.4.5 && < 0.5, -- text-builder >= 0.6.7 && < 0.7, tasty,- tasty-bench >=0.3.2 && <0.4+ tasty-bench >=0.4 && <0.5