diff --git a/bench/BenchDecimal.hs b/bench/BenchDecimal.hs --- a/bench/BenchDecimal.hs +++ b/bench/BenchDecimal.hs @@ -2,17 +2,16 @@ -- Copyright: (c) 2022 Andrew Lelechenko -- Licence: BSD3 -- Maintainer: Andrew Lelechenko - 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 + ] diff --git a/bench/BenchDecimalUnbounded.hs b/bench/BenchDecimalUnbounded.hs new file mode 100644 --- /dev/null +++ b/bench/BenchDecimalUnbounded.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE NumDecimals #-} + +-- | +-- Copyright: (c) 2022 Andrew Lelechenko +-- Licence: BSD3 +-- Maintainer: Andrew Lelechenko +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] diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -2,7 +2,6 @@ -- Copyright: (c) 2022 Andrew Lelechenko -- Licence: BSD3 -- Maintainer: Andrew Lelechenko - 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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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` diff --git a/src/Data/Text/Builder/Linear.hs b/src/Data/Text/Builder/Linear.hs --- a/src/Data/Text/Builder/Linear.hs +++ b/src/Data/Text/Builder/Linear.hs @@ -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. -- diff --git a/src/Data/Text/Builder/Linear/Buffer.hs b/src/Data/Text/Builder/Linear/Buffer.hs --- a/src/Data/Text/Builder/Linear/Buffer.hs +++ b/src/Data/Text/Builder/Linear/Buffer.hs @@ -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)” +-- “” -- 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). diff --git a/src/Data/Text/Builder/Linear/Char.hs b/src/Data/Text/Builder/Linear/Char.hs --- a/src/Data/Text/Builder/Linear/Char.hs +++ b/src/Data/Text/Builder/Linear/Char.hs @@ -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 #) → diff --git a/src/Data/Text/Builder/Linear/Core.hs b/src/Data/Text/Builder/Linear/Core.hs --- a/src/Data/Text/Builder/Linear/Core.hs +++ b/src/Data/Text/Builder/Linear/Core.hs @@ -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 --- --- 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 diff --git a/src/Data/Text/Builder/Linear/Dec.hs b/src/Data/Text/Builder/Linear/Dec.hs deleted file mode 100644 --- a/src/Data/Text/Builder/Linear/Dec.hs +++ /dev/null @@ -1,172 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} - --- | --- Copyright: (c) 2022 Andrew Lelechenko --- Licence: BSD3 --- Maintainer: Andrew Lelechenko -#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 #-} diff --git a/src/Data/Text/Builder/Linear/Dec/Bounded.hs b/src/Data/Text/Builder/Linear/Dec/Bounded.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Builder/Linear/Dec/Bounded.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Copyright: (c) 2022 Andrew Lelechenko +-- Licence: BSD3 +-- Maintainer: Andrew Lelechenko +#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 #-} diff --git a/src/Data/Text/Builder/Linear/Dec/Unbounded.hs b/src/Data/Text/Builder/Linear/Dec/Unbounded.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Builder/Linear/Dec/Unbounded.hs @@ -0,0 +1,314 @@ +-- | +-- Copyright: (c) 2024 Pierre Le Marre +-- Licence: BSD3 +-- Maintainer: Andrew Lelechenko +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 diff --git a/src/Data/Text/Builder/Linear/Double.hs b/src/Data/Text/Builder/Linear/Double.hs --- a/src/Data/Text/Builder/Linear/Double.hs +++ b/src/Data/Text/Builder/Linear/Double.hs @@ -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 %<| diff --git a/src/Data/Text/Builder/Linear/Hex.hs b/src/Data/Text/Builder/Linear/Hex.hs --- a/src/Data/Text/Builder/Linear/Hex.hs +++ b/src/Data/Text/Builder/Linear/Hex.hs @@ -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 diff --git a/src/Data/Text/Builder/Linear/Internal.hs b/src/Data/Text/Builder/Linear/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Builder/Linear/Internal.hs @@ -0,0 +1,428 @@ +-- | +-- Copyright: (c) 2022 Andrew Lelechenko +-- (c) 2023 Pierre Le Marre +-- Licence: BSD3 +-- Maintainer: Andrew Lelechenko +-- +-- 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 +-- +-- 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) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 -------------------------------------------------------------------------------- diff --git a/text-builder-linear.cabal b/text-builder-linear.cabal --- a/text-builder-linear.cabal +++ b/text-builder-linear.cabal @@ -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 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