scientific-notation 0.1.6.0 → 0.1.7.0

raw patch · 6 files changed

Files

• CHANGELOG.md +10/−2
• Setup.hs +0/−2
• bench/Main.hs +165/−132
• scientific-notation.cabal +58/−50
• src/Data/Number/Scientific.hs +1408/−1220
• test/Main.hs +266/−248

@@ -1,7 +1,15 @@ # Revision history for scientific-notation -## 0.1.6.0 -- 2023-??-??O+## 0.1.7.0 -- 2024-02-12 +* Add `toInteger`.++## 0.1.6.1 -- 2024-02-06++* Update package metadata.++## 0.1.6.0 -- 2023-06-27+ * Support GHC 9.4 and 9.6. Drop support for GHCs older than 9.4. * Add `fromInt` and `fromInt(8|16|32|64)`. @@ -38,4 +46,4 @@  ## 0.1.0.0 -- 2019-09-24 -* First version. Released on an unsuspecting world.+* First version.

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,189 +1,222 @@-{-# language BangPatterns #-}-{-# language PackageImports #-}-{-# language MagicHash #-}-{-# language ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-} -import Gauge (bgroup,bench,whnf)-import Gauge.Main (defaultMain)-import Data.ByteString.Internal (ByteString(PS))-import Data.Primitive (SmallArray,PrimArray,ByteArray(..))-import Data.Word (Word16) import Control.Monad.ST (runST) import Control.Monad.ST.Run (runPrimArrayST)-import GHC.ForeignPtr (ForeignPtrContents(PlainPtr))-import GHC.ForeignPtr (ForeignPtr(ForeignPtr))+import Data.ByteString.Internal (ByteString (PS))+import Data.Primitive (ByteArray (..), PrimArray, SmallArray)+import Data.Word (Word16)+import GHC.ForeignPtr (ForeignPtr (ForeignPtr), ForeignPtrContents (PlainPtr))+import Gauge (bench, bgroup, whnf)+import Gauge.Main (defaultMain) -import qualified GHC.Exts as Exts+import qualified Data.Aeson.Parser as Aeson+import qualified Data.Attoparsec.ByteString.Char8 as Atto import qualified Data.Bytes as Bytes import qualified Data.Bytes.Parser as P import qualified Data.Bytes.Parser.Latin as Latin+import qualified Data.Bytes.Text.Ascii as Ascii import qualified Data.Primitive as PM-import qualified Data.Attoparsec.ByteString.Char8 as Atto-import qualified Data.Aeson.Parser as Aeson+import qualified GHC.Exts as Exts -import qualified "scientific" Data.Scientific as SlowSci-import qualified "scientific-notation" Data.Number.Scientific as SCI+import qualified Data.Number.Scientific as SCI+import qualified Data.Scientific as SlowSci  main :: IO ()-main = defaultMain-  [ bgroup "scientific-notation"-    [ bgroup "parser"-      [ bench "ten-small"-          (whnf (\b -> P.parseByteArray decodeTen b) tenSmall)-      , bench "ten-large"-          (whnf (\b -> P.parseByteArray decodeTen b) tenLarge)-      ]-    , bgroup "conversion"-      [ bench "twenty-word16"-        (whnf (\b -> convertArray16 b) twentyFastSci)-      ]-    ]-  , bgroup "scientific"-    [ bgroup "parser"-      [ bench "ten-small" $ whnf-        (\b -> Atto.parseOnly-          (aesonDecodeN 10 []) (fromPinned b)-        ) tenSmall-      , bench "ten-large" $ whnf-        (\b -> Atto.parseOnly-          (aesonDecodeN 10 []) (fromPinned b)-        ) tenLarge-      ]-    , bgroup "conversion"-      [ bench "twenty-word16"-        (whnf (\b -> convertSlowArray16 b) twentySlowSci)-      ]+main =+  defaultMain+    [ bgroup+        "scientific-notation"+        [ bgroup+            "parser"+            [ bench+                "ten-small"+                (whnf (\b -> P.parseByteArray decodeTen b) tenSmall)+            , bench+                "ten-large"+                (whnf (\b -> P.parseByteArray decodeTen b) tenLarge)+            ]+        , bgroup+            "conversion"+            [ bench+                "twenty-word16"+                (whnf (\b -> convertArray16 b) twentyFastSci)+            ]+        ]+    , bgroup+        "scientific"+        [ bgroup+            "parser"+            [ bench "ten-small" $+                whnf+                  ( \b ->+                      Atto.parseOnly+                        (aesonDecodeN 10 [])+                        (fromPinned b)+                  )+                  tenSmall+            , bench "ten-large" $+                whnf+                  ( \b ->+                      Atto.parseOnly+                        (aesonDecodeN 10 [])+                        (fromPinned b)+                  )+                  tenLarge+            ]+        , bgroup+            "conversion"+            [ bench+                "twenty-word16"+                (whnf (\b -> convertSlowArray16 b) twentySlowSci)+            ]+        ]     ]-  ]  -- TODO: In the test suite, we should confirm that parsing this -- actually succeeds. We intentionally avoid leading plus signs -- here so that we can compare against aeson. tenSmall :: ByteArray-tenSmall = pin $ Bytes.toByteArray $ Bytes.fromAsciiString $ concat-  [ ",4256"-  , ",-125e14"-  , ",5.000006"-  , ",1e100"-  , ",-13.25E-100"-  , ",-653467618"-  , ",-17e+6"-  , ",9999.001"-  , ",0000.002"-  , ",0000.002E1"-  ]+tenSmall =+  pin $+    Bytes.toByteArray $+      Ascii.fromString $+        concat+          [ ",4256"+          , ",-125e14"+          , ",5.000006"+          , ",1e100"+          , ",-13.25E-100"+          , ",-653467618"+          , ",-17e+6"+          , ",9999.001"+          , ",0000.002"+          , ",0000.002E1"+          ]  -- TODO: In the test suite, we should confirm that parsing this -- actually succeeds. We intentionally avoid leading plus signs -- here so that we can compare against aeson. tenLarge :: ByteArray-tenLarge = pin $ Bytes.toByteArray $ Bytes.fromAsciiString $ concat-  [ ",4221465241250205246754620201240240201451991999956"-  , ",242422432499393113113131313131533753.02031243210e13432"-  , ",-0.999999999999999999999999999999999999"-  , ",4.46246246526345643246256423645246224e100"-  , ",42463523462.46246243246256423645246224E24625"-  , ",-82463523462.56246243246256423645246224e-24625"-  , ",82463523462.56246243246256423645246224e+24625"-  , ",-201.562462432462564236452462240240420"-  , ",-0.777777777777777777777777777777777e-777"-  , ",0.987777777777777777777777777777777e-42"-  ]-+tenLarge =+  pin $+    Bytes.toByteArray $+      Ascii.fromString $+        concat+          [ ",4221465241250205246754620201240240201451991999956"+          , ",242422432499393113113131313131533753.02031243210e13432"+          , ",-0.999999999999999999999999999999999999"+          , ",4.46246246526345643246256423645246224e100"+          , ",42463523462.46246243246256423645246224E24625"+          , ",-82463523462.56246243246256423645246224e-24625"+          , ",82463523462.56246243246256423645246224e+24625"+          , ",-201.562462432462564236452462240240420"+          , ",-0.777777777777777777777777777777777e-777"+          , ",0.987777777777777777777777777777777e-42"+          ]  -- All of these can fit inside a Word16.-twentyPairs :: SmallArray (Int,Int)-twentyPairs = Exts.fromList-  [ (2336,0)-  , (43265,0)-  , (17,0)-  , (24,3)-  , (1,4)-  , (25,0)-  , (0,0)-  , (1900,0)-  , (65,0)-  , (1100,0)-  , (5,3)-  , (0,0)-  , (1600,0)-  , (1500,0)-  , (2000,0)-  , (62,2)-  , (500,0)-  , (670,0)-  , (1100,0)-  , (65500,0)-  ]+twentyPairs :: SmallArray (Int, Int)+twentyPairs =+  Exts.fromList+    [ (2336, 0)+    , (43265, 0)+    , (17, 0)+    , (24, 3)+    , (1, 4)+    , (25, 0)+    , (0, 0)+    , (1900, 0)+    , (65, 0)+    , (1100, 0)+    , (5, 3)+    , (0, 0)+    , (1600, 0)+    , (1500, 0)+    , (2000, 0)+    , (62, 2)+    , (500, 0)+    , (670, 0)+    , (1100, 0)+    , (65500, 0)+    ]  twentyFastSci :: SmallArray SCI.Scientific twentyFastSci = fmap (uncurry SCI.small) twentyPairs  twentySlowSci :: SmallArray SlowSci.Scientific-twentySlowSci = fmap-  (\(x,y) -> SlowSci.scientific (fromIntegral x) y)-  twentyPairs+twentySlowSci =+  fmap+    (\(x, y) -> SlowSci.scientific (fromIntegral x) y)+    twentyPairs  aesonDecodeN :: Int -> [SlowSci.Scientific] -> Atto.Parser [SlowSci.Scientific]-aesonDecodeN !ix !acc = if ix > 0-  then do-    _ <- Atto.char ','-    !num <- Aeson.scientific-    aesonDecodeN (ix - 1) (num : acc)-  else pure acc+aesonDecodeN !ix !acc =+  if ix > 0+    then do+      _ <- Atto.char ','+      !num <- Aeson.scientific+      aesonDecodeN (ix - 1) (num : acc)+    else pure acc  decodeTen :: P.Parser () s (SmallArray SCI.Scientific) decodeTen = do   arr <- P.effect (PM.newSmallArray 10 errorThunk)-  let go !ix = if ix >= 0-        then do-          Latin.char () ',' -          !num <- SCI.parserSignedUtf8Bytes ()-          P.effect (PM.writeSmallArray arr ix num)-          go (ix - 1)-        else P.effect (PM.unsafeFreezeSmallArray arr)+  let go !ix =+        if ix >= 0+          then do+            Latin.char () ','+            !num <- SCI.parserSignedUtf8Bytes ()+            P.effect (PM.writeSmallArray arr ix num)+            go (ix - 1)+          else P.effect (PM.unsafeFreezeSmallArray arr)   go 9  convertArray16 ::-     SmallArray SCI.Scientific-  -> PrimArray Word16+  SmallArray SCI.Scientific ->+  PrimArray Word16 convertArray16 xs = runPrimArrayST $ do   let len = PM.sizeofSmallArray xs   ws <- PM.newPrimArray len-  let go !ix = if ix >= 0-        then case SCI.toWord16 (PM.indexSmallArray xs ix) of-          Nothing -> error "convertArray16: bad number"-          Just (r :: Word16) -> do-            PM.writePrimArray ws ix r-            go (ix - 1)-        else PM.unsafeFreezePrimArray ws+  let go !ix =+        if ix >= 0+          then case SCI.toWord16 (PM.indexSmallArray xs ix) of+            Nothing -> error "convertArray16: bad number"+            Just (r :: Word16) -> do+              PM.writePrimArray ws ix r+              go (ix - 1)+          else PM.unsafeFreezePrimArray ws   go (len - 1)  convertSlowArray16 ::-     SmallArray SlowSci.Scientific-  -> PrimArray Word16+  SmallArray SlowSci.Scientific ->+  PrimArray Word16 convertSlowArray16 xs = runPrimArrayST $ do   let len = PM.sizeofSmallArray xs   ws <- PM.newPrimArray len-  let go !ix = if ix >= 0-        then case SlowSci.toBoundedInteger (PM.indexSmallArray xs ix) of-          Nothing -> error "convertArray16: bad number"-          Just (r :: Word16) -> do-            PM.writePrimArray ws ix r-            go (ix - 1)-        else PM.unsafeFreezePrimArray ws+  let go !ix =+        if ix >= 0+          then case SlowSci.toBoundedInteger (PM.indexSmallArray xs ix) of+            Nothing -> error "convertArray16: bad number"+            Just (r :: Word16) -> do+              PM.writePrimArray ws ix r+              go (ix - 1)+          else PM.unsafeFreezePrimArray ws   go (len - 1)  errorThunk :: a-{-# noinline errorThunk #-}+{-# NOINLINE errorThunk #-} errorThunk = error "scientific:benchmark error"  -- Convert a pinned immutable byte array to a bytestring. fromPinned :: ByteArray -> ByteString-{-# inline fromPinned #-}-fromPinned (ByteArray arr# ) = PS-  (ForeignPtr (Exts.byteArrayContents# arr# ) (PlainPtr (Exts.unsafeCoerce# arr#)))-  0 (Exts.I# (Exts.sizeofByteArray# arr# ))+{-# INLINE fromPinned #-}+fromPinned (ByteArray arr#) =+  PS+    (ForeignPtr (Exts.byteArrayContents# arr#) (PlainPtr (Exts.unsafeCoerce# arr#)))+    0+    (Exts.I# (Exts.sizeofByteArray# arr#))  pin :: ByteArray -> ByteArray pin src = runST $ do

@@ -1,7 +1,7 @@-cabal-version: 2.2-name: scientific-notation-version: 0.1.6.0-synopsis: Scientific notation intended for tokenization+cabal-version:   2.4+name:            scientific-notation+version:         0.1.7.0+synopsis:        Scientific notation intended for tokenization description:   This library provides a type used to represent a number in   scientific notation. This is most frequently useful when@@ -31,70 +31,78 @@   `scientific` in the following ways:   .   * Correctness: `scientific` does not correctly handle large exponents. See-    <https://github.com/basvandijk/scientific/issues/62 issue #62>.+  <https://github.com/basvandijk/scientific/issues/62 issue #62>.   .   * Parsing: The `scientific-notation` parser outperforms the `scientific`-    parser that ships with `aeson` by a factor of five on small numbers.-homepage: https://github.com/andrewthad/scientific-notation-bug-reports: https://github.com/andrewthad/scientific-notation/issues-license: BSD-3-Clause-license-file: LICENSE-author: Andrew Martin-maintainer: andrew.thaddeus@gmail.com-copyright: 2019 Andrew Martin-category: Data-extra-source-files: CHANGELOG.md+  parser that ships with `aeson` by a factor of five on small numbers. +homepage:        https://github.com/byteverse/scientific-notation+bug-reports:     https://github.com/byteverse/scientific-notation/issues+license:         BSD-3-Clause+license-file:    LICENSE+author:          Andrew Martin+maintainer:      amartin@layer3com.com+copyright:       2019 Andrew Martin+category:        Data+extra-doc-files: CHANGELOG.md+tested-with:     GHC ==9.4.8 || ==9.6.3 || ==9.8.1++common build-settings+  default-language: Haskell2010+  ghc-options:      -Wall -Wunused-packages+ library+  import:          build-settings   exposed-modules: Data.Number.Scientific   build-depends:-    , base >=4.17.1 && <5-    , bytebuild >=0.3.5 && <0.4-    , bytesmith >=0.3 && <0.4-    , byteslice >=0.2.6 && <0.3-    , natural-arithmetic >=0.1.1 && <0.3-    , text-short >=0.1.3-    , primitive >=0.7.1-    , bytestring >=0.10.12-    , word-compat >= 0.0.2-  hs-source-dirs: src-  ghc-options: -O2 -Wall-  default-language: Haskell2010+    , base                >=4.17.1  && <5+    , bytebuild           >=0.3.5   && <0.4+    , byteslice           >=0.2.6   && <0.3+    , bytesmith           >=0.3     && <0.4+    , bytestring          >=0.10.12+    , natural-arithmetic  >=0.1.1   && <0.3+    , primitive           >=0.7.1+    , text-short          >=0.1.3+    , word-compat         >=0.0.2 +  hs-source-dirs:  src+  ghc-options:     -O2+ test-suite test-  default-language: Haskell2010-  type: exitcode-stdio-1.0+  import:         build-settings+  type:           exitcode-stdio-1.0   hs-source-dirs: test-  main-is: Main.hs-  ghc-options: -Wall -O2+  main-is:        Main.hs   build-depends:-    , QuickCheck >=2.13.1-    , base >=4.12.0.0 && <5-    , bytebuild+    , base                 >=4.12.0.0 && <5     , byteslice-    , bytestring+    , bytesmith+    , primitive     , scientific-notation-    , tasty >=1.2.3-    , tasty-hunit >=0.10.0.2+    , tasty                >=1.2.3+    , tasty-hunit          >=0.10.0.2     , tasty-quickcheck-    , primitive-    , bytesmith  benchmark bench-  type: exitcode-stdio-1.0+  import:         build-settings+  type:           exitcode-stdio-1.0   build-depends:+    , attoparsec+    , attoparsec-aeson     , base-    , gauge >= 0.2.4-    , byteslice >= 0.1.2-    , scientific-notation-    , primitive+    , byteslice            >=0.1.2     , bytesmith-    , aeson-    , attoparsec     , bytestring-    , scientific+    , gauge                >=0.2.4+    , primitive     , run-st-  ghc-options: -Wall -O2-  default-language: Haskell2010+    , scientific+    , scientific-notation++  ghc-options:    -O2   hs-source-dirs: bench-  main-is: Main.hs+  main-is:        Main.hs++source-repository head+  type:     git+  location: git://github.com/byteverse/scientific-notation.git

@@ -1,1220 +1,1408 @@-{-# language BangPatterns #-}-{-# language DuplicateRecordFields #-}-{-# language LambdaCase #-}-{-# language NumericUnderscores #-}-{-# language TypeApplications #-}-{-# language MultiWayIf #-}-{-# language MagicHash #-}-{-# language UnboxedTuples #-}--module Data.Number.Scientific-  ( Scientific-  , Scientific#-    -- * Produce-  , small-  , large-  , fromFixed-  , fromWord8-  , fromWord16-  , fromWord32-  , fromWord64-  , fromInt-  , fromInt8-  , fromInt16-  , fromInt32-  , fromInt64-    -- * Consume-  , toWord-  , toWord8-  , toWord16-  , toWord32-  , toWord64-  , toInt-  , toInt32-  , toInt64-  , withExposed-    -- * Scale and Consume-  , roundShiftedToInt64-    -- * Compare-  , greaterThanInt64-    -- * Decode-  , parserSignedUtf8Bytes-  , parserTrailingUtf8Bytes-  , parserUnsignedUtf8Bytes-  , parserNegatedUtf8Bytes-  , parserNegatedTrailingUtf8Bytes-  , parserSignedUtf8Bytes#-  , parserTrailingUtf8Bytes#-  , parserUnsignedUtf8Bytes#-  , parserNegatedUtf8Bytes#-  , parserNegatedTrailingUtf8Bytes#-    -- * Encode-  , encode-  , builderUtf8-  ) where--import Prelude hiding (negate)--import Control.Monad.ST (runST)-import Data.ByteString.Short.Internal (ShortByteString(SBS))-import Data.Bytes.Builder (Builder)-import Data.Bytes.Parser.Unsafe (Parser(..))-import Data.Bytes.Types (Bytes(Bytes))-import Data.Fixed (Fixed(MkFixed),HasResolution)-import Data.Primitive (ByteArray(ByteArray))-import Data.Text.Short (ShortText)-import GHC.Exts (Int#,Word#,(+#),intToInt64#,int64ToInt#)-import GHC.Int.Compat-import GHC.Word.Compat--import qualified Arithmetic.Nat as Nat-import qualified Data.Bytes as Bytes-import qualified Data.Bytes.Builder as Builder-import qualified Data.Bytes.Builder.Bounded as BB-import qualified Data.Bytes.Builder.Bounded.Unsafe as BBU-import qualified Data.Bytes.Chunks as Chunks-import qualified Data.Bytes.Parser as Parser-import qualified Data.Bytes.Parser.Latin as Latin-import qualified Data.Bytes.Parser.Unsafe as Unsafe-import qualified Data.Bytes.Types as BT-import qualified Data.Fixed as Fixed-import qualified Data.Primitive as PM-import qualified Data.Text.Short.Unsafe as TS-import qualified GHC.Exts as Exts-import qualified Prelude as Prelude---- Implementation Notes------ When consuming a Scientific, we are always careful to avoid--- forcing the LargeScientific. In situations involving small--- numbers, this field is not used, so we do not want to waste time--- evaluating it.--data Scientific = Scientific-  {-# UNPACK #-} !Int -- coefficient-  {-# UNPACK #-} !Int -- base-10 exponent, minBound means use unlimited-precision field-  LargeScientific--type Scientific# = (# Int#, Int#, LargeScientific #)--instance Show Scientific where-  showsPrec _ (Scientific coeff e largeNum) = if e /= minBound-    then showsPrec 0 coeff . showChar 'e' . showsPrec 0 e-    else case largeNum of-      LargeScientific coeffLarge eLarge ->-        showsPrec 0 coeffLarge . showChar 'e' . showsPrec 0 eLarge--instance Eq Scientific where-  Scientific coeffA eA largeA == Scientific coeffB eB largeB-    | eA == minBound && eB == minBound = eqLargeScientific largeA largeB-    | eA == minBound = eqLargeScientific largeA (LargeScientific (fromIntegral coeffB) (fromIntegral eB))-    | eB == minBound = eqLargeScientific (LargeScientific (fromIntegral coeffA) (fromIntegral eA)) largeB-    | eA >= maxBound - padding || eB >= maxBound - padding = eqLargeScientific-        (LargeScientific (fromIntegral coeffA) (fromIntegral eA))-        (LargeScientific (fromIntegral coeffA) (fromIntegral eB))-    | otherwise = eqSmall coeffA eA coeffB eB--data LargeScientific = LargeScientific-  !Integer -- coefficent-  !Integer -- exponent---- Padding just needs to be any number larger than the number of decimal--- digits that could represent a 64-bit integer. Normalization of scientific--- numbers using the small representation is only sound when we know that we--- are not going to trigger an overflow.-padding :: Int-padding = 50--eqSmall :: Int -> Int -> Int -> Int -> Bool-eqSmall cA0 eA0 cB0 eB0 =-  let (cA,eA) = smallNormalize cA0 eA0-      (cB,eB) = smallNormalize cB0 eB0-   in cA == cB && eA == eB--eqLargeScientific :: LargeScientific -> LargeScientific -> Bool-eqLargeScientific a b =-  let LargeScientific cA eA = largeNormalize a-      LargeScientific cB eB = largeNormalize b-   in cA == cB && eA == eB--zeroLarge :: LargeScientific-{-# noinline zeroLarge #-}-zeroLarge = LargeScientific 0 0---- | Construct a 'Scientific' from a coefficient and exponent--- that fit in a machine word.-small ::-     Int -- ^ Coefficient-  -> Int -- ^ Exponent-  -> Scientific-small !coeff !e = if e /= minBound-  then Scientific coeff e zeroLarge-  else large (fromIntegral coeff) (fromIntegral e)---- | Construct a 'Scientific' from a coefficient and exponent--- of arbitrary size.-large ::-     Integer -- ^ Coefficient-  -> Integer -- ^ Exponent-  -> Scientific-large coeff e =-  let !b = LargeScientific coeff e-   in Scientific 0 minBound b---- | Construct a 'Scientific' from a fixed-precision number.--- This does not perform well and is only included for convenience.-fromFixed :: HasResolution e => Fixed e -> Scientific-fromFixed n@(MkFixed coeff) =-  let !b = LargeScientific coeff-        (fromIntegral (Prelude.negate (logBase10 0 (Fixed.resolution n))))-   in Scientific 0 minBound b--toWord8 :: Scientific -> Maybe Word8-{-# inline toWord8 #-}-toWord8 (Scientific (I# coeff) (I# e) largeNum) = case toWord8# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | w #) -> Just (W8# w)--toWord16 :: Scientific -> Maybe Word16-{-# inline toWord16 #-}-toWord16 (Scientific (I# coeff) (I# e) largeNum) = case toWord16# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | w #) -> Just (W16# w)--toWord32 :: Scientific -> Maybe Word32-{-# inline toWord32 #-}-toWord32 (Scientific (I# coeff) (I# e) largeNum) = case toWord32# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | w #) -> Just (W32# w)--toInt32 :: Scientific -> Maybe Int32-{-# inline toInt32 #-}-toInt32 (Scientific (I# coeff) (I# e) largeNum) = case toInt32# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | w #) -> Just (I32# w)--toWord64 :: Scientific -> Maybe Word64-{-# inline toWord64 #-}-toWord64 (Scientific (I# coeff) (I# e) largeNum) = case toWord# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | w #) -> Just (W64# w)--toWord :: Scientific -> Maybe Word-{-# inline toWord #-}-toWord (Scientific (I# coeff) (I# e) largeNum) = case toWord# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | w #) -> Just (W# w)--toInt :: Scientific -> Maybe Int-{-# inline toInt #-}-toInt (Scientific (I# coeff) (I# e) largeNum) = case toInt# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | i #) -> Just (I# i)--toInt64 :: Scientific -> Maybe Int64-{-# inline toInt64 #-}-toInt64 (Scientific (I# coeff) (I# e) largeNum) = case toInt# coeff e largeNum of-  (# (# #) | #) -> Nothing-  (# | i #) -> Just (I64# (intToInt64# i))---- | This works even if the number has a fractional component. For example:------ >>> roundShiftedToInt64 2 (fromFixed @E3 1.037)--- 103------ The shift amount should be a small constant between -100 and 100.--- The behavior of a shift outside this range is undefined.-roundShiftedToInt64 ::-     Int -- ^ Exponent @e@, @n@ is multiplied by @10^e@ before rounding-  -> Scientific -- ^ Number @n@-  -> Maybe Int64-{-# inline roundShiftedToInt64 #-}-roundShiftedToInt64 (I# adj) (Scientific (I# coeff) (I# e) largeNum) =-  case roundToInt# coeff e adj largeNum of-     (# (# #) | #) -> Nothing-     (# | i #) -> Just (I64# (intToInt64# i))---- | Convert a 64-bit unsigned word to a 'Scientific'.-fromWord64 :: Word64 -> Scientific-fromWord64 !w = if w <= 9223372036854775807-  then Scientific (fromIntegral w) 0 zeroLarge-  else-    let !b = LargeScientific (fromIntegral w) 0-     in Scientific 0 minBound b--fromInt :: Int -> Scientific-{-# inline fromInt #-}-fromInt coeff = Scientific coeff 0 zeroLarge--fromInt8 :: Int8 -> Scientific-{-# inline fromInt8 #-}-fromInt8 coeff = Scientific (fromIntegral coeff) 0 zeroLarge--fromInt16 :: Int16 -> Scientific-{-# inline fromInt16 #-}-fromInt16 coeff = Scientific (fromIntegral coeff) 0 zeroLarge--fromInt32 :: Int32 -> Scientific-{-# inline fromInt32 #-}-fromInt32 coeff = Scientific (fromIntegral coeff) 0 zeroLarge--fromInt64 :: Int64 -> Scientific-{-# inline fromInt64 #-}-fromInt64 coeff = Scientific (fromIntegral coeff) 0 zeroLarge---- | Convert an 8-bit unsigned word to a 'Scientific'.-fromWord8 :: Word8 -> Scientific-{-# inline fromWord8 #-}-fromWord8 !w = Scientific (fromIntegral w) 0 zeroLarge---- | Convert a 16-bit unsigned word to a 'Scientific'.-fromWord16 :: Word16 -> Scientific-{-# inline fromWord16 #-}-fromWord16 !w = Scientific (fromIntegral w) 0 zeroLarge---- | Convert a 32-bit unsigned word to a 'Scientific'.-fromWord32 :: Word32 -> Scientific-{-# inline fromWord32 #-}-fromWord32 !w = Scientific (fromIntegral w) 0 zeroLarge---- | Is the number represented in scientific notation greater than the--- 64-bit integer argument?-greaterThanInt64 :: Scientific -> Int64 -> Bool-greaterThanInt64 (Scientific coeff0@(I# coeff0# ) e0 large0) tgt@(I64# tgt# )-  | e0 == minBound = largeGreaterThanInt64 large0 tgt-  | coeff0 == 0 = 0 > tgt-  | e0 == 0 = I64# (intToInt64# coeff0#) > tgt-  | coeff0 > 0 =-      if | tgt <= 0 -> True-         | e0 > 0 -> case smallToInt coeff0 e0 of-             (# (# #) | #) -> True-             (# | i# #) -> I64# (intToInt64# i#) > tgt-           -- In last case, e0 is less than zero.-         | otherwise -> case posIntExp10 (I# (int64ToInt# tgt#)) (Prelude.negate e0) of-             (# (# #) | #) -> False-             (# | i# #) -> I64# (intToInt64# coeff0#) > I64# (intToInt64# i#)-  | otherwise = -- Coefficent is negative-      if | tgt >= 0 -> False-         | e0 > 0 -> case smallToInt coeff0 e0 of-             (# (# #) | #) -> False-             (# | i# #) -> I64# (intToInt64# i#) > tgt-           -- In last case, e0 is less than zero.-         | otherwise -> case negIntExp10 (I# (int64ToInt# tgt#)) (Prelude.negate e0) of-             (# (# #) | #) -> True-             (# | i# #) -> I64# (intToInt64# coeff0#) > I64# (intToInt64# i#)--largeGreaterThanInt64 :: LargeScientific -> Int64 -> Bool-largeGreaterThanInt64 large0@(LargeScientific coeff e) !tgt-  | coeff == 0 = 0 > tgt-  | e == 0 = coeff > fromIntegral @Int64 @Integer tgt-  | coeff > 0 =-      if | tgt <= 0 -> True-         | e > 0 -> case largeToInt large0 of-             (# (# #) | #) -> True-             (# | i# #) -> I64# (intToInt64# i#) > tgt-         | otherwise -> case posSciLowerBound False coeff e of-             Exactly n -> n > fromIntegral @Int64 @Integer tgt-             LowerBoundedMagnitude n -> (n+1) > fromIntegral @Int64 @Integer tgt-  | otherwise = -- Coefficent is negative-      if | tgt >= 0 -> False-         | e > 0 -> case largeToInt large0 of-             (# (# #) | #) -> False-             (# | i# #) -> I64# (intToInt64# i#) > tgt-         | otherwise -> case posSciLowerBound False coeff e of-             Exactly n -> n > fromIntegral @Int64 @Integer tgt-             LowerBoundedMagnitude n -> n > fromIntegral @Int64 @Integer tgt---- | Expose the non-normalized exponent and coefficient.-withExposed ::-     (Int -> Int -> a)-     -- ^ Called when coefficient and exponent are small-  -> (Integer -> Integer -> a)-     -- ^ Called when coefficient and exponent are large-  -> Scientific-  -> a-withExposed f g (Scientific coeff theExp big) = if theExp /= minBound-  then f coeff theExp-  else case big of-    LargeScientific coeff' theExp' -> g coeff' theExp'--toSmallHelper ::-     (Int -> Int -> (# (# #) | Word# #) ) -- small-  -> (LargeScientific -> (# (# #) | Word# #) ) -- large-  -> Int#-  -> Int#-  -> LargeScientific-  -> (# (# #) | Word# #)-{-# inline toSmallHelper #-}-toSmallHelper fromSmall fromLarge coefficient0# exponent0# large0 =-  if exponent0 /= minBound-    then fromSmall coefficient0 exponent0-    else fromLarge large0-  where-  coefficient0 = I# coefficient0#-  exponent0 = I# exponent0#--toSmallIntHelper ::-     (Int -> Int -> (# (# #) | Int# #) ) -- small-  -> (LargeScientific -> (# (# #) | Int# #) ) -- large-  -> Int#-  -> Int#-  -> LargeScientific-  -> (# (# #) | Int# #)-{-# inline toSmallIntHelper #-}-toSmallIntHelper fromSmall fromLarge coefficient0# exponent0# large0 =-  if exponent0 /= minBound-    then fromSmall coefficient0 exponent0-    else fromLarge large0-  where-  coefficient0 = I# coefficient0#-  exponent0 = I# exponent0#---toWord8# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)-{-# noinline toWord8# #-}-toWord8# coefficient0# exponent0# large0 =-  toSmallHelper smallToWord8 largeToWord8-    coefficient0# exponent0# large0--toWord16# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)-{-# noinline toWord16# #-}-toWord16# coefficient0# exponent0# largeNum =-  toSmallHelper smallToWord16 largeToWord16-    coefficient0# exponent0# largeNum--toWord32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)-{-# noinline toWord32# #-}-toWord32# coefficient0# exponent0# largeNum =-  toSmallHelper smallToWord32 largeToWord32-    coefficient0# exponent0# largeNum--toInt32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)-{-# noinline toInt32# #-}-toInt32# coefficient0# exponent0# largeNum =-  toSmallIntHelper smallToInt32 largeToInt32-    coefficient0# exponent0# largeNum--toWord# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)-{-# noinline toWord# #-}-toWord# coefficient0# exponent0# largeNum =-  toSmallHelper smallToWord largeToWord-    coefficient0# exponent0# largeNum--toInt# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)-{-# noinline toInt# #-}-toInt# coefficient0# exponent0# largeNum =-  toSmallIntHelper smallToInt largeToInt-    coefficient0# exponent0# largeNum--roundToInt# :: Int# -> Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)-{-# noinline roundToInt# #-}-roundToInt# coefficient0# exponent0# adjustment0# largeNum =-  if exponent0 /= minBound-    then-      if | coefficient0 == 0 -> (# | 0# #)-         | exponent0 > (maxBound - 200) -> (# (# #) | #)-         | exponent0 < (minBound + 200) -> (# (# #) | #)-         | adjustment0 > 100 -> (# (# #) | #)-         | adjustment0 < (-100) -> (# (# #) | #)-         | otherwise ->-             roundSmallToInt coefficient0 (I# (exponent0# +# adjustment0#))-    else roundLargeToInt adjustment0 largeNum-  where-  coefficient0 = I# coefficient0#-  exponent0 = I# exponent0#-  adjustment0 = I# adjustment0#---- Arguments are non-normalized coefficient and exponent.--- We cannot use the same trick that we use for Word8 and--- Word16.-smallToWord32 :: Int -> Int -> (# (# #) | Word# #)-smallToWord32 !coefficient0 !exponent0-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 10, coefficient >= 0, coefficient <= 0xFFFFFFFF-    = word32Exp10 (fromIntegral @Int @Word coefficient) expon-  | otherwise = (# (# #) | #)---- Arguments are non-normalized coefficient and exponent.-smallToInt32 :: Int -> Int -> (# (# #) | Int# #)-smallToInt32 !coefficient0 !exponent0-  | coefficient0 == 0 = (# | 0# #)-  | (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 10-  , coefficient >= fromIntegral @Int32 @Int (minBound :: Int32)-  , coefficient <= fromIntegral @Int32 @Int (maxBound :: Int32)-    = if coefficient >= 0-        then posInt32Exp10 coefficient expon-        else negInt32Exp10 coefficient expon-  | otherwise = (# (# #) | #)---- Arguments are non-normalized coefficient and exponent.--- We cannot use the same trick that we use for Word8 and--- Word16.-smallToWord :: Int -> Int -> (# (# #) | Word# #)-smallToWord !coefficient0 !exponent0-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 30, coefficient >= 0-    = wordExp10 (fromIntegral @Int @Word coefficient) expon-  | otherwise = (# (# #) | #)---- Arguments are non-normalized coefficient and exponent.-smallToInt :: Int -> Int -> (# (# #) | Int# #)-smallToInt !coefficient0 !exponent0-  | coefficient0 == 0 = (# | 0# #)-  | (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 30-    = if coefficient >= 0-        then posIntExp10 coefficient expon-        else negIntExp10 coefficient expon-  | otherwise = (# (# #) | #)---- Arguments are non-normalized coefficient and exponent.--- This is similar to smallToInt except that we round numbers with fractional--- parts. And by round, I actually mean truncate. Fractional parts only show--- up when the exponent is negative.-roundSmallToInt :: Int -> Int -> (# (# #) | Int# #)-roundSmallToInt !coefficient0 !exponent0-  | coefficient0 == 0 = (# | 0# #)-  | (coefficient@(I# coefficient# ),expon) <- incrementNegativeExp coefficient0 exponent0-  , expon < 30 = case compare expon 0 of-      EQ -> (# | coefficient# #)-      GT -> if coefficient >= 0-        then posIntExp10 coefficient expon-        else negIntExp10 coefficient expon-      LT -> if coefficient >= 0-        then (# | roundPosIntNegExp10 coefficient expon #)-        else (# | roundNegIntNegExp10 coefficient expon #)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized coefficient and exponent--- With Word16, we can do a neat little trick where we--- cap the coefficient at 65536 and the exponent at 5. This--- works because a 32-bit signed int can contain 65535e4.-smallToWord16 :: Int -> Int -> (# (# #) | Word# #)-smallToWord16 !coefficient0 !exponent0-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 5, coefficient >= 0, coefficient < 65536-  , r <- exp10 coefficient expon-  , y@(W16# y# ) <- fromIntegral @Int @Word16 r-  , fromIntegral @Word16 @Int y == r-    = (# | y# #)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized coefficient and exponent--- With Word8, we can do a neat little trick where we--- cap the coefficient at 256 and the exponent at 3. This--- works because a 32-bit signed int can contain 255e2.-smallToWord8 :: Int -> Int -> (# (# #) | Word# #)-smallToWord8 !coefficient0 !exponent0-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 3, coefficient >= 0, coefficient < 256-  , r <- exp10 coefficient expon-  , y@(W8# y# ) <- fromIntegral @Int @Word8 r-  , fromIntegral @Word8 @Int y == r-    = (# | y# #)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized-largeToWord8 :: LargeScientific -> (# (# #) | Word# #)-largeToWord8 (LargeScientific coefficient0 exponent0)-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 3, coefficient >= 0, coefficient < 256-  , r <- exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-  , y@(W8# y# ) <- fromIntegral @Int @Word8 r-  , fromIntegral @Word8 @Int y == r-    = (# | y# #)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized-largeToWord16 :: LargeScientific -> (# (# #) | Word# #)-largeToWord16 (LargeScientific coefficient0 exponent0)-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 5, coefficient >= 0, coefficient < 65536-  , r <- exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-  , y@(W16# y# ) <- fromIntegral @Int @Word16 r-  , fromIntegral @Word16 @Int y == r-    = (# | y# #)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized-largeToWord32 :: LargeScientific -> (# (# #) | Word# #)-largeToWord32 (LargeScientific coefficient0 exponent0)-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 10, coefficient >= 0, coefficient <= 0xFFFFFFFF-    = word32Exp10 (fromIntegral @Integer @Word coefficient) (fromIntegral @Integer @Int expon)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized, this targets the native word size-largeToWord :: LargeScientific -> (# (# #) | Word# #)-largeToWord (LargeScientific coefficient0 exponent0)-  | coefficient0 == 0 = (# | 0## #)-  | (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 30, coefficient >= 0, coefficient <= (fromIntegral @Word @Integer maxBound)-    = wordExp10 (fromIntegral @Integer @Word coefficient) (fromIntegral @Integer @Int expon)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized-largeToInt32 :: LargeScientific -> (# (# #) | Int# #)-largeToInt32 (LargeScientific coefficient0 exponent0)-  | coefficient0 == 0 = (# | 0# #)-  | (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 10-  , coefficient >= (fromIntegral @Int32 @Integer minBound)-  , coefficient <= (fromIntegral @Int32 @Integer maxBound)-    = if coefficient >= 0-        then posInt32Exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-        else negInt32Exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized, this targets the native word size-largeToInt :: LargeScientific -> (# (# #) | Int# #)-largeToInt (LargeScientific coefficient0 exponent0)-  | coefficient0 == 0 = (# | 0# #)-  | (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0-  , expon >= 0, expon < 30-  , coefficient >= (fromIntegral @Int @Integer minBound)-  , coefficient <= (fromIntegral @Int @Integer maxBound)-    = if coefficient >= 0-        then posIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-        else negIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-  | otherwise = (# (# #) | #)---- Arguments are non-normalized, this targets the native word size-roundLargeToInt :: Int -> LargeScientific -> (# (# #) | Int# #)-roundLargeToInt !adj (LargeScientific coefficient0 exponent0)-  | coefficient0 == 0 = (# | 0# #)-  | (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent1-  , expon < 30-    = case compare expon 0 of-        EQ -> case fromIntegral @Integer @Int coefficient of-          I# r -> (# | r #)-        GT ->-          if coefficient >= (fromIntegral @Int @Integer minBound) && coefficient <= (fromIntegral @Int @Integer maxBound)-            then if coefficient >= 0-              then posIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-              else negIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)-            else (# (# #) | #)-        LT -> if expon < (-100_000_000_000)-          then -- Due to the realities of hardward, a negative exponent with high-               -- magnitude is guaranteed to produce a zero result. A coefficient-               -- large enough to resist the zero result would consume all memory.-               (# | 0# #)-          else if coefficient >= 0-            then roundPosIntegerNegExp10 coefficient (fromInteger expon)-            else roundNegIntegerNegExp10 coefficient (fromInteger expon)-  | otherwise = (# (# #) | #)-  where-  exponent1 = exponent0 + toInteger adj---- Precondition: the exponent is non-negative. This returns--- an unboxed Nothing on overflow. This implementation should--- work even on a 32-bit platform.-word32Exp10 :: Word -> Int -> (# (# #) | Word# #)-word32Exp10 !a@(W# a# ) !e = case e of-  0 -> (# | a# #)-  _ -> let (overflow, a') = timesWord2 a 10 in-    if overflow || (a' > 0xFFFFFFFF)-      then (# (# #) | #)-      else word32Exp10 a' (e - 1)---- Precondition: the exponent is non-negative, and the--- coefficient is non-negative. This returns an unboxed--- Nothing on overflow.-posInt32Exp10 :: Int -> Int -> (# (# #) | Int# #)-posInt32Exp10 !a@(I# a# ) !e = case e of-  0 -> (# | a# #)-  _ -> if a < posInt32PreUpper-    then let a' = a * 10 in-      if a' >= a && a' <= fromIntegral (maxBound :: Int32)-        then posInt32Exp10 a' (e - 1)-        else (# (# #) | #)-    else (# (# #) | #)---- Precondition: the exponent is non-negative, and the--- coefficient is non-positive. This returns an unboxed--- Nothing on overflow.-negInt32Exp10 :: Int -> Int -> (# (# #) | Int# #)-negInt32Exp10 !a@(I# a# ) !e = case e of-  0 -> (# | a# #)-  _ -> if a > negInt32PreLower-    then let a' = a * 10 in-      if a' <= a && a' >= fromIntegral (minBound :: Int32)-        then negInt32Exp10 a' (e - 1)-        else (# (# #) | #)-    else (# (# #) | #)---- Precondition: the exponent is non-negative. This returns--- an unboxed Nothing on overflow.-wordExp10 :: Word -> Int -> (# (# #) | Word# #)-wordExp10 !a@(W# a# ) !e = case e of-  0 -> (# | a# #)-  _ -> let (overflow, a') = timesWord2 a 10 in if overflow-    then (# (# #) | #)-    else wordExp10 a' (e - 1)---- Precondition: The exponent is non-negative, and the--- coefficient is non-negative. This returns an unboxed--- Nothing on overflow.-posIntExp10 :: Int -> Int -> (# (# #) | Int# #)-posIntExp10 !a@(I# a# ) !e = case e of-  0 -> (# | a# #)-  _ -> if a < posIntPreUpper-    then let a' = a * 10 in-      if a' >= a-        then posIntExp10 a' (e - 1)-        else (# (# #) | #)-    else (# (# #) | #)---- Precondition: The exponent is non-positive, and the--- coefficient is non-negative. This returns an unboxed--- Nothing on overflow.-roundPosIntNegExp10 :: Int -> Int -> Int#-roundPosIntNegExp10 !a@(I# a# ) !e = case e of-  0 -> a#-  _ -> roundPosIntNegExp10 (quot a 10) (e + 1)---- Precondition: The exponent is non-positive, and the--- coefficient is non-negative. This returns an unboxed--- Nothing on overflow.-roundPosIntegerNegExp10 :: Integer -> Int -> (# (# #) | Int# #)-roundPosIntegerNegExp10 !a !e = case e of-  0 -> if a > fromIntegral @Int @Integer maxBound-    then (# (# #) | #)-    else case fromInteger a of-      I# a# -> (# | a# #)-  _ -> case a of-    0 -> (# | 0# #)-    _ -> roundPosIntegerNegExp10 (quot a 10) (e + 1)---- Precondition: The exponent is non-negative, and the--- coefficient is non-positive. This returns an unboxed--- Nothing on overflow.-negIntExp10 :: Int -> Int -> (# (# #) | Int# #)-negIntExp10 !a@(I# a# ) !e = case e of-  0 -> (# | a# #)-  _ -> if a > negIntPreLower-    then let a' = a * 10 in-      if a' <= a-        then negIntExp10 a' (e - 1)-        else (# (# #) | #)-    else (# (# #) | #)---- Precondition: The exponent is non-position, and the--- coefficient is non-positive. This returns an unboxed--- Nothing on overflow.-roundNegIntNegExp10 :: Int -> Int -> Int#-roundNegIntNegExp10 !a@(I# a# ) !e = case e of-  0 -> a#-  _ -> roundNegIntNegExp10 (quot a 10) (e + 1)---- Precondition: The exponent is non-position, and the--- coefficient is non-positive. This returns an unboxed--- Nothing on overflow.-roundNegIntegerNegExp10 :: Integer -> Int -> (# (# #) | Int# #)-roundNegIntegerNegExp10 !a !e = case e of-  0 -> if a > fromIntegral @Int @Integer maxBound-    then (# (# #) | #)-    else case fromInteger a of-      I# a# -> (# | a# #)-  _ -> case a of-    0 -> (# | 0# #)-    _ -> roundNegIntegerNegExp10 (quot a 10) (e + 1)---- What are these lower and upper bounds? The problem that--- we are trying to solve is that overflow is tricky to detect--- when we multiply by ten. By putting an upper (or lower)--- bound on the thing we are multiplying by ten, we can--- make overflow detection simple: just test that the--- accumulator became larger (or smaller when dealing with--- a negative coefficient) than it previously was.--posIntPreUpper :: Int-posIntPreUpper = div maxBound 10 + 10--negIntPreLower :: Int-negIntPreLower = div minBound 10 - 10--posInt32PreUpper :: Int-posInt32PreUpper = 214748370--negInt32PreLower :: Int-negInt32PreLower = (-214748370)---- Bool is true if overflow happened-timesWord2 :: Word -> Word -> (Bool, Word)-timesWord2 (W# a) (W# b) =-  let !(# c, r #) = Exts.timesWord2# a b-   in (case c of { 0## -> False; _ -> True}, W# r)---- Precondition: the exponent is non-negative-exp10 :: Int -> Int -> Int-exp10 !a !e = case e of-  0 -> a-  _ -> exp10 (a * 10) (e - 1)--largeNormalize :: LargeScientific -> LargeScientific-largeNormalize s@(LargeScientific w _) = case w of-  0 -> LargeScientific 0 0-  _ -> largeNormalizeLoop s---- Precondition: the coefficient is non-zero-largeNormalizeLoop :: LargeScientific -> LargeScientific-largeNormalizeLoop (LargeScientific w e) = case quotRem w 10 of-  (q,r) -> case r of-    0 -> largeNormalizeLoop (LargeScientific q (e + 1))-    _ -> LargeScientific w e--largeIncrementNegativeExp :: Integer -> Integer -> (Integer,Integer)-largeIncrementNegativeExp w e = if e >= 0-  then (w,e)-  else case quotRem w 10 of-    (q,r) -> case r of-      0 -> largeIncrementNegativeExp q (e + 1)-      _ -> (w,e)--smallNormalize :: Int -> Int -> (Int,Int)-smallNormalize (I# w) (I# e) = case w of-  0# -> (0,0)-  _ -> case smallNormalize# w e of-    (# w', e' #) -> (I# w', I# e')--incrementNegativeExp :: Int -> Int -> (Int,Int)-incrementNegativeExp (I# w) (I# e) = case incrementNegativeExp# w e of-  (# w', e' #) -> (I# w', I# e')---- If the exponent is negative, increase it as long as the--- coefficient divides ten evenly.--- This only ever causes the coefficient to decrease, never increase.-incrementNegativeExp# :: Int# -> Int# -> (# Int#, Int# #)-{-# noinline incrementNegativeExp# #-}-incrementNegativeExp# w# e# = if I# e# >= 0-  then (# w#, e# #)-  else case quotRem (I# w# ) 10 of-    (I# q#,r) -> case r of-      0 -> incrementNegativeExp# q# (e# +# 1# )-      _ -> (# w#, e# #)---- Precondition: coefficient is not zero. If it is,--- this will loop.-smallNormalize# :: Int# -> Int# -> (# Int#, Int# #)-{-# noinline smallNormalize# #-}-smallNormalize# w# e# = case quotRem (I# w# ) 10 of-  (I# q#,r) -> case r of-    0 -> smallNormalize# q# (e# +# 1# )-    _ -> (# w#, e# #)---- | Parse a number that is encoded in UTF-8 and in scientific notation.--- All of these are accepted:------ * 330e-1--- * 330e+1--- * 330e1--- * 330.0e1--- * -330.0e1--- * 12--- * 00012--- * 2.05--- * +2.05--- * +33.6e+1-parserSignedUtf8Bytes :: e -> Parser e s Scientific-parserSignedUtf8Bytes e = boxScientific (parserSignedUtf8Bytes# e)---- | Variant of 'parserSignedUtf8Bytes' that rejects strings with--- a leading plus or minus sign.-parserUnsignedUtf8Bytes :: e -> Parser e s Scientific-parserUnsignedUtf8Bytes e = boxScientific (parserUnsignedUtf8Bytes# e)---- | Variant of 'parserUnsignedUtf8Bytes' that negates the result.-parserNegatedUtf8Bytes :: e -> Parser e s Scientific-parserNegatedUtf8Bytes e = boxScientific (parserNegatedUtf8Bytes# e)--parserTrailingUtf8Bytes# ::-     e -- ^ Error message-  -> Int# -- ^ Leading digit-  -> Parser e s Scientific#-{-# noinline parserTrailingUtf8Bytes# #-}-parserTrailingUtf8Bytes# e leader =-  mapIntPairToScientific (parseSmallTrailing# leader)-  `orElseScientific`-  upcastLargeScientific (parseLargeTrailing e (I# leader))--parserNegatedTrailingUtf8Bytes# ::-     e -- ^ Error message-  -> Int# -- ^ Leading digit-  -> Parser e s Scientific#-{-# noinline parserNegatedTrailingUtf8Bytes# #-}-parserNegatedTrailingUtf8Bytes# e leader =-  mapNegateIntPairToScientific (parseSmallTrailing# leader)-  `orElseScientific`-  upcastNegatedLargeScientific (parseLargeTrailing e (I# leader))--parserSignedUtf8Bytes# ::-     e -- ^ Error message-  -> Parser e s Scientific#-parserSignedUtf8Bytes# e = Latin.any e `bindToScientific` \c -> case c of-  '+' -> parserUnsignedUtf8Bytes# e-  '-' -> parserNegatedUtf8Bytes# e-  _ -> Unsafe.unconsume 1 `bindToScientific` \_ ->-    parserUnsignedUtf8Bytes# e---- | Variant of 'parseUnsignedUtf8Bytes' where all arguments are--- unboxed.-parserUnsignedUtf8Bytes# ::-     e -- ^ Error message-  -> Parser e s Scientific#-parserUnsignedUtf8Bytes# e =-  mapIntPairToScientific parseSmall#-  `orElseScientific`-  upcastLargeScientific (parseLarge e)---- Negates the result after parsing the bytes.-parserNegatedUtf8Bytes# ::-     e -- ^ Error message-  -> Parser e s Scientific#-parserNegatedUtf8Bytes# e =-  mapNegateIntPairToScientific parseSmall#-  `orElseScientific`-  upcastNegatedLargeScientific (parseLarge e)--parserTrailingUtf8Bytes ::-     e -- ^ Error message-  -> Int -- ^ Leading digit, should be between @-9@ and @9@.-  -> Parser e s Scientific-parserTrailingUtf8Bytes e (I# leader) =-  boxScientific (parserTrailingUtf8Bytes# e leader)--parserNegatedTrailingUtf8Bytes ::-     e -- ^ Error message-  -> Int -- ^ Leading digit, should be between @-9@ and @9@.-  -> Parser e s Scientific-parserNegatedTrailingUtf8Bytes e (I# leader) =-  boxScientific (parserNegatedTrailingUtf8Bytes# e leader)------ parserTrailingUtf8Bytes# ::---      e -- Error message---   -> Parser e s Scientific#--- parserTrailingUtf8Bytes# !leader e =---   parseSmall# leader---   `orElseScientific`---   unboxScientific (P.fail e)--parseLarge :: e -> Parser e s LargeScientific-parseLarge e = do-  coeff <- Latin.decUnsignedInteger e-  parseLargeCommon e coeff--parseLargeTrailing :: e -> Int -> Parser e s LargeScientific-parseLargeTrailing e !leader = do-  coeff <- Latin.decTrailingInteger leader-  parseLargeCommon e coeff--parseLargeCommon :: e -> Integer -> Parser e s LargeScientific-{-# noinline parseLargeCommon #-}-parseLargeCommon e coeff = do-  Latin.trySatisfyThen (pure (LargeScientific coeff 0)) $ \c -> case c of-    '.' -> Just $ do-      !start <- Unsafe.cursor-      afterDot <- Latin.decUnsignedInteger e-      !end <- Unsafe.cursor-      let !logDenom = end - start-          !coeffFinal = (integerTenExp coeff logDenom) + afterDot-      Latin.trySatisfy (\ch -> ch == 'e' || ch == 'E') >>= \case-        True -> attemptLargeExp e coeffFinal (unI (Prelude.negate logDenom))-        False -> pure $! LargeScientific coeffFinal $! fromIntegral $! Prelude.negate logDenom-    'e' -> Just (attemptLargeExp e coeff 0# )-    'E' -> Just (attemptLargeExp e coeff 0# )-    _ -> Nothing---- handles unsigned small numbers-parseSmall# :: Parser () s (# Int#, Int# #)-parseSmall# =-  Latin.decUnsignedInt# () `Parser.bindFromIntToIntPair` \coeff# ->-  parseSmallCommon# coeff#--parseSmallTrailing# :: Int# -> Parser () s (# Int#, Int# #)-parseSmallTrailing# leader =-  Latin.decTrailingInt# () leader `Parser.bindFromIntToIntPair` \coeff# ->-  parseSmallCommon# coeff#--parseSmallCommon# :: Int# -> Parser () s (# Int#, Int# #)-{-# noinline parseSmallCommon# #-}-parseSmallCommon# coeff# =-  Latin.trySatisfyThen (Parser.pureIntPair (# coeff#, 0# #)) $ \c -> case c of-    '.' -> Just $-      Unsafe.cursor `Parser.bindFromLiftedToIntPair` \start ->-      Latin.decUnsignedInt# () `Parser.bindFromIntToIntPair` \afterDot# ->-      Unsafe.cursor `Parser.bindFromLiftedToIntPair` \end ->-      let !logDenom = end - start-          goCoeff !coeffShifted !expon = case expon of-            0 ->-              let !(I# coeffShifted# ) = coeffShifted-                  !(# coeffFinal, overflowed #) =-                    Exts.addIntC# coeffShifted# afterDot#-               in case overflowed of-                0# -> Latin.trySatisfy (\ch -> ch == 'e' || ch == 'E') `Parser.bindFromLiftedToIntPair` \b -> case b of-                  True -> attemptSmallExp coeffFinal (unI (Prelude.negate logDenom))-                  False -> Parser.pureIntPair (# coeffFinal, unI (Prelude.negate logDenom) #)-                _ -> Parser.failIntPair ()-            _ ->-              let coeffShifted' = coeffShifted * 10-               in if coeffShifted' >= coeffShifted-                    then goCoeff coeffShifted' (expon - 1)-                    -- If we overflow, fail so that the parser-                    -- for large number will handle it instead.-                    else Parser.failIntPair ()-       in goCoeff (I# coeff# ) logDenom-    'e' -> Just (attemptSmallExp coeff# 0#)-    'E' -> Just (attemptSmallExp coeff# 0#)-    _ -> Nothing----- The delta passed to this is only ever a negative integer.-attemptLargeExp ::-     e-  -> Integer-  -> Int#-  -> Parser e s LargeScientific-{-# noinline attemptLargeExp #-}-attemptLargeExp e signedCoeff !deltaExp# = do-  expon <- Latin.decSignedInteger e-  let !exponent' = expon + fromIntegral (I# deltaExp# )-  pure (LargeScientific signedCoeff exponent')---- The delta passed to this is only ever a negative integer.--- It is also between -21 and -1. (Or maybe -22 or -20, not sure).-attemptSmallExp :: Int# -> Int# -> Parser () s (# Int#, Int# #)-{-# noinline attemptSmallExp #-}-attemptSmallExp !signedCoeff# !deltaExp# = Parser.unboxIntPair $ do-  e <- Latin.decSignedInt ()-  -- I give this a little extra padding just to be safe.-  if e > (minBound + padding)-    then pure (signedCoeff, e + deltaExp)-    else Parser.fail ()-  where-  signedCoeff = I# signedCoeff#-  deltaExp = I# deltaExp#---- | Convert a 'Word#' parser to a 'Word32' parser. Precondition:--- the argument parser only returns words less than 4294967296.-boxScientific :: Parser s e Scientific# -> Parser s e Scientific-boxScientific (Parser f) = Parser-  (\x s0 -> case f x s0 of-    (# s1, r #) -> case r of-      (# e | #) -> (# s1, (# e | #) #)-      (# | (# (# w, y, z #), b, c #) #) -> (# s1, (# | (# Scientific (I# w) (I# y) z, b, c #) #) #)-  )--unI :: Int -> Int#-unI (I# i) = i--orElseScientific :: Parser x s Scientific# -> Parser e s Scientific# -> Parser e s Scientific#-{-# inline orElseScientific #-}-orElseScientific (Parser f) (Parser g) = Parser-  (\x s0 -> case f x s0 of-    (# s1, r0 #) -> case r0 of-      (# _ | #) -> g x s1-      (# | r #) -> (# s1, (# | r #) #)-  )---- Precondition: argument is non-negative--- If the argument is r and the exponent is e, the result--- is described as: r * 10^e-integerTenExp :: Integer -> Int -> Integer-integerTenExp !r !e = case e of-  0 -> r-  1 -> r * 10-  2 -> r * 100-  3 -> r * 1000-  4 -> r * 10000-  5 -> r * 100000-  6 -> r * 1000000-  7 -> r * 10000000-  8 -> r * 100000000-  _ -> integerTenExp (r * 1000000000) (e - 9)--data Estimate-  = Exactly !Integer-  | LowerBoundedMagnitude !Integer-    -- For positive N, LowerBoundedMagnitude N means that x > N and x < N+1.-    -- For negative N, LowerBoundedMagnitude N means that x < N and x > N-1.---- Precondition: Exponent is non-positive. Coefficient is non-zero.--- When calling this from elsewhere, set wasTruncated to False.-posSciLowerBound :: Bool -> Integer -> Integer -> Estimate-posSciLowerBound !wasTruncated !coeff !e-  | e == 0 = case wasTruncated of-      True -> LowerBoundedMagnitude coeff-      False -> Exactly coeff-  | otherwise = let (q,r) = quotRem coeff 10 in-      case q of-        0 -> LowerBoundedMagnitude 0-        _ -> posSciLowerBound (wasTruncated || r /= 0) q (e + 1)---- This only works if the number is a power of ten.--- It is only intended to be used by fromFixed.--- Precondition: the Integer is not zero.-logBase10 :: Int -> Integer -> Int-logBase10 !acc i = if i == 1-  then acc-  else logBase10 (acc + 1) (div i 10)--upcastLargeScientific ::-     Parser e s LargeScientific-  -> Parser e s Scientific#-upcastLargeScientific (Parser g) = Parser-  (\x s0 -> case g x s0 of-    (# s1, r #) -> case r of-      (# e | #) -> (# s1, (# e | #) #)-      (# | (# a, b, c #) #) -> (# s1, (# | (# (# 0#, unI minBound, a #), b, c #) #) #)-  )--upcastNegatedLargeScientific ::-     Parser e s LargeScientific-  -> Parser e s Scientific#-upcastNegatedLargeScientific (Parser g) = Parser-  (\x s0 -> case g x s0 of-    (# s1, r #) -> case r of-      (# e | #) -> (# s1, (# e | #) #)-      (# | (# LargeScientific w y, b, c #) #) -> (# s1, (# | (# (# 0#, unI minBound, LargeScientific (Prelude.negate w) y #), b, c #) #) #)-  )--mapIntPairToScientific ::-     Parser e s (# Int#, Int# #)-  -> Parser e s Scientific#-mapIntPairToScientific (Parser g) = Parser-  (\x s0 -> case g x s0 of-    (# s1, r #) -> case r of-      (# e | #) -> (# s1, (# e | #) #)-      (# | (# (# y, z #), b, c #) #) -> (# s1, (# | (# (# y, z, zeroLarge #), b, c #) #) #)-  )---- We do not check to see if exponent==minBound since this is called--- on the result of an unsigned parser. Fortunately, signed fixed-width--- integers always have one extra number on the low end that is not the--- negation of anything on the high end.-mapNegateIntPairToScientific ::-     Parser e s (# Int#, Int# #)-  -> Parser e s Scientific#-mapNegateIntPairToScientific (Parser g) = Parser-  (\x s0 -> case g x s0 of-    (# s1, r #) -> case r of-      (# e | #) -> (# s1, (# e | #) #)-      (# | (# (# y, z #), b, c #) #) -> (# s1, (# | (# (# Exts.negateInt# y, z, zeroLarge #), b, c #) #) #)-  )--bindToScientific :: Parser s e a -> (a -> Parser s e Scientific#) -> Parser s e Scientific#-{-# inline bindToScientific #-}-bindToScientific (Parser f) g = Parser-  (\x@(# arr, _, _ #) s0 -> case f x s0 of-    (# s1, r0 #) -> case r0 of-      (# e | #) -> (# s1, (# e | #) #)-      (# | (# y, b, c #) #) ->-        runParser (g y) (# arr, b, c #) s1-  )---- | Encode a number as text. If the exponent is between -50 and +50 (exclusive),--- this represents the number without any exponent. For example:------ >>> encode (small 87654321 (-3))--- "87654.321"--- >>> encode (small 5000 (-3))--- "-5000"------ The decision of when to use an exponent is not considered stable part of--- this library\'s API. Check the test suite for examples of what to expect,--- and feel free to open an issue or contribute if the output of this function--- is unsightly in certain situations.-encode :: Scientific -> ShortText-encode s = case Chunks.concatU (Builder.run 128 (builderUtf8 s)) of-  ByteArray x -> TS.fromShortByteStringUnsafe (SBS x)---- | Variant of 'encode' that provides a builder instead.-builderUtf8 :: Scientific -> Builder-builderUtf8 (Scientific coeff e big)-  | e == 0 = Builder.intDec coeff-  | e == minBound = let LargeScientific coeff' e' = big in-      if | coeff' == 0 -> Builder.ascii '0'-         | e' == 0 -> Builder.integerDec coeff'-         | e' > 0 && e' < 50 ->-             -- TODO: Add a replicate function to builder to improve this.-             Builder.integerDec coeff' <> Builder.bytes (Bytes.replicate (fromInteger e') 0x30)-         | e' < 0, e' > (-50), coeff' > 0, coeff' < 18446744073709551616 ->-             let coeff'' = fromInteger coeff' :: Word-                 e'' = fromInteger e' :: Int-              in Builder.bytes (encodePosCoeffNegExp coeff'' e'')-         | e' < 0, e' > (-50), coeff' < 0, coeff' > (-18446744073709551616) ->-             let coeff'' = fromInteger (Prelude.negate coeff') :: Word-                 e'' = fromInteger e' :: Int-              in Builder.bytes (encodeNegCoeffNegExp coeff'' e'')-         | otherwise ->-             Builder.integerDec coeff'-             <>-             Builder.ascii 'e'-             <>-             Builder.integerDec e'-  | otherwise =-      if | coeff == 0 -> Builder.ascii '0'-         | e > 0 && e < 50 ->-             -- TODO: Add a replicate function to builder to improve this.-             Builder.intDec coeff <> Builder.bytes (Bytes.replicate e 0x30)-         | e < 0 && e > (-50) -> if coeff > 0-             then Builder.bytes (encodePosCoeffNegExp (fromIntegral @Int @Word coeff) e)-             else Builder.bytes (encodeNegCoeffNegExp (fromIntegral @Int @Word (Prelude.negate coeff)) e)-         | otherwise -> Builder.fromBounded Nat.constant $-             BB.intDec coeff-             `BB.append`-             BB.ascii 'e'-             `BB.append`-             BB.intDec e---- Precondition: exponent is negative.--- This is convoluted, so if a reader of this code thinks of a better--- way to do this, feel free to PR a more simple replacement.-encodePosCoeffNegExp :: Word -> Int -> Bytes-encodePosCoeffNegExp !w !e = runST $ do-  dst <- PM.newByteArray 128-  PM.setByteArray dst 0 128 (0x30 :: Word8)-  end <- BBU.pasteST (BB.wordDec w) dst 100-  let dotIx = end + e-  let coeffMag = end - 100-  let extra = if coeffMag > Prelude.negate e-        then (coeffMag - Prelude.negate e) - 1-        else 0-  PM.moveByteArray dst 0 dst 1 dotIx-  PM.writeByteArray dst (dotIx - 1) (0x2E :: Word8)-  dst' <- PM.unsafeFreezeByteArray dst-  pure Bytes-    { BT.array=dst'-    , BT.offset=dotIx - 2 - extra-    , BT.length=Prelude.negate e + 2 + extra-    }---- Precondition: exponent is negative.--- This is convoluted, so if a reader of this code thinks of a better--- way to do this, feel free to PR a more simple replacement.-encodeNegCoeffNegExp :: Word -> Int -> Bytes-encodeNegCoeffNegExp !w !e = runST $ do-  dst <- PM.newByteArray 128-  PM.setByteArray dst 0 128 (0x30 :: Word8)-  end <- BBU.pasteST (BB.wordDec w) dst 100-  let dotIx = end + e-  let coeffMag = end - 100-  let extra = if coeffMag > Prelude.negate e-        then (coeffMag - Prelude.negate e) - 1-        else 0-  PM.moveByteArray dst 0 dst 1 dotIx-  PM.writeByteArray dst (dotIx - 1) (0x2E :: Word8)-  PM.writeByteArray dst (dotIx - 3 - extra) (0x2D :: Word8)-  dst' <- PM.unsafeFreezeByteArray dst-  pure Bytes-    { BT.array=dst'-    , BT.offset=dotIx - 3 - extra-    , BT.length=Prelude.negate e + 3 + extra-    }+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UnboxedTuples #-}++module Data.Number.Scientific+  ( Scientific+  , Scientific#++    -- * Produce+  , small+  , large+  , fromFixed+  , fromWord8+  , fromWord16+  , fromWord32+  , fromWord64+  , fromInt+  , fromInt8+  , fromInt16+  , fromInt32+  , fromInt64++    -- * Consume+  , toWord+  , toWord8+  , toWord16+  , toWord32+  , toWord64+  , toInt+  , toInt32+  , toInt64+  , toInteger+  , withExposed++    -- * Scale and Consume+  , roundShiftedToInt64++    -- * Compare+  , greaterThanInt64++    -- * Decode+  , parserSignedUtf8Bytes+  , parserTrailingUtf8Bytes+  , parserUnsignedUtf8Bytes+  , parserNegatedUtf8Bytes+  , parserNegatedTrailingUtf8Bytes+  , parserSignedUtf8Bytes#+  , parserTrailingUtf8Bytes#+  , parserUnsignedUtf8Bytes#+  , parserNegatedUtf8Bytes#+  , parserNegatedTrailingUtf8Bytes#++    -- * Encode+  , encode+  , builderUtf8+  ) where++import Prelude hiding (negate,toInteger)++import Control.Monad.ST (runST)+import Data.ByteString.Short.Internal (ShortByteString (SBS))+import Data.Bytes.Builder (Builder)+import Data.Bytes.Parser.Unsafe (Parser (..))+import Data.Bytes.Types (Bytes (Bytes))+import Data.Fixed (Fixed (MkFixed), HasResolution)+import Data.Primitive (ByteArray (ByteArray))+import Data.Text.Short (ShortText)+import GHC.Exts (Int#, Word#, int64ToInt#, intToInt64#, (+#))+import GHC.Int.Compat+import GHC.Word.Compat++import qualified Arithmetic.Nat as Nat+import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Builder as Builder+import qualified Data.Bytes.Builder.Bounded as BB+import qualified Data.Bytes.Builder.Bounded.Unsafe as BBU+import qualified Data.Bytes.Chunks as Chunks+import qualified Data.Bytes.Parser as Parser+import qualified Data.Bytes.Parser.Latin as Latin+import qualified Data.Bytes.Parser.Unsafe as Unsafe+import qualified Data.Bytes.Types as BT+import qualified Data.Fixed as Fixed+import qualified Data.Primitive as PM+import qualified Data.Text.Short.Unsafe as TS+import qualified GHC.Exts as Exts+import qualified Prelude++-- Implementation Notes+--+-- When consuming a Scientific, we are always careful to avoid+-- forcing the LargeScientific. In situations involving small+-- numbers, this field is not used, so we do not want to waste time+-- evaluating it.++data Scientific+  = Scientific+      {-# UNPACK #-} !Int -- coefficient+      {-# UNPACK #-} !Int -- base-10 exponent, minBound means use unlimited-precision field+      LargeScientific++type Scientific# = (# Int#, Int#, LargeScientific #)++instance Show Scientific where+  showsPrec _ (Scientific coeff e largeNum) =+    if e /= minBound+      then showsPrec 0 coeff . showChar 'e' . showsPrec 0 e+      else case largeNum of+        LargeScientific coeffLarge eLarge ->+          showsPrec 0 coeffLarge . showChar 'e' . showsPrec 0 eLarge++instance Eq Scientific where+  Scientific coeffA eA largeA == Scientific coeffB eB largeB+    | eA == minBound && eB == minBound = eqLargeScientific largeA largeB+    | eA == minBound = eqLargeScientific largeA (LargeScientific (fromIntegral coeffB) (fromIntegral eB))+    | eB == minBound = eqLargeScientific (LargeScientific (fromIntegral coeffA) (fromIntegral eA)) largeB+    | eA >= maxBound - padding || eB >= maxBound - padding =+        eqLargeScientific+          (LargeScientific (fromIntegral coeffA) (fromIntegral eA))+          (LargeScientific (fromIntegral coeffA) (fromIntegral eB))+    | otherwise = eqSmall coeffA eA coeffB eB++data LargeScientific+  = LargeScientific+      !Integer -- coefficent+      !Integer -- exponent++-- Padding just needs to be any number larger than the number of decimal+-- digits that could represent a 64-bit integer. Normalization of scientific+-- numbers using the small representation is only sound when we know that we+-- are not going to trigger an overflow.+padding :: Int+padding = 50++eqSmall :: Int -> Int -> Int -> Int -> Bool+eqSmall cA0 eA0 cB0 eB0 =+  let (cA, eA) = smallNormalize cA0 eA0+      (cB, eB) = smallNormalize cB0 eB0+   in cA == cB && eA == eB++eqLargeScientific :: LargeScientific -> LargeScientific -> Bool+eqLargeScientific a b =+  let LargeScientific cA eA = largeNormalize a+      LargeScientific cB eB = largeNormalize b+   in cA == cB && eA == eB++zeroLarge :: LargeScientific+{-# NOINLINE zeroLarge #-}+zeroLarge = LargeScientific 0 0++{- | Construct a 'Scientific' from a coefficient and exponent+that fit in a machine word.+-}+small ::+  -- | Coefficient+  Int ->+  -- | Exponent+  Int ->+  Scientific+small !coeff !e =+  if e /= minBound+    then Scientific coeff e zeroLarge+    else large (fromIntegral coeff) (fromIntegral e)++{- | Construct a 'Scientific' from a coefficient and exponent+of arbitrary size.+-}+large ::+  -- | Coefficient+  Integer ->+  -- | Exponent+  Integer ->+  Scientific+large coeff e =+  let !b = LargeScientific coeff e+   in Scientific 0 minBound b++{- | Construct a 'Scientific' from a fixed-precision number.+This does not perform well and is only included for convenience.+-}+fromFixed :: (HasResolution e) => Fixed e -> Scientific+fromFixed n@(MkFixed coeff) =+  let !b =+        LargeScientific+          coeff+          (fromIntegral (Prelude.negate (logBase10 0 (Fixed.resolution n))))+   in Scientific 0 minBound b++toWord8 :: Scientific -> Maybe Word8+{-# INLINE toWord8 #-}+toWord8 (Scientific (I# coeff) (I# e) largeNum) = case toWord8# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | w #) -> Just (W8# w)++toWord16 :: Scientific -> Maybe Word16+{-# INLINE toWord16 #-}+toWord16 (Scientific (I# coeff) (I# e) largeNum) = case toWord16# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | w #) -> Just (W16# w)++toWord32 :: Scientific -> Maybe Word32+{-# INLINE toWord32 #-}+toWord32 (Scientific (I# coeff) (I# e) largeNum) = case toWord32# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | w #) -> Just (W32# w)++toInt32 :: Scientific -> Maybe Int32+{-# INLINE toInt32 #-}+toInt32 (Scientific (I# coeff) (I# e) largeNum) = case toInt32# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | w #) -> Just (I32# w)++toWord64 :: Scientific -> Maybe Word64+{-# INLINE toWord64 #-}+toWord64 (Scientific (I# coeff) (I# e) largeNum) = case toWord# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | w #) -> Just (W64# w)++toWord :: Scientific -> Maybe Word+{-# INLINE toWord #-}+toWord (Scientific (I# coeff) (I# e) largeNum) = case toWord# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | w #) -> Just (W# w)++toInt :: Scientific -> Maybe Int+{-# INLINE toInt #-}+toInt (Scientific (I# coeff) (I# e) largeNum) = case toInt# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | i #) -> Just (I# i)++toInt64 :: Scientific -> Maybe Int64+{-# INLINE toInt64 #-}+toInt64 (Scientific (I# coeff) (I# e) largeNum) = case toInt# coeff e largeNum of+  (# (# #) | #) -> Nothing+  (# | i #) -> Just (I64# (intToInt64# i))++-- | This can exhaust memory. Do not use on untrusted input.+toInteger :: Scientific -> Maybe Integer+toInteger (Scientific coeff e largeNum)+  | e == minBound = case largeNum of+      LargeScientific bigCoeff bigExp -> case compare bigExp 0 of+        GT -> Just (bigCoeff * ((10 :: Integer) ^ bigExp))+        EQ -> Just bigCoeff+        LT -> case attemptLargeNegativeExponentiate bigCoeff (Prelude.negate bigExp) of+          Nothing -> Nothing+          Just i -> Just i+  | otherwise = case compare e 0 of+      GT -> Just (Prelude.toInteger coeff * ((10 :: Integer) ^ e))+      EQ -> Just (Prelude.toInteger coeff)+      LT -> case attemptNegativeExponentiate coeff (Prelude.negate e) of+        Nothing -> Nothing+        Just i -> Just (Prelude.toInteger i)++-- The exponent argument must be non-negative, but we interpret it as+-- a negative number.+attemptNegativeExponentiate :: Int -> Int -> Maybe Int+attemptNegativeExponentiate c0 e0 = go c0 e0 where+  -- Note: This is unoptimized and has poor performance.+  go :: Int -> Int -> Maybe Int+  go !c !e = case compare e 0 of+    EQ -> Just c+    GT ->+      let c' = div c 10+       in if c' * 10 == c+            then go c' (e - 1)+            else Nothing+    LT -> errorWithoutStackTrace "attemptNegativeExponentiate: invariant violated"++-- The exponent argument must be non-negative, but we interpret it as+-- a negative number.+attemptLargeNegativeExponentiate :: Integer -> Integer -> Maybe Integer+attemptLargeNegativeExponentiate c0 e0 = go c0 e0 where+  -- Note: This is unoptimized and has poor performance.+  go :: Integer -> Integer -> Maybe Integer+  go !c !e = case compare e 0 of+    EQ -> Just c+    GT ->+      let c' = div c 10+       in if c' * 10 == c+            then go c' (e - 1)+            else Nothing+    LT -> errorWithoutStackTrace "attemptLargeNegativeExponentiate: invariant violated"++{- | This works even if the number has a fractional component. For example:++>>> roundShiftedToInt64 2 (fromFixed @E3 1.037)+103++The shift amount should be a small constant between -100 and 100.+The behavior of a shift outside this range is undefined.+-}+roundShiftedToInt64 ::+  -- | Exponent @e@, @n@ is multiplied by @10^e@ before rounding+  Int ->+  -- | Number @n@+  Scientific ->+  Maybe Int64+{-# INLINE roundShiftedToInt64 #-}+roundShiftedToInt64 (I# adj) (Scientific (I# coeff) (I# e) largeNum) =+  case roundToInt# coeff e adj largeNum of+    (# (# #) | #) -> Nothing+    (# | i #) -> Just (I64# (intToInt64# i))++-- | Convert a 64-bit unsigned word to a 'Scientific'.+fromWord64 :: Word64 -> Scientific+fromWord64 !w =+  if w <= 9223372036854775807+    then Scientific (fromIntegral w) 0 zeroLarge+    else+      let !b = LargeScientific (fromIntegral w) 0+       in Scientific 0 minBound b++fromInt :: Int -> Scientific+{-# INLINE fromInt #-}+fromInt coeff = Scientific coeff 0 zeroLarge++fromInt8 :: Int8 -> Scientific+{-# INLINE fromInt8 #-}+fromInt8 coeff = Scientific (fromIntegral coeff) 0 zeroLarge++fromInt16 :: Int16 -> Scientific+{-# INLINE fromInt16 #-}+fromInt16 coeff = Scientific (fromIntegral coeff) 0 zeroLarge++fromInt32 :: Int32 -> Scientific+{-# INLINE fromInt32 #-}+fromInt32 coeff = Scientific (fromIntegral coeff) 0 zeroLarge++fromInt64 :: Int64 -> Scientific+{-# INLINE fromInt64 #-}+fromInt64 coeff = Scientific (fromIntegral coeff) 0 zeroLarge++-- | Convert an 8-bit unsigned word to a 'Scientific'.+fromWord8 :: Word8 -> Scientific+{-# INLINE fromWord8 #-}+fromWord8 !w = Scientific (fromIntegral w) 0 zeroLarge++-- | Convert a 16-bit unsigned word to a 'Scientific'.+fromWord16 :: Word16 -> Scientific+{-# INLINE fromWord16 #-}+fromWord16 !w = Scientific (fromIntegral w) 0 zeroLarge++-- | Convert a 32-bit unsigned word to a 'Scientific'.+fromWord32 :: Word32 -> Scientific+{-# INLINE fromWord32 #-}+fromWord32 !w = Scientific (fromIntegral w) 0 zeroLarge++{- | Is the number represented in scientific notation greater than the+64-bit integer argument?+-}+greaterThanInt64 :: Scientific -> Int64 -> Bool+greaterThanInt64 (Scientific coeff0@(I# coeff0#) e0 large0) tgt@(I64# tgt#)+  | e0 == minBound = largeGreaterThanInt64 large0 tgt+  | coeff0 == 0 = 0 > tgt+  | e0 == 0 = I64# (intToInt64# coeff0#) > tgt+  | coeff0 > 0 =+      if+        | tgt <= 0 -> True+        | e0 > 0 -> case smallToInt coeff0 e0 of+            (# (# #) | #) -> True+            (# | i# #) -> I64# (intToInt64# i#) > tgt+        -- In last case, e0 is less than zero.+        | otherwise -> case posIntExp10 (I# (int64ToInt# tgt#)) (Prelude.negate e0) of+            (# (# #) | #) -> False+            (# | i# #) -> I64# (intToInt64# coeff0#) > I64# (intToInt64# i#)+  | otherwise -- Coefficent is negative+    =+      if+        | tgt >= 0 -> False+        | e0 > 0 -> case smallToInt coeff0 e0 of+            (# (# #) | #) -> False+            (# | i# #) -> I64# (intToInt64# i#) > tgt+        -- In last case, e0 is less than zero.+        | otherwise -> case negIntExp10 (I# (int64ToInt# tgt#)) (Prelude.negate e0) of+            (# (# #) | #) -> True+            (# | i# #) -> I64# (intToInt64# coeff0#) > I64# (intToInt64# i#)++largeGreaterThanInt64 :: LargeScientific -> Int64 -> Bool+largeGreaterThanInt64 large0@(LargeScientific coeff e) !tgt+  | coeff == 0 = 0 > tgt+  | e == 0 = coeff > fromIntegral @Int64 @Integer tgt+  | coeff > 0 =+      if+        | tgt <= 0 -> True+        | e > 0 -> case largeToInt large0 of+            (# (# #) | #) -> True+            (# | i# #) -> I64# (intToInt64# i#) > tgt+        | otherwise -> case posSciLowerBound False coeff e of+            Exactly n -> n > fromIntegral @Int64 @Integer tgt+            LowerBoundedMagnitude n -> (n + 1) > fromIntegral @Int64 @Integer tgt+  | otherwise -- Coefficent is negative+    =+      if+        | tgt >= 0 -> False+        | e > 0 -> case largeToInt large0 of+            (# (# #) | #) -> False+            (# | i# #) -> I64# (intToInt64# i#) > tgt+        | otherwise -> case posSciLowerBound False coeff e of+            Exactly n -> n > fromIntegral @Int64 @Integer tgt+            LowerBoundedMagnitude n -> n > fromIntegral @Int64 @Integer tgt++-- | Expose the non-normalized exponent and coefficient.+withExposed ::+  -- | Called when coefficient and exponent are small+  (Int -> Int -> a) ->+  -- | Called when coefficient and exponent are large+  (Integer -> Integer -> a) ->+  Scientific ->+  a+withExposed f g (Scientific coeff theExp big) =+  if theExp /= minBound+    then f coeff theExp+    else case big of+      LargeScientific coeff' theExp' -> g coeff' theExp'++toSmallHelper ::+  (Int -> Int -> (# (# #) | Word# #)) -> -- small+  (LargeScientific -> (# (# #) | Word# #)) -> -- large+  Int# ->+  Int# ->+  LargeScientific ->+  (# (# #) | Word# #)+{-# INLINE toSmallHelper #-}+toSmallHelper fromSmall fromLarge coefficient0# exponent0# large0 =+  if exponent0 /= minBound+    then fromSmall coefficient0 exponent0+    else fromLarge large0+ where+  coefficient0 = I# coefficient0#+  exponent0 = I# exponent0#++toSmallIntHelper ::+  (Int -> Int -> (# (# #) | Int# #)) -> -- small+  (LargeScientific -> (# (# #) | Int# #)) -> -- large+  Int# ->+  Int# ->+  LargeScientific ->+  (# (# #) | Int# #)+{-# INLINE toSmallIntHelper #-}+toSmallIntHelper fromSmall fromLarge coefficient0# exponent0# large0 =+  if exponent0 /= minBound+    then fromSmall coefficient0 exponent0+    else fromLarge large0+ where+  coefficient0 = I# coefficient0#+  exponent0 = I# exponent0#++toWord8# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)+{-# NOINLINE toWord8# #-}+toWord8# coefficient0# exponent0# large0 =+  toSmallHelper+    smallToWord8+    largeToWord8+    coefficient0#+    exponent0#+    large0++toWord16# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)+{-# NOINLINE toWord16# #-}+toWord16# coefficient0# exponent0# largeNum =+  toSmallHelper+    smallToWord16+    largeToWord16+    coefficient0#+    exponent0#+    largeNum++toWord32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)+{-# NOINLINE toWord32# #-}+toWord32# coefficient0# exponent0# largeNum =+  toSmallHelper+    smallToWord32+    largeToWord32+    coefficient0#+    exponent0#+    largeNum++toInt32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)+{-# NOINLINE toInt32# #-}+toInt32# coefficient0# exponent0# largeNum =+  toSmallIntHelper+    smallToInt32+    largeToInt32+    coefficient0#+    exponent0#+    largeNum++toWord# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)+{-# NOINLINE toWord# #-}+toWord# coefficient0# exponent0# largeNum =+  toSmallHelper+    smallToWord+    largeToWord+    coefficient0#+    exponent0#+    largeNum++toInt# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)+{-# NOINLINE toInt# #-}+toInt# coefficient0# exponent0# largeNum =+  toSmallIntHelper+    smallToInt+    largeToInt+    coefficient0#+    exponent0#+    largeNum++roundToInt# :: Int# -> Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)+{-# NOINLINE roundToInt# #-}+roundToInt# coefficient0# exponent0# adjustment0# largeNum =+  if exponent0 /= minBound+    then+      if+        | coefficient0 == 0 -> (# | 0# #)+        | exponent0 > (maxBound - 200) -> (# (# #) | #)+        | exponent0 < (minBound + 200) -> (# (# #) | #)+        | adjustment0 > 100 -> (# (# #) | #)+        | adjustment0 < (-100) -> (# (# #) | #)+        | otherwise ->+            roundSmallToInt coefficient0 (I# (exponent0# +# adjustment0#))+    else roundLargeToInt adjustment0 largeNum+ where+  coefficient0 = I# coefficient0#+  exponent0 = I# exponent0#+  adjustment0 = I# adjustment0#++-- Arguments are non-normalized coefficient and exponent.+-- We cannot use the same trick that we use for Word8 and+-- Word16.+smallToWord32 :: Int -> Int -> (# (# #) | Word# #)+smallToWord32 !coefficient0 !exponent0+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- incrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 10+  , coefficient >= 0+  , coefficient <= 0xFFFFFFFF =+      word32Exp10 (fromIntegral @Int @Word coefficient) expon+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized coefficient and exponent.+smallToInt32 :: Int -> Int -> (# (# #) | Int# #)+smallToInt32 !coefficient0 !exponent0+  | coefficient0 == 0 = (# | 0# #)+  | (coefficient, expon) <- incrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 10+  , coefficient >= fromIntegral @Int32 @Int (minBound :: Int32)+  , coefficient <= fromIntegral @Int32 @Int (maxBound :: Int32) =+      if coefficient >= 0+        then posInt32Exp10 coefficient expon+        else negInt32Exp10 coefficient expon+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized coefficient and exponent.+-- We cannot use the same trick that we use for Word8 and+-- Word16.+smallToWord :: Int -> Int -> (# (# #) | Word# #)+smallToWord !coefficient0 !exponent0+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- incrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 30+  , coefficient >= 0 =+      wordExp10 (fromIntegral @Int @Word coefficient) expon+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized coefficient and exponent.+smallToInt :: Int -> Int -> (# (# #) | Int# #)+smallToInt !coefficient0 !exponent0+  | coefficient0 == 0 = (# | 0# #)+  | (coefficient, expon) <- incrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 30 =+      if coefficient >= 0+        then posIntExp10 coefficient expon+        else negIntExp10 coefficient expon+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized coefficient and exponent.+-- This is similar to smallToInt except that we round numbers with fractional+-- parts. And by round, I actually mean truncate. Fractional parts only show+-- up when the exponent is negative.+roundSmallToInt :: Int -> Int -> (# (# #) | Int# #)+roundSmallToInt !coefficient0 !exponent0+  | coefficient0 == 0 = (# | 0# #)+  | (coefficient@(I# coefficient#), expon) <- incrementNegativeExp coefficient0 exponent0+  , expon < 30 = case compare expon 0 of+      EQ -> (# | coefficient# #)+      GT ->+        if coefficient >= 0+          then posIntExp10 coefficient expon+          else negIntExp10 coefficient expon+      LT ->+        if coefficient >= 0+          then (# | roundPosIntNegExp10 coefficient expon #)+          else (# | roundNegIntNegExp10 coefficient expon #)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized coefficient and exponent+-- With Word16, we can do a neat little trick where we+-- cap the coefficient at 65536 and the exponent at 5. This+-- works because a 32-bit signed int can contain 65535e4.+smallToWord16 :: Int -> Int -> (# (# #) | Word# #)+smallToWord16 !coefficient0 !exponent0+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- incrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 5+  , coefficient >= 0+  , coefficient < 65536+  , r <- exp10 coefficient expon+  , y@(W16# y#) <- fromIntegral @Int @Word16 r+  , fromIntegral @Word16 @Int y == r =+      (# | y# #)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized coefficient and exponent+-- With Word8, we can do a neat little trick where we+-- cap the coefficient at 256 and the exponent at 3. This+-- works because a 32-bit signed int can contain 255e2.+smallToWord8 :: Int -> Int -> (# (# #) | Word# #)+smallToWord8 !coefficient0 !exponent0+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- incrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 3+  , coefficient >= 0+  , coefficient < 256+  , r <- exp10 coefficient expon+  , y@(W8# y#) <- fromIntegral @Int @Word8 r+  , fromIntegral @Word8 @Int y == r =+      (# | y# #)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized+largeToWord8 :: LargeScientific -> (# (# #) | Word# #)+largeToWord8 (LargeScientific coefficient0 exponent0)+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- largeIncrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 3+  , coefficient >= 0+  , coefficient < 256+  , r <- exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+  , y@(W8# y#) <- fromIntegral @Int @Word8 r+  , fromIntegral @Word8 @Int y == r =+      (# | y# #)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized+largeToWord16 :: LargeScientific -> (# (# #) | Word# #)+largeToWord16 (LargeScientific coefficient0 exponent0)+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- largeIncrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 5+  , coefficient >= 0+  , coefficient < 65536+  , r <- exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+  , y@(W16# y#) <- fromIntegral @Int @Word16 r+  , fromIntegral @Word16 @Int y == r =+      (# | y# #)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized+largeToWord32 :: LargeScientific -> (# (# #) | Word# #)+largeToWord32 (LargeScientific coefficient0 exponent0)+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- largeIncrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 10+  , coefficient >= 0+  , coefficient <= 0xFFFFFFFF =+      word32Exp10 (fromIntegral @Integer @Word coefficient) (fromIntegral @Integer @Int expon)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized, this targets the native word size+largeToWord :: LargeScientific -> (# (# #) | Word# #)+largeToWord (LargeScientific coefficient0 exponent0)+  | coefficient0 == 0 = (# | 0## #)+  | (coefficient, expon) <- largeIncrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 30+  , coefficient >= 0+  , coefficient <= (fromIntegral @Word @Integer maxBound) =+      wordExp10 (fromIntegral @Integer @Word coefficient) (fromIntegral @Integer @Int expon)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized+largeToInt32 :: LargeScientific -> (# (# #) | Int# #)+largeToInt32 (LargeScientific coefficient0 exponent0)+  | coefficient0 == 0 = (# | 0# #)+  | (coefficient, expon) <- largeIncrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 10+  , coefficient >= (fromIntegral @Int32 @Integer minBound)+  , coefficient <= (fromIntegral @Int32 @Integer maxBound) =+      if coefficient >= 0+        then posInt32Exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+        else negInt32Exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized, this targets the native word size+largeToInt :: LargeScientific -> (# (# #) | Int# #)+largeToInt (LargeScientific coefficient0 exponent0)+  | coefficient0 == 0 = (# | 0# #)+  | (coefficient, expon) <- largeIncrementNegativeExp coefficient0 exponent0+  , expon >= 0+  , expon < 30+  , coefficient >= (fromIntegral @Int @Integer minBound)+  , coefficient <= (fromIntegral @Int @Integer maxBound) =+      if coefficient >= 0+        then posIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+        else negIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+  | otherwise = (# (# #) | #)++-- Arguments are non-normalized, this targets the native word size+roundLargeToInt :: Int -> LargeScientific -> (# (# #) | Int# #)+roundLargeToInt !adj (LargeScientific coefficient0 exponent0)+  | coefficient0 == 0 = (# | 0# #)+  | (coefficient, expon) <- largeIncrementNegativeExp coefficient0 exponent1+  , expon < 30 =+      case compare expon 0 of+        EQ -> case fromIntegral @Integer @Int coefficient of+          I# r -> (# | r #)+        GT ->+          if coefficient >= (fromIntegral @Int @Integer minBound) && coefficient <= (fromIntegral @Int @Integer maxBound)+            then+              if coefficient >= 0+                then posIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+                else negIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)+            else (# (# #) | #)+        LT ->+          if expon < (-100_000_000_000)+            then -- Due to the realities of hardward, a negative exponent with high+            -- magnitude is guaranteed to produce a zero result. A coefficient+            -- large enough to resist the zero result would consume all memory.+              (# | 0# #)+            else+              if coefficient >= 0+                then roundPosIntegerNegExp10 coefficient (fromInteger expon)+                else roundNegIntegerNegExp10 coefficient (fromInteger expon)+  | otherwise = (# (# #) | #)+ where+  exponent1 = exponent0 + Prelude.toInteger adj++-- Precondition: the exponent is non-negative. This returns+-- an unboxed Nothing on overflow. This implementation should+-- work even on a 32-bit platform.+word32Exp10 :: Word -> Int -> (# (# #) | Word# #)+word32Exp10 !a@(W# a#) !e = case e of+  0 -> (# | a# #)+  _ ->+    let (overflow, a') = timesWord2 a 10+     in if overflow || (a' > 0xFFFFFFFF)+          then (# (# #) | #)+          else word32Exp10 a' (e - 1)++-- Precondition: the exponent is non-negative, and the+-- coefficient is non-negative. This returns an unboxed+-- Nothing on overflow.+posInt32Exp10 :: Int -> Int -> (# (# #) | Int# #)+posInt32Exp10 !a@(I# a#) !e = case e of+  0 -> (# | a# #)+  _ ->+    if a < posInt32PreUpper+      then+        let a' = a * 10+         in if a' >= a && a' <= fromIntegral (maxBound :: Int32)+              then posInt32Exp10 a' (e - 1)+              else (# (# #) | #)+      else (# (# #) | #)++-- Precondition: the exponent is non-negative, and the+-- coefficient is non-positive. This returns an unboxed+-- Nothing on overflow.+negInt32Exp10 :: Int -> Int -> (# (# #) | Int# #)+negInt32Exp10 !a@(I# a#) !e = case e of+  0 -> (# | a# #)+  _ ->+    if a > negInt32PreLower+      then+        let a' = a * 10+         in if a' <= a && a' >= fromIntegral (minBound :: Int32)+              then negInt32Exp10 a' (e - 1)+              else (# (# #) | #)+      else (# (# #) | #)++-- Precondition: the exponent is non-negative. This returns+-- an unboxed Nothing on overflow.+wordExp10 :: Word -> Int -> (# (# #) | Word# #)+wordExp10 !a@(W# a#) !e = case e of+  0 -> (# | a# #)+  _ ->+    let (overflow, a') = timesWord2 a 10+     in if overflow+          then (# (# #) | #)+          else wordExp10 a' (e - 1)++-- Precondition: The exponent is non-negative, and the+-- coefficient is non-negative. This returns an unboxed+-- Nothing on overflow.+posIntExp10 :: Int -> Int -> (# (# #) | Int# #)+posIntExp10 !a@(I# a#) !e = case e of+  0 -> (# | a# #)+  _ ->+    if a < posIntPreUpper+      then+        let a' = a * 10+         in if a' >= a+              then posIntExp10 a' (e - 1)+              else (# (# #) | #)+      else (# (# #) | #)++-- Precondition: The exponent is non-positive, and the+-- coefficient is non-negative. This returns an unboxed+-- Nothing on overflow.+roundPosIntNegExp10 :: Int -> Int -> Int#+roundPosIntNegExp10 !a@(I# a#) !e = case e of+  0 -> a#+  _ -> roundPosIntNegExp10 (quot a 10) (e + 1)++-- Precondition: The exponent is non-positive, and the+-- coefficient is non-negative. This returns an unboxed+-- Nothing on overflow.+roundPosIntegerNegExp10 :: Integer -> Int -> (# (# #) | Int# #)+roundPosIntegerNegExp10 !a !e = case e of+  0 ->+    if a > fromIntegral @Int @Integer maxBound+      then (# (# #) | #)+      else case fromInteger a of+        I# a# -> (# | a# #)+  _ -> case a of+    0 -> (# | 0# #)+    _ -> roundPosIntegerNegExp10 (quot a 10) (e + 1)++-- Precondition: The exponent is non-negative, and the+-- coefficient is non-positive. This returns an unboxed+-- Nothing on overflow.+negIntExp10 :: Int -> Int -> (# (# #) | Int# #)+negIntExp10 !a@(I# a#) !e = case e of+  0 -> (# | a# #)+  _ ->+    if a > negIntPreLower+      then+        let a' = a * 10+         in if a' <= a+              then negIntExp10 a' (e - 1)+              else (# (# #) | #)+      else (# (# #) | #)++-- Precondition: The exponent is non-position, and the+-- coefficient is non-positive. This returns an unboxed+-- Nothing on overflow.+roundNegIntNegExp10 :: Int -> Int -> Int#+roundNegIntNegExp10 !a@(I# a#) !e = case e of+  0 -> a#+  _ -> roundNegIntNegExp10 (quot a 10) (e + 1)++-- Precondition: The exponent is non-position, and the+-- coefficient is non-positive. This returns an unboxed+-- Nothing on overflow.+roundNegIntegerNegExp10 :: Integer -> Int -> (# (# #) | Int# #)+roundNegIntegerNegExp10 !a !e = case e of+  0 ->+    if a > fromIntegral @Int @Integer maxBound+      then (# (# #) | #)+      else case fromInteger a of+        I# a# -> (# | a# #)+  _ -> case a of+    0 -> (# | 0# #)+    _ -> roundNegIntegerNegExp10 (quot a 10) (e + 1)++-- What are these lower and upper bounds? The problem that+-- we are trying to solve is that overflow is tricky to detect+-- when we multiply by ten. By putting an upper (or lower)+-- bound on the thing we are multiplying by ten, we can+-- make overflow detection simple: just test that the+-- accumulator became larger (or smaller when dealing with+-- a negative coefficient) than it previously was.++posIntPreUpper :: Int+posIntPreUpper = div maxBound 10 + 10++negIntPreLower :: Int+negIntPreLower = div minBound 10 - 10++posInt32PreUpper :: Int+posInt32PreUpper = 214748370++negInt32PreLower :: Int+negInt32PreLower = (-214748370)++-- Bool is true if overflow happened+timesWord2 :: Word -> Word -> (Bool, Word)+timesWord2 (W# a) (W# b) =+  let !(# c, r #) = Exts.timesWord2# a b+   in (case c of 0## -> False; _ -> True, W# r)++-- Precondition: the exponent is non-negative+exp10 :: Int -> Int -> Int+exp10 !a !e = case e of+  0 -> a+  _ -> exp10 (a * 10) (e - 1)++largeNormalize :: LargeScientific -> LargeScientific+largeNormalize s@(LargeScientific w _) = case w of+  0 -> LargeScientific 0 0+  _ -> largeNormalizeLoop s++-- Precondition: the coefficient is non-zero+largeNormalizeLoop :: LargeScientific -> LargeScientific+largeNormalizeLoop (LargeScientific w e) = case quotRem w 10 of+  (q, r) -> case r of+    0 -> largeNormalizeLoop (LargeScientific q (e + 1))+    _ -> LargeScientific w e++largeIncrementNegativeExp :: Integer -> Integer -> (Integer, Integer)+largeIncrementNegativeExp w e =+  if e >= 0+    then (w, e)+    else case quotRem w 10 of+      (q, r) -> case r of+        0 -> largeIncrementNegativeExp q (e + 1)+        _ -> (w, e)++smallNormalize :: Int -> Int -> (Int, Int)+smallNormalize (I# w) (I# e) = case w of+  0# -> (0, 0)+  _ -> case smallNormalize# w e of+    (# w', e' #) -> (I# w', I# e')++incrementNegativeExp :: Int -> Int -> (Int, Int)+incrementNegativeExp (I# w) (I# e) = case incrementNegativeExp# w e of+  (# w', e' #) -> (I# w', I# e')++-- If the exponent is negative, increase it as long as the+-- coefficient divides ten evenly.+-- This only ever causes the coefficient to decrease, never increase.+incrementNegativeExp# :: Int# -> Int# -> (# Int#, Int# #)+{-# NOINLINE incrementNegativeExp# #-}+incrementNegativeExp# w# e# =+  if I# e# >= 0+    then (# w#, e# #)+    else case quotRem (I# w#) 10 of+      (I# q#, r) -> case r of+        0 -> incrementNegativeExp# q# (e# +# 1#)+        _ -> (# w#, e# #)++-- Precondition: coefficient is not zero. If it is,+-- this will loop.+smallNormalize# :: Int# -> Int# -> (# Int#, Int# #)+{-# NOINLINE smallNormalize# #-}+smallNormalize# w# e# = case quotRem (I# w#) 10 of+  (I# q#, r) -> case r of+    0 -> smallNormalize# q# (e# +# 1#)+    _ -> (# w#, e# #)++{- | Parse a number that is encoded in UTF-8 and in scientific notation.+All of these are accepted:++* 330e-1+* 330e+1+* 330e1+* 330.0e1+* -330.0e1+* 12+* 00012+* 2.05+* +2.05+* +33.6e+1+-}+parserSignedUtf8Bytes :: e -> Parser e s Scientific+parserSignedUtf8Bytes e = boxScientific (parserSignedUtf8Bytes# e)++{- | Variant of 'parserSignedUtf8Bytes' that rejects strings with+a leading plus or minus sign.+-}+parserUnsignedUtf8Bytes :: e -> Parser e s Scientific+parserUnsignedUtf8Bytes e = boxScientific (parserUnsignedUtf8Bytes# e)++-- | Variant of 'parserUnsignedUtf8Bytes' that negates the result.+parserNegatedUtf8Bytes :: e -> Parser e s Scientific+parserNegatedUtf8Bytes e = boxScientific (parserNegatedUtf8Bytes# e)++parserTrailingUtf8Bytes# ::+  -- | Error message+  e ->+  -- | Leading digit+  Int# ->+  Parser e s Scientific#+{-# NOINLINE parserTrailingUtf8Bytes# #-}+parserTrailingUtf8Bytes# e leader =+  mapIntPairToScientific (parseSmallTrailing# leader)+    `orElseScientific` upcastLargeScientific (parseLargeTrailing e (I# leader))++parserNegatedTrailingUtf8Bytes# ::+  -- | Error message+  e ->+  -- | Leading digit+  Int# ->+  Parser e s Scientific#+{-# NOINLINE parserNegatedTrailingUtf8Bytes# #-}+parserNegatedTrailingUtf8Bytes# e leader =+  mapNegateIntPairToScientific (parseSmallTrailing# leader)+    `orElseScientific` upcastNegatedLargeScientific (parseLargeTrailing e (I# leader))++parserSignedUtf8Bytes# ::+  -- | Error message+  e ->+  Parser e s Scientific#+parserSignedUtf8Bytes# e =+  Latin.any e `bindToScientific` \c -> case c of+    '+' -> parserUnsignedUtf8Bytes# e+    '-' -> parserNegatedUtf8Bytes# e+    _ ->+      Unsafe.unconsume 1 `bindToScientific` \_ ->+        parserUnsignedUtf8Bytes# e++{- | Variant of 'parseUnsignedUtf8Bytes' where all arguments are+unboxed.+-}+parserUnsignedUtf8Bytes# ::+  -- | Error message+  e ->+  Parser e s Scientific#+parserUnsignedUtf8Bytes# e =+  mapIntPairToScientific parseSmall#+    `orElseScientific` upcastLargeScientific (parseLarge e)++-- Negates the result after parsing the bytes.+parserNegatedUtf8Bytes# ::+  -- | Error message+  e ->+  Parser e s Scientific#+parserNegatedUtf8Bytes# e =+  mapNegateIntPairToScientific parseSmall#+    `orElseScientific` upcastNegatedLargeScientific (parseLarge e)++parserTrailingUtf8Bytes ::+  -- | Error message+  e ->+  -- | Leading digit, should be between @-9@ and @9@.+  Int ->+  Parser e s Scientific+parserTrailingUtf8Bytes e (I# leader) =+  boxScientific (parserTrailingUtf8Bytes# e leader)++parserNegatedTrailingUtf8Bytes ::+  -- | Error message+  e ->+  -- | Leading digit, should be between @-9@ and @9@.+  Int ->+  Parser e s Scientific+parserNegatedTrailingUtf8Bytes e (I# leader) =+  boxScientific (parserNegatedTrailingUtf8Bytes# e leader)++--+-- parserTrailingUtf8Bytes# ::+--      e -- Error message+--   -> Parser e s Scientific#+-- parserTrailingUtf8Bytes# !leader e =+--   parseSmall# leader+--   `orElseScientific`+--   unboxScientific (P.fail e)++parseLarge :: e -> Parser e s LargeScientific+parseLarge e = do+  coeff <- Latin.decUnsignedInteger e+  parseLargeCommon e coeff++parseLargeTrailing :: e -> Int -> Parser e s LargeScientific+parseLargeTrailing e !leader = do+  coeff <- Latin.decTrailingInteger leader+  parseLargeCommon e coeff++parseLargeCommon :: e -> Integer -> Parser e s LargeScientific+{-# NOINLINE parseLargeCommon #-}+parseLargeCommon e coeff = do+  Latin.trySatisfyThen (pure (LargeScientific coeff 0)) $ \c -> case c of+    '.' -> Just $ do+      !start <- Unsafe.cursor+      afterDot <- Latin.decUnsignedInteger e+      !end <- Unsafe.cursor+      let !logDenom = end - start+          !coeffFinal = (integerTenExp coeff logDenom) + afterDot+      Latin.trySatisfy (\ch -> ch == 'e' || ch == 'E') >>= \case+        True -> attemptLargeExp e coeffFinal (unI (Prelude.negate logDenom))+        False -> pure $! LargeScientific coeffFinal $! fromIntegral $! Prelude.negate logDenom+    'e' -> Just (attemptLargeExp e coeff 0#)+    'E' -> Just (attemptLargeExp e coeff 0#)+    _ -> Nothing++-- handles unsigned small numbers+parseSmall# :: Parser () s (# Int#, Int# #)+parseSmall# =+  Latin.decUnsignedInt# () `Parser.bindFromIntToIntPair` \coeff# ->+    parseSmallCommon# coeff#++parseSmallTrailing# :: Int# -> Parser () s (# Int#, Int# #)+parseSmallTrailing# leader =+  Latin.decTrailingInt# () leader `Parser.bindFromIntToIntPair` \coeff# ->+    parseSmallCommon# coeff#++parseSmallCommon# :: Int# -> Parser () s (# Int#, Int# #)+{-# NOINLINE parseSmallCommon# #-}+parseSmallCommon# coeff# =+  Latin.trySatisfyThen (Parser.pureIntPair (# coeff#, 0# #)) $ \c -> case c of+    '.' ->+      Just $+        Unsafe.cursor `Parser.bindFromLiftedToIntPair` \start ->+          Latin.decUnsignedInt# () `Parser.bindFromIntToIntPair` \afterDot# ->+            Unsafe.cursor `Parser.bindFromLiftedToIntPair` \end ->+              let !logDenom = end - start+                  goCoeff !coeffShifted !expon = case expon of+                    0 ->+                      let !(I# coeffShifted#) = coeffShifted+                          !(# coeffFinal, overflowed #) =+                            Exts.addIntC# coeffShifted# afterDot#+                       in case overflowed of+                            0# ->+                              Latin.trySatisfy (\ch -> ch == 'e' || ch == 'E') `Parser.bindFromLiftedToIntPair` \b -> case b of+                                True -> attemptSmallExp coeffFinal (unI (Prelude.negate logDenom))+                                False -> Parser.pureIntPair (# coeffFinal, unI (Prelude.negate logDenom) #)+                            _ -> Parser.failIntPair ()+                    _ ->+                      let coeffShifted' = coeffShifted * 10+                       in if coeffShifted' >= coeffShifted+                            then goCoeff coeffShifted' (expon - 1)+                            else -- If we overflow, fail so that the parser+                            -- for large number will handle it instead.+                              Parser.failIntPair ()+               in goCoeff (I# coeff#) logDenom+    'e' -> Just (attemptSmallExp coeff# 0#)+    'E' -> Just (attemptSmallExp coeff# 0#)+    _ -> Nothing++-- The delta passed to this is only ever a negative integer.+attemptLargeExp ::+  e ->+  Integer ->+  Int# ->+  Parser e s LargeScientific+{-# NOINLINE attemptLargeExp #-}+attemptLargeExp e signedCoeff !deltaExp# = do+  expon <- Latin.decSignedInteger e+  let !exponent' = expon + fromIntegral (I# deltaExp#)+  pure (LargeScientific signedCoeff exponent')++-- The delta passed to this is only ever a negative integer.+-- It is also between -21 and -1. (Or maybe -22 or -20, not sure).+attemptSmallExp :: Int# -> Int# -> Parser () s (# Int#, Int# #)+{-# NOINLINE attemptSmallExp #-}+attemptSmallExp !signedCoeff# !deltaExp# = Parser.unboxIntPair $ do+  e <- Latin.decSignedInt ()+  -- I give this a little extra padding just to be safe.+  if e > (minBound + padding)+    then pure (signedCoeff, e + deltaExp)+    else Parser.fail ()+ where+  signedCoeff = I# signedCoeff#+  deltaExp = I# deltaExp#++{- | Convert a 'Word#' parser to a 'Word32' parser. Precondition:+the argument parser only returns words less than 4294967296.+-}+boxScientific :: Parser s e Scientific# -> Parser s e Scientific+boxScientific (Parser f) =+  Parser+    ( \x s0 -> case f x s0 of+        (# s1, r #) -> case r of+          (# e | #) -> (# s1, (# e | #) #)+          (# | (# (# w, y, z #), b, c #) #) -> (# s1, (# | (# Scientific (I# w) (I# y) z, b, c #) #) #)+    )++unI :: Int -> Int#+unI (I# i) = i++orElseScientific :: Parser x s Scientific# -> Parser e s Scientific# -> Parser e s Scientific#+{-# INLINE orElseScientific #-}+orElseScientific (Parser f) (Parser g) =+  Parser+    ( \x s0 -> case f x s0 of+        (# s1, r0 #) -> case r0 of+          (# _ | #) -> g x s1+          (# | r #) -> (# s1, (# | r #) #)+    )++-- Precondition: argument is non-negative+-- If the argument is r and the exponent is e, the result+-- is described as: r * 10^e+integerTenExp :: Integer -> Int -> Integer+integerTenExp !r !e = case e of+  0 -> r+  1 -> r * 10+  2 -> r * 100+  3 -> r * 1000+  4 -> r * 10000+  5 -> r * 100000+  6 -> r * 1000000+  7 -> r * 10000000+  8 -> r * 100000000+  _ -> integerTenExp (r * 1000000000) (e - 9)++data Estimate+  = Exactly !Integer+  | LowerBoundedMagnitude !Integer++-- For positive N, LowerBoundedMagnitude N means that x > N and x < N+1.+-- For negative N, LowerBoundedMagnitude N means that x < N and x > N-1.++-- Precondition: Exponent is non-positive. Coefficient is non-zero.+-- When calling this from elsewhere, set wasTruncated to False.+posSciLowerBound :: Bool -> Integer -> Integer -> Estimate+posSciLowerBound !wasTruncated !coeff !e+  | e == 0 = case wasTruncated of+      True -> LowerBoundedMagnitude coeff+      False -> Exactly coeff+  | otherwise =+      let (q, r) = quotRem coeff 10+       in case q of+            0 -> LowerBoundedMagnitude 0+            _ -> posSciLowerBound (wasTruncated || r /= 0) q (e + 1)++-- This only works if the number is a power of ten.+-- It is only intended to be used by fromFixed.+-- Precondition: the Integer is not zero.+logBase10 :: Int -> Integer -> Int+logBase10 !acc i =+  if i == 1+    then acc+    else logBase10 (acc + 1) (div i 10)++upcastLargeScientific ::+  Parser e s LargeScientific ->+  Parser e s Scientific#+upcastLargeScientific (Parser g) =+  Parser+    ( \x s0 -> case g x s0 of+        (# s1, r #) -> case r of+          (# e | #) -> (# s1, (# e | #) #)+          (# | (# a, b, c #) #) -> (# s1, (# | (# (# 0#, unI minBound, a #), b, c #) #) #)+    )++upcastNegatedLargeScientific ::+  Parser e s LargeScientific ->+  Parser e s Scientific#+upcastNegatedLargeScientific (Parser g) =+  Parser+    ( \x s0 -> case g x s0 of+        (# s1, r #) -> case r of+          (# e | #) -> (# s1, (# e | #) #)+          (# | (# LargeScientific w y, b, c #) #) -> (# s1, (# | (# (# 0#, unI minBound, LargeScientific (Prelude.negate w) y #), b, c #) #) #)+    )++mapIntPairToScientific ::+  Parser e s (# Int#, Int# #) ->+  Parser e s Scientific#+mapIntPairToScientific (Parser g) =+  Parser+    ( \x s0 -> case g x s0 of+        (# s1, r #) -> case r of+          (# e | #) -> (# s1, (# e | #) #)+          (# | (# (# y, z #), b, c #) #) -> (# s1, (# | (# (# y, z, zeroLarge #), b, c #) #) #)+    )++-- We do not check to see if exponent==minBound since this is called+-- on the result of an unsigned parser. Fortunately, signed fixed-width+-- integers always have one extra number on the low end that is not the+-- negation of anything on the high end.+mapNegateIntPairToScientific ::+  Parser e s (# Int#, Int# #) ->+  Parser e s Scientific#+mapNegateIntPairToScientific (Parser g) =+  Parser+    ( \x s0 -> case g x s0 of+        (# s1, r #) -> case r of+          (# e | #) -> (# s1, (# e | #) #)+          (# | (# (# y, z #), b, c #) #) -> (# s1, (# | (# (# Exts.negateInt# y, z, zeroLarge #), b, c #) #) #)+    )++bindToScientific :: Parser s e a -> (a -> Parser s e Scientific#) -> Parser s e Scientific#+{-# INLINE bindToScientific #-}+bindToScientific (Parser f) g =+  Parser+    ( \x@(# arr, _, _ #) s0 -> case f x s0 of+        (# s1, r0 #) -> case r0 of+          (# e | #) -> (# s1, (# e | #) #)+          (# | (# y, b, c #) #) ->+            runParser (g y) (# arr, b, c #) s1+    )++{- | Encode a number as text. If the exponent is between -50 and +50 (exclusive),+this represents the number without any exponent. For example:++>>> encode (small 87654321 (-3))+"87654.321"+>>> encode (small 5000 (-3))+"-5000"++The decision of when to use an exponent is not considered stable part of+this library\'s API. Check the test suite for examples of what to expect,+and feel free to open an issue or contribute if the output of this function+is unsightly in certain situations.+-}+encode :: Scientific -> ShortText+encode s = case Chunks.concatU (Builder.run 128 (builderUtf8 s)) of+  ByteArray x -> TS.fromShortByteStringUnsafe (SBS x)++-- | Variant of 'encode' that provides a builder instead.+builderUtf8 :: Scientific -> Builder+builderUtf8 (Scientific coeff e big)+  | e == 0 = Builder.intDec coeff+  | e == minBound =+      let LargeScientific coeff' e' = big+       in if+            | coeff' == 0 -> Builder.ascii '0'+            | e' == 0 -> Builder.integerDec coeff'+            | e' > 0 && e' < 50 ->+                -- TODO: Add a replicate function to builder to improve this.+                Builder.integerDec coeff' <> Builder.bytes (Bytes.replicate (fromInteger e') 0x30)+            | e' < 0+            , e' > (-50)+            , coeff' > 0+            , coeff' < 18446744073709551616 ->+                let coeff'' = fromInteger coeff' :: Word+                    e'' = fromInteger e' :: Int+                 in Builder.bytes (encodePosCoeffNegExp coeff'' e'')+            | e' < 0+            , e' > (-50)+            , coeff' < 0+            , coeff' > (-18446744073709551616) ->+                let coeff'' = fromInteger (Prelude.negate coeff') :: Word+                    e'' = fromInteger e' :: Int+                 in Builder.bytes (encodeNegCoeffNegExp coeff'' e'')+            | otherwise ->+                Builder.integerDec coeff'+                  <> Builder.ascii 'e'+                  <> Builder.integerDec e'+  | otherwise =+      if+        | coeff == 0 -> Builder.ascii '0'+        | e > 0 && e < 50 ->+            -- TODO: Add a replicate function to builder to improve this.+            Builder.intDec coeff <> Builder.bytes (Bytes.replicate e 0x30)+        | e < 0 && e > (-50) ->+            if coeff > 0+              then Builder.bytes (encodePosCoeffNegExp (fromIntegral @Int @Word coeff) e)+              else Builder.bytes (encodeNegCoeffNegExp (fromIntegral @Int @Word (Prelude.negate coeff)) e)+        | otherwise ->+            Builder.fromBounded Nat.constant $+              BB.intDec coeff+                `BB.append` BB.ascii 'e'+                `BB.append` BB.intDec e++-- Precondition: exponent is negative.+-- This is convoluted, so if a reader of this code thinks of a better+-- way to do this, feel free to PR a more simple replacement.+encodePosCoeffNegExp :: Word -> Int -> Bytes+encodePosCoeffNegExp !w !e = runST $ do+  dst <- PM.newByteArray 128+  PM.setByteArray dst 0 128 (0x30 :: Word8)+  end <- BBU.pasteST (BB.wordDec w) dst 100+  let dotIx = end + e+  let coeffMag = end - 100+  let extra =+        if coeffMag > Prelude.negate e+          then (coeffMag - Prelude.negate e) - 1+          else 0+  PM.moveByteArray dst 0 dst 1 dotIx+  PM.writeByteArray dst (dotIx - 1) (0x2E :: Word8)+  dst' <- PM.unsafeFreezeByteArray dst+  pure+    Bytes+      { BT.array = dst'+      , BT.offset = dotIx - 2 - extra+      , BT.length = Prelude.negate e + 2 + extra+      }++-- Precondition: exponent is negative.+-- This is convoluted, so if a reader of this code thinks of a better+-- way to do this, feel free to PR a more simple replacement.+encodeNegCoeffNegExp :: Word -> Int -> Bytes+encodeNegCoeffNegExp !w !e = runST $ do+  dst <- PM.newByteArray 128+  PM.setByteArray dst 0 128 (0x30 :: Word8)+  end <- BBU.pasteST (BB.wordDec w) dst 100+  let dotIx = end + e+  let coeffMag = end - 100+  let extra =+        if coeffMag > Prelude.negate e+          then (coeffMag - Prelude.negate e) - 1+          else 0+  PM.moveByteArray dst 0 dst 1 dotIx+  PM.writeByteArray dst (dotIx - 1) (0x2E :: Word8)+  PM.writeByteArray dst (dotIx - 3 - extra) (0x2D :: Word8)+  dst' <- PM.unsafeFreezeByteArray dst+  pure+    Bytes+      { BT.array = dst'+      , BT.offset = dotIx - 3 - extra+      , BT.length = Prelude.negate e + 3 + extra+      }

@@ -1,27 +1,27 @@-{-# language BangPatterns #-}-{-# language NumericUnderscores #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}-{-# language OverloadedStrings #-}-{-# language NumDecimals #-}+{-# LANGUAGE NumDecimals #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} -import Control.Monad (when,replicateM)+import Prelude hiding (toInteger)++import Control.Monad (replicateM, when) import Data.Bool (bool)-import Data.Bytes.Types (Bytes(Bytes))+import Data.Bytes.Types (Bytes (Bytes)) import Data.Char (ord)-import Data.Fixed (Fixed,E12)+import Data.Fixed (E12, Fixed) import Data.Int (Int64)-import Data.Number.Scientific (large,small,toWord8,toWord16,toWord32,toWord64)-import Data.Number.Scientific (toInt64,toInt32,roundShiftedToInt64)+import Data.Number.Scientific (large, roundShiftedToInt64, small, toInt32, toInt64, toWord16, toWord32, toWord64, toWord8, toInteger) import Data.Primitive (ByteArray) import Data.Word (Word8)-import Test.Tasty (defaultMain,testGroup,TestTree)-import Test.Tasty.HUnit ((@=?),assertFailure)-import Test.Tasty.QuickCheck (testProperty,(===))+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertFailure, (@=?))+import Test.Tasty.QuickCheck (testProperty, (===))  import qualified Data.Bits as Bits-import qualified Data.Number.Scientific as SCI import qualified Data.Bytes.Parser as P+import qualified Data.Number.Scientific as SCI import qualified Data.Primitive as PM import qualified GHC.Exts as Exts import qualified Test.Tasty.HUnit as THU@@ -31,231 +31,249 @@ main = defaultMain tests  tests :: TestTree-tests = testGroup "Tests"-  [ testGroup "Eq"-    [ THU.testCase "A" $ small 300 (-2) @=? small 3 0-    , THU.testCase "B" $ small 300 (-2) @=? large 3e50 (-50)-    , THU.testCase "C" $ large 3e100 (-99) @=? small 30 0-    , THU.testCase "D" $ large 3e5 9999999995 @=? large 3e6 9999999994-    , THU.testCase "E" $ when-        (small 400 maxBound == small 4 (minBound + 1))-        (assertFailure "")-    , THU.testCase "F" $ small 0 (-2) @=? small 0 5-    , THU.testCase "G" $ large 0 (-2) @=? large 0 5-    , testProperty "small" $ \x y ->-        small x y === small x y-    ]-  , testGroup "Word8"-    [ THU.testCase "A" $ Just 30 @=? toWord8 (small 300 (-1))-    , THU.testCase "B" $ Nothing @=? toWord8 (small 300 0)-    , THU.testCase "C" $ Nothing @=? toWord8 (small 1 999999999)-    , THU.testCase "D" $ Just 255 @=? toWord8 (large 255e40 (-40))-    , THU.testCase "E" $ Just 0 @=? toWord8 (large 0 10e30)-    , THU.testCase "F" $ Just 0 @=? toWord8 (small 0 999999999)-    , THU.testCase "G" $ Nothing @=? toWord8 (small (-1) 1)-    ]-  , testGroup "Word16"-    [ THU.testCase "A" $ Just 30 @=? toWord16 (small 300 (-1))-    , THU.testCase "B" $ Just 300 @=? toWord16 (small 300 0)-    , THU.testCase "C" $ Nothing @=? toWord16 (small 1 999999999)-    , THU.testCase "D" $ Just 65535 @=? toWord16 (large 65535e40 (-40))-    , THU.testCase "E" $ Just 0 @=? toWord16 (large 0 10e30)-    , THU.testCase "F" $ Just 0 @=? toWord16 (small 0 999999999)-    , THU.testCase "G" $ Nothing @=? toWord16 (small (-1) 1)-    , THU.testCase "H" $ Nothing @=? toWord16 (small 65536 0)-    ]-  , testGroup "Word32"-    [ THU.testCase "A" $ Just 30 @=? toWord32 (small 300 (-1))-    , THU.testCase "B" $ Just 300 @=? toWord32 (small 300 0)-    , THU.testCase "C" $ Nothing @=? toWord32 (small 1 999999999)-    , THU.testCase "D" $ Just 65535 @=? toWord32 (large 65535e40 (-40))-    , THU.testCase "E" $ Just 0 @=? toWord32 (large 0 10e30)-    , THU.testCase "F" $ Just 0 @=? toWord32 (small 0 999999999)-    , THU.testCase "G" $ Nothing @=? toWord32 (small (-1) 1)-    , THU.testCase "H" $ Nothing @=? toWord32 (small 4294967296 0)-    , THU.testCase "I" $ Just 4294967295 @=? toWord32 (large 4294967295e40 (-40))-    , THU.testCase "J" $ Just 4294967295 @=? toWord32 (small 4294967295 0)-    ]-  , testGroup "Word64"-    [ THU.testCase "A" $ Just 30 @=? toWord64 (small 300 (-1))-    , THU.testCase "B" $ Just 300 @=? toWord64 (small 300 0)-    , THU.testCase "C" $ Nothing @=? toWord64 (small 1 999999999)-    , THU.testCase "D" $ Just 65535 @=? toWord64 (large 65535e40 (-40))-    , THU.testCase "E" $ Just 0 @=? toWord64 (large 0 10e30)-    , THU.testCase "F" $ Just 0 @=? toWord64 (small 0 999999999)-    , THU.testCase "G" $ Nothing @=? toWord64 (small (-1) 1)-    , THU.testCase "H" $ Just 4294967296 @=? toWord64 (small 4294967296 0)-    , THU.testCase "I" $ Just 4294967295 @=? toWord64 (large 4294967295e40 (-40))-    , THU.testCase "J" $ Just 4294967295 @=? toWord64 (small 4294967295 0)-    , THU.testCase "K" $ Nothing @=? toWord64 (large (2 ^ (64 :: Int)) 0)-    , THU.testCase "L" $ Just maxBound @=? toWord64 (large ((2 ^ (64 :: Int)) - 1) 0)-    , THU.testCase "M" $ Just (fromIntegral (maxBound :: Int)) @=? toWord64 (small (maxBound :: Int) 0)-    ]-  , testGroup "Int32"-    [ THU.testCase "A" $ Just 30 @=? toInt32 (small 300 (-1))-    , THU.testCase "B" $ Just 300 @=? toInt32 (small 300 0)-    , THU.testCase "C" $ Nothing @=? toInt32 (small 1 999999999)-    , THU.testCase "D" $ Just 65535 @=? toInt32 (large 65535e40 (-40))-    , THU.testCase "E" $ Just 0 @=? toInt32 (large 0 10e30)-    , THU.testCase "F" $ Just 0 @=? toInt32 (small 0 999999999)-    , THU.testCase "G" $ Just (-10) @=? toInt32 (small (-1) 1)-    , THU.testCase "H" $ Just 2147483647 @=? toInt32 (small 2147483647 0)-    , THU.testCase "I" $ Nothing @=? toInt32 (large 4294967295e40 (-40))-    , THU.testCase "J" $ Just (-2147483640)  @=? toInt32 (small (-214748364) 1)-    , THU.testCase "K" $ Just 2147483640 @=? toInt32 (small 214748364 1)-    , THU.testCase "L" $ Nothing @=? toInt32 (small 214748365 1)-    ]-  , testGroup "Int64"-    [ THU.testCase "A" $ Just 30 @=? toInt64 (small 300 (-1))-    , THU.testCase "B" $ Just 300 @=? toInt64 (small 300 0)-    , THU.testCase "C" $ Nothing @=? toInt64 (small 1 999999999)-    , THU.testCase "D" $ Just 65535 @=? toInt64 (large 65535e40 (-40))-    , THU.testCase "E" $ Just 0 @=? toInt64 (large 0 10e30)-    , THU.testCase "F" $ Just 0 @=? toInt64 (small 0 999999999)-    , THU.testCase "G" $ Just (-10) @=? toInt64 (small (-1) 1)-    , THU.testCase "H" $ Just 4294967296 @=? toInt64 (small 4294967296 0)-    , THU.testCase "I" $ Just 4294967295 @=? toInt64 (large 4294967295e40 (-40))-    , THU.testCase "J" $ Just 4294967295 @=? toInt64 (small 4294967295 0)-    , THU.testCase "K" $ Nothing @=? toInt64 (large (2 ^ (64 :: Int)) 0)-    , THU.testCase "L" $ Just maxBound @=? toInt64 (large ((2 ^ (63 :: Int)) - 1) 0)-    , THU.testCase "M" $ Just (fromIntegral (maxBound :: Int)) @=? toInt64 (small (maxBound :: Int) 0)-    , THU.testCase "N" $ Just (fromIntegral (minBound :: Int)) @=? toInt64 (small (minBound :: Int) 0)-    , THU.testCase "O" $ Nothing @=? toInt64 (large (negate (2 ^ (63 :: Int)) - 1) 0)-    , THU.testCase "P" $ Just (minBound :: Int64) @=? toInt64 (large (negate (2 ^ (63 :: Int))) 0)-    , THU.testCase "Q" $ Just 9.2e18 @=? toInt64 (small 92 17)-    , THU.testCase "R" $ Just 9.3e17 @=? toInt64 (small 93 16)-    , THU.testCase "S" $ Nothing @=? toInt64 (small 93 17)-    , THU.testCase "T" $ Nothing @=? toInt64 (large 93 17)-    , THU.testCase "U" $ Just (-9.3e17) @=? toInt64 (small (-93) 16)-    , THU.testCase "V" $ Nothing @=? toInt64 (large 922337203685477581 1)-    , THU.testCase "W" $ Just 12 @=? roundShiftedToInt64 1 (small 129 (-2))-    , THU.testCase "X" $ Just (-12) @=? roundShiftedToInt64 1 (small (-129) (-2))-    , THU.testCase "Y" $ Nothing @=? roundShiftedToInt64 31 (small 129 (-2))-    , THU.testCase "Z" $ Just (1.29e18) @=? roundShiftedToInt64 18 (small 129 (-2))-    , THU.testCase "AA" $ Just 9223372 @=? roundShiftedToInt64 (-26) (large 9223372036854775817425364203 5)-    , THU.testCase "AB" $ Just (-9223372) @=? roundShiftedToInt64 (-26) (large (-9223372036854775817425364203) 5)-    , THU.testCase "AC" $ Just 0 @=? roundShiftedToInt64 0 (large (-9223372036854775817425364203) (-1_000_000_000))-    , THU.testCase "AD" $ Just 0 @=? roundShiftedToInt64 0 (large (50000000000000000000000000000) (-1_000_000_000))-    , THU.testCase "AE" $ Just 2 @=? toInt64 (small 2 0)-    , THU.testCase "AF" $ Just 2 @=? toInt64 (large 2 0)-    ]-  , testGroup "Compare"-    [ THU.testCase "A" $ SCI.greaterThanInt64 (small 300 (-2)) 2 @=? True-    , THU.testCase "B" $ SCI.greaterThanInt64 (small 300 (-2)) 3 @=? False-    , THU.testCase "C" $ SCI.greaterThanInt64 (small 300 (-2)) 4 @=? False-    , THU.testCase "D" $ SCI.greaterThanInt64 (small (-300) (-2)) (-2) @=? False-    , THU.testCase "E" $ SCI.greaterThanInt64 (small (-300) (-2)) (-3) @=? False-    , THU.testCase "F" $ SCI.greaterThanInt64 (small (-300) (-2)) (-4) @=? True-    , THU.testCase "G" $ SCI.greaterThanInt64 (small (-300) (-2)) 5 @=? False-    , THU.testCase "H" $ SCI.greaterThanInt64 (small 300 (-2)) (-5) @=? True-    , THU.testCase "I" $ SCI.greaterThanInt64 (small 300 (-2)) 0 @=? True-    , THU.testCase "J" $ SCI.greaterThanInt64 (small 3 0) 0 @=? True-    , THU.testCase "K" $ SCI.greaterThanInt64 (small 0 0) 0 @=? False-    , THU.testCase "L" $ SCI.greaterThanInt64 (small 0 10) 0 @=? False-    , THU.testCase "M" $ SCI.greaterThanInt64 (small 1 100) 20 @=? True-    , THU.testCase "N" $ SCI.greaterThanInt64 (small (-5) 100) (-20) @=? False-    , THU.testCase "O" $ SCI.greaterThanInt64 (small (-5) (-100)) (-1) @=? True-    , THU.testCase "P" $ SCI.greaterThanInt64 (small 42 (-2)) 1 @=? False-    , THU.testCase "Q" $ SCI.greaterThanInt64 (small 42 (-1)) 1 @=? True-    , THU.testCase "R" $ SCI.greaterThanInt64 (large 5430747472779717375525059 0) 1 @=? True-    , THU.testCase "S" $ SCI.greaterThanInt64 (large 5430747472779717375525059 (-100)) 1 @=? False-    , THU.testCase "T" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) 0) 1 @=? False-    , THU.testCase "U" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) (-100)) (-1) @=? True-    , THU.testCase "V" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) (-100)) 0 @=? False-    , THU.testCase "W" $ SCI.greaterThanInt64 (large (4e30) (-30)) 4 @=? False-    , THU.testCase "X" $ SCI.greaterThanInt64 (large (4e30) (-30)) 3 @=? True-    , THU.testCase "Y" $ SCI.greaterThanInt64 (large (-4e30) (-30)) (-4) @=? False-    , THU.testCase "Z" $ SCI.greaterThanInt64 (large (-4e30) (-30)) (-5) @=? True-    ]-  , testGroup "Parser"-    [ testGroup "UTF-8-signed"-      [ testProperty "small-integer" $ \i ->-          let str = show i in-          P.Success (P.Slice (length str + 1) 0 (small i 0))-          ===-          P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)-      , testProperty "small-exp" $ \i j b ->-          let str = show i ++ bool "e" "E" b ++ show j in-          P.Success (P.Slice (length str + 1) 0 (small i j))-          ===-          P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)-      , testProperty "fixed-e12-no-exp" $ \(i :: Fixed E12) ->-          let str = show i in-          QC.counterexample str-          $-          P.Success (P.Slice (length str + 1) 0 (SCI.fromFixed i))-          ===-          P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)-      , testProperty "large-integer" $ \(LargeInteger i) (LargeInteger j) ->-          let str = show (large i j) in-          QC.counterexample str-          $-          P.Success (P.Slice (length str + 1) 0 (large i j))-          ===-          P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)-      ]-    ]-  , testGroup "Encode"-    [ testGroup "small"-      [ THU.testCase "A" $ "5000" @=? SCI.encode (small 5 3)-      , THU.testCase "B" $ "-5000" @=? SCI.encode (small (-5) 3)-      , THU.testCase "C" $ "0.0006" @=? SCI.encode (small 6 (-4))-      , THU.testCase "D" $ "0.087654321" @=? SCI.encode (small 87654321 (-9))-      , THU.testCase "E" $ "0.87654321" @=? SCI.encode (small 87654321 (-8))-      , THU.testCase "F" $ "8.7654321" @=? SCI.encode (small 87654321 (-7))-      , THU.testCase "G" $ "87.654321" @=? SCI.encode (small 87654321 (-6))-      , THU.testCase "H" $ "876.54321" @=? SCI.encode (small 87654321 (-5))-      , THU.testCase "I" $ "8765.4321" @=? SCI.encode (small 87654321 (-4))-      , THU.testCase "J" $ "87654.321" @=? SCI.encode (small 87654321 (-3))-      , THU.testCase "K" $ "876543.21" @=? SCI.encode (small 87654321 (-2))-      , THU.testCase "L" $ "8765432.1" @=? SCI.encode (small 87654321 (-1))-      , THU.testCase "M" $ "87654321" @=? SCI.encode (small 87654321 0)-      , THU.testCase "N" $ "876543210" @=? SCI.encode (small 87654321 1)-      , THU.testCase "O" $ "87654321.0" @=? SCI.encode (small 876543210 (-1))-      , THU.testCase "P" $ "-0.087654321" @=? SCI.encode (small (-87654321) (-9))-      , THU.testCase "Q" $ "-0.87654321" @=? SCI.encode (small (-87654321) (-8))-      , THU.testCase "R" $ "-8.7654321" @=? SCI.encode (small (-87654321) (-7))-      , THU.testCase "S" $ "-87.654321" @=? SCI.encode (small (-87654321) (-6))-      , THU.testCase "T" $ "-876.54321" @=? SCI.encode (small (-87654321) (-5))-      , THU.testCase "U" $ "-8765.4321" @=? SCI.encode (small (-87654321) (-4))-      , THU.testCase "V" $ "-87654.321" @=? SCI.encode (small (-87654321) (-3))-      , THU.testCase "W" $ "-876543.21" @=? SCI.encode (small (-87654321) (-2))-      , THU.testCase "X" $ "-8765432.1" @=? SCI.encode (small (-87654321) (-1))-      , THU.testCase "Y" $ "-87654321" @=? SCI.encode (small (-87654321) 0)-      , THU.testCase "Z" $ "-876543210" @=? SCI.encode (small (-87654321) 1)-      , THU.testCase "AA" $ "-87654321.0" @=? SCI.encode (small (-876543210) (-1))-      ]-    , testGroup "large"-      [ THU.testCase "A" $ "5000" @=? SCI.encode (large 5 3)-      , THU.testCase "B" $ "-5000" @=? SCI.encode (large (-5) 3)-      , THU.testCase "C" $ "0.0006" @=? SCI.encode (large 6 (-4))-      , THU.testCase "D" $ "0.087654321" @=? SCI.encode (large 87654321 (-9))-      , THU.testCase "E" $ "0.87654321" @=? SCI.encode (large 87654321 (-8))-      , THU.testCase "F" $ "8.7654321" @=? SCI.encode (large 87654321 (-7))-      , THU.testCase "G" $ "87.654321" @=? SCI.encode (large 87654321 (-6))-      , THU.testCase "H" $ "876.54321" @=? SCI.encode (large 87654321 (-5))-      , THU.testCase "I" $ "8765.4321" @=? SCI.encode (large 87654321 (-4))-      , THU.testCase "J" $ "87654.321" @=? SCI.encode (large 87654321 (-3))-      , THU.testCase "K" $ "876543.21" @=? SCI.encode (large 87654321 (-2))-      , THU.testCase "L" $ "8765432.1" @=? SCI.encode (large 87654321 (-1))-      , THU.testCase "M" $ "87654321" @=? SCI.encode (large 87654321 0)-      , THU.testCase "N" $ "876543210" @=? SCI.encode (large 87654321 1)-      , THU.testCase "O" $ "87654321.0" @=? SCI.encode (large 876543210 (-1))-      , THU.testCase "P" $ "-0.087654321" @=? SCI.encode (large (-87654321) (-9))-      , THU.testCase "Q" $ "-0.87654321" @=? SCI.encode (large (-87654321) (-8))-      , THU.testCase "R" $ "-8.7654321" @=? SCI.encode (large (-87654321) (-7))-      , THU.testCase "S" $ "-87.654321" @=? SCI.encode (large (-87654321) (-6))-      , THU.testCase "T" $ "-876.54321" @=? SCI.encode (large (-87654321) (-5))-      , THU.testCase "U" $ "-8765.4321" @=? SCI.encode (large (-87654321) (-4))-      , THU.testCase "V" $ "-87654.321" @=? SCI.encode (large (-87654321) (-3))-      , THU.testCase "W" $ "-876543.21" @=? SCI.encode (large (-87654321) (-2))-      , THU.testCase "X" $ "-8765432.1" @=? SCI.encode (large (-87654321) (-1))-      , THU.testCase "Y" $ "-87654321" @=? SCI.encode (large (-87654321) 0)-      , THU.testCase "Z" $ "-876543210" @=? SCI.encode (large (-87654321) 1)-      , THU.testCase "AA" $ "-87654321.0" @=? SCI.encode (large (-876543210) (-1))-      ]+tests =+  testGroup+    "Tests"+    [ testGroup+        "Eq"+        [ THU.testCase "A" $ small 300 (-2) @=? small 3 0+        , THU.testCase "B" $ small 300 (-2) @=? large 3e50 (-50)+        , THU.testCase "C" $ large 3e100 (-99) @=? small 30 0+        , THU.testCase "D" $ large 3e5 9999999995 @=? large 3e6 9999999994+        , THU.testCase "E" $+            when+              (small 400 maxBound == small 4 (minBound + 1))+              (assertFailure "")+        , THU.testCase "F" $ small 0 (-2) @=? small 0 5+        , THU.testCase "G" $ large 0 (-2) @=? large 0 5+        , testProperty "small" $ \x y ->+            small x y === small x y+        ]+    , testGroup+        "Word8"+        [ THU.testCase "A" $ Just 30 @=? toWord8 (small 300 (-1))+        , THU.testCase "B" $ Nothing @=? toWord8 (small 300 0)+        , THU.testCase "C" $ Nothing @=? toWord8 (small 1 999999999)+        , THU.testCase "D" $ Just 255 @=? toWord8 (large 255e40 (-40))+        , THU.testCase "E" $ Just 0 @=? toWord8 (large 0 10e30)+        , THU.testCase "F" $ Just 0 @=? toWord8 (small 0 999999999)+        , THU.testCase "G" $ Nothing @=? toWord8 (small (-1) 1)+        ]+    , testGroup+        "Word16"+        [ THU.testCase "A" $ Just 30 @=? toWord16 (small 300 (-1))+        , THU.testCase "B" $ Just 300 @=? toWord16 (small 300 0)+        , THU.testCase "C" $ Nothing @=? toWord16 (small 1 999999999)+        , THU.testCase "D" $ Just 65535 @=? toWord16 (large 65535e40 (-40))+        , THU.testCase "E" $ Just 0 @=? toWord16 (large 0 10e30)+        , THU.testCase "F" $ Just 0 @=? toWord16 (small 0 999999999)+        , THU.testCase "G" $ Nothing @=? toWord16 (small (-1) 1)+        , THU.testCase "H" $ Nothing @=? toWord16 (small 65536 0)+        ]+    , testGroup+        "Word32"+        [ THU.testCase "A" $ Just 30 @=? toWord32 (small 300 (-1))+        , THU.testCase "B" $ Just 300 @=? toWord32 (small 300 0)+        , THU.testCase "C" $ Nothing @=? toWord32 (small 1 999999999)+        , THU.testCase "D" $ Just 65535 @=? toWord32 (large 65535e40 (-40))+        , THU.testCase "E" $ Just 0 @=? toWord32 (large 0 10e30)+        , THU.testCase "F" $ Just 0 @=? toWord32 (small 0 999999999)+        , THU.testCase "G" $ Nothing @=? toWord32 (small (-1) 1)+        , THU.testCase "H" $ Nothing @=? toWord32 (small 4294967296 0)+        , THU.testCase "I" $ Just 4294967295 @=? toWord32 (large 4294967295e40 (-40))+        , THU.testCase "J" $ Just 4294967295 @=? toWord32 (small 4294967295 0)+        ]+    , testGroup+        "Word64"+        [ THU.testCase "A" $ Just 30 @=? toWord64 (small 300 (-1))+        , THU.testCase "B" $ Just 300 @=? toWord64 (small 300 0)+        , THU.testCase "C" $ Nothing @=? toWord64 (small 1 999999999)+        , THU.testCase "D" $ Just 65535 @=? toWord64 (large 65535e40 (-40))+        , THU.testCase "E" $ Just 0 @=? toWord64 (large 0 10e30)+        , THU.testCase "F" $ Just 0 @=? toWord64 (small 0 999999999)+        , THU.testCase "G" $ Nothing @=? toWord64 (small (-1) 1)+        , THU.testCase "H" $ Just 4294967296 @=? toWord64 (small 4294967296 0)+        , THU.testCase "I" $ Just 4294967295 @=? toWord64 (large 4294967295e40 (-40))+        , THU.testCase "J" $ Just 4294967295 @=? toWord64 (small 4294967295 0)+        , THU.testCase "K" $ Nothing @=? toWord64 (large (2 ^ (64 :: Int)) 0)+        , THU.testCase "L" $ Just maxBound @=? toWord64 (large ((2 ^ (64 :: Int)) - 1) 0)+        , THU.testCase "M" $ Just (fromIntegral (maxBound :: Int)) @=? toWord64 (small (maxBound :: Int) 0)+        ]+    , testGroup+        "Int32"+        [ THU.testCase "A" $ Just 30 @=? toInt32 (small 300 (-1))+        , THU.testCase "B" $ Just 300 @=? toInt32 (small 300 0)+        , THU.testCase "C" $ Nothing @=? toInt32 (small 1 999999999)+        , THU.testCase "D" $ Just 65535 @=? toInt32 (large 65535e40 (-40))+        , THU.testCase "E" $ Just 0 @=? toInt32 (large 0 10e30)+        , THU.testCase "F" $ Just 0 @=? toInt32 (small 0 999999999)+        , THU.testCase "G" $ Just (-10) @=? toInt32 (small (-1) 1)+        , THU.testCase "H" $ Just 2147483647 @=? toInt32 (small 2147483647 0)+        , THU.testCase "I" $ Nothing @=? toInt32 (large 4294967295e40 (-40))+        , THU.testCase "J" $ Just (-2147483640) @=? toInt32 (small (-214748364) 1)+        , THU.testCase "K" $ Just 2147483640 @=? toInt32 (small 214748364 1)+        , THU.testCase "L" $ Nothing @=? toInt32 (small 214748365 1)+        ]+    , testGroup+        "Int64"+        [ THU.testCase "A" $ Just 30 @=? toInt64 (small 300 (-1))+        , THU.testCase "B" $ Just 300 @=? toInt64 (small 300 0)+        , THU.testCase "C" $ Nothing @=? toInt64 (small 1 999999999)+        , THU.testCase "D" $ Just 65535 @=? toInt64 (large 65535e40 (-40))+        , THU.testCase "E" $ Just 0 @=? toInt64 (large 0 10e30)+        , THU.testCase "F" $ Just 0 @=? toInt64 (small 0 999999999)+        , THU.testCase "G" $ Just (-10) @=? toInt64 (small (-1) 1)+        , THU.testCase "H" $ Just 4294967296 @=? toInt64 (small 4294967296 0)+        , THU.testCase "I" $ Just 4294967295 @=? toInt64 (large 4294967295e40 (-40))+        , THU.testCase "J" $ Just 4294967295 @=? toInt64 (small 4294967295 0)+        , THU.testCase "K" $ Nothing @=? toInt64 (large (2 ^ (64 :: Int)) 0)+        , THU.testCase "L" $ Just maxBound @=? toInt64 (large ((2 ^ (63 :: Int)) - 1) 0)+        , THU.testCase "M" $ Just (fromIntegral (maxBound :: Int)) @=? toInt64 (small (maxBound :: Int) 0)+        , THU.testCase "N" $ Just (fromIntegral (minBound :: Int)) @=? toInt64 (small (minBound :: Int) 0)+        , THU.testCase "O" $ Nothing @=? toInt64 (large (negate (2 ^ (63 :: Int)) - 1) 0)+        , THU.testCase "P" $ Just (minBound :: Int64) @=? toInt64 (large (negate (2 ^ (63 :: Int))) 0)+        , THU.testCase "Q" $ Just 9.2e18 @=? toInt64 (small 92 17)+        , THU.testCase "R" $ Just 9.3e17 @=? toInt64 (small 93 16)+        , THU.testCase "S" $ Nothing @=? toInt64 (small 93 17)+        , THU.testCase "T" $ Nothing @=? toInt64 (large 93 17)+        , THU.testCase "U" $ Just (-9.3e17) @=? toInt64 (small (-93) 16)+        , THU.testCase "V" $ Nothing @=? toInt64 (large 922337203685477581 1)+        , THU.testCase "W" $ Just 12 @=? roundShiftedToInt64 1 (small 129 (-2))+        , THU.testCase "X" $ Just (-12) @=? roundShiftedToInt64 1 (small (-129) (-2))+        , THU.testCase "Y" $ Nothing @=? roundShiftedToInt64 31 (small 129 (-2))+        , THU.testCase "Z" $ Just (1.29e18) @=? roundShiftedToInt64 18 (small 129 (-2))+        , THU.testCase "AA" $ Just 9223372 @=? roundShiftedToInt64 (-26) (large 9223372036854775817425364203 5)+        , THU.testCase "AB" $ Just (-9223372) @=? roundShiftedToInt64 (-26) (large (-9223372036854775817425364203) 5)+        , THU.testCase "AC" $ Just 0 @=? roundShiftedToInt64 0 (large (-9223372036854775817425364203) (-1_000_000_000))+        , THU.testCase "AD" $ Just 0 @=? roundShiftedToInt64 0 (large (50000000000000000000000000000) (-1_000_000_000))+        , THU.testCase "AE" $ Just 2 @=? toInt64 (small 2 0)+        , THU.testCase "AF" $ Just 2 @=? toInt64 (large 2 0)+        ]+    , testGroup+        "Integer"+        [ THU.testCase "A" $ Just 30 @=? toInteger (small 300 (-1))+        , THU.testCase "B" $ Just 300 @=? toInteger (small 300 0)+        , THU.testCase "C" $ Just 65535 @=? toInteger (large 65535e40 (-40))+        , THU.testCase "D" $ Just 999_999_999_999_999_999_999_999_999_999_999_000 @=? toInteger (large 999_999_999_999_999_999_999_999_999_999_999 3)+        , THU.testCase "E" $ Just 999_999_999_999_999_999_999_999_999_999_999 @=? toInteger (large 999_999_999_999_999_999_999_999_999_999_999_000 (-3))+        ]+    , testGroup+        "Compare"+        [ THU.testCase "A" $ SCI.greaterThanInt64 (small 300 (-2)) 2 @=? True+        , THU.testCase "B" $ SCI.greaterThanInt64 (small 300 (-2)) 3 @=? False+        , THU.testCase "C" $ SCI.greaterThanInt64 (small 300 (-2)) 4 @=? False+        , THU.testCase "D" $ SCI.greaterThanInt64 (small (-300) (-2)) (-2) @=? False+        , THU.testCase "E" $ SCI.greaterThanInt64 (small (-300) (-2)) (-3) @=? False+        , THU.testCase "F" $ SCI.greaterThanInt64 (small (-300) (-2)) (-4) @=? True+        , THU.testCase "G" $ SCI.greaterThanInt64 (small (-300) (-2)) 5 @=? False+        , THU.testCase "H" $ SCI.greaterThanInt64 (small 300 (-2)) (-5) @=? True+        , THU.testCase "I" $ SCI.greaterThanInt64 (small 300 (-2)) 0 @=? True+        , THU.testCase "J" $ SCI.greaterThanInt64 (small 3 0) 0 @=? True+        , THU.testCase "K" $ SCI.greaterThanInt64 (small 0 0) 0 @=? False+        , THU.testCase "L" $ SCI.greaterThanInt64 (small 0 10) 0 @=? False+        , THU.testCase "M" $ SCI.greaterThanInt64 (small 1 100) 20 @=? True+        , THU.testCase "N" $ SCI.greaterThanInt64 (small (-5) 100) (-20) @=? False+        , THU.testCase "O" $ SCI.greaterThanInt64 (small (-5) (-100)) (-1) @=? True+        , THU.testCase "P" $ SCI.greaterThanInt64 (small 42 (-2)) 1 @=? False+        , THU.testCase "Q" $ SCI.greaterThanInt64 (small 42 (-1)) 1 @=? True+        , THU.testCase "R" $ SCI.greaterThanInt64 (large 5430747472779717375525059 0) 1 @=? True+        , THU.testCase "S" $ SCI.greaterThanInt64 (large 5430747472779717375525059 (-100)) 1 @=? False+        , THU.testCase "T" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) 0) 1 @=? False+        , THU.testCase "U" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) (-100)) (-1) @=? True+        , THU.testCase "V" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) (-100)) 0 @=? False+        , THU.testCase "W" $ SCI.greaterThanInt64 (large (4e30) (-30)) 4 @=? False+        , THU.testCase "X" $ SCI.greaterThanInt64 (large (4e30) (-30)) 3 @=? True+        , THU.testCase "Y" $ SCI.greaterThanInt64 (large (-4e30) (-30)) (-4) @=? False+        , THU.testCase "Z" $ SCI.greaterThanInt64 (large (-4e30) (-30)) (-5) @=? True+        ]+    , testGroup+        "Parser"+        [ testGroup+            "UTF-8-signed"+            [ testProperty "small-integer" $ \i ->+                let str = show i+                 in P.Success (P.Slice (length str + 1) 0 (small i 0))+                      === P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)+            , testProperty "small-exp" $ \i j b ->+                let str = show i ++ bool "e" "E" b ++ show j+                 in P.Success (P.Slice (length str + 1) 0 (small i j))+                      === P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)+            , testProperty "fixed-e12-no-exp" $ \(i :: Fixed E12) ->+                let str = show i+                 in QC.counterexample str $+                      P.Success (P.Slice (length str + 1) 0 (SCI.fromFixed i))+                        === P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)+            , testProperty "large-integer" $ \(LargeInteger i) (LargeInteger j) ->+                let str = show (large i j)+                 in QC.counterexample str $+                      P.Success (P.Slice (length str + 1) 0 (large i j))+                        === P.parseBytes (SCI.parserSignedUtf8Bytes ()) (bytes str)+            ]+        ]+    , testGroup+        "Encode"+        [ testGroup+            "small"+            [ THU.testCase "A" $ "5000" @=? SCI.encode (small 5 3)+            , THU.testCase "B" $ "-5000" @=? SCI.encode (small (-5) 3)+            , THU.testCase "C" $ "0.0006" @=? SCI.encode (small 6 (-4))+            , THU.testCase "D" $ "0.087654321" @=? SCI.encode (small 87654321 (-9))+            , THU.testCase "E" $ "0.87654321" @=? SCI.encode (small 87654321 (-8))+            , THU.testCase "F" $ "8.7654321" @=? SCI.encode (small 87654321 (-7))+            , THU.testCase "G" $ "87.654321" @=? SCI.encode (small 87654321 (-6))+            , THU.testCase "H" $ "876.54321" @=? SCI.encode (small 87654321 (-5))+            , THU.testCase "I" $ "8765.4321" @=? SCI.encode (small 87654321 (-4))+            , THU.testCase "J" $ "87654.321" @=? SCI.encode (small 87654321 (-3))+            , THU.testCase "K" $ "876543.21" @=? SCI.encode (small 87654321 (-2))+            , THU.testCase "L" $ "8765432.1" @=? SCI.encode (small 87654321 (-1))+            , THU.testCase "M" $ "87654321" @=? SCI.encode (small 87654321 0)+            , THU.testCase "N" $ "876543210" @=? SCI.encode (small 87654321 1)+            , THU.testCase "O" $ "87654321.0" @=? SCI.encode (small 876543210 (-1))+            , THU.testCase "P" $ "-0.087654321" @=? SCI.encode (small (-87654321) (-9))+            , THU.testCase "Q" $ "-0.87654321" @=? SCI.encode (small (-87654321) (-8))+            , THU.testCase "R" $ "-8.7654321" @=? SCI.encode (small (-87654321) (-7))+            , THU.testCase "S" $ "-87.654321" @=? SCI.encode (small (-87654321) (-6))+            , THU.testCase "T" $ "-876.54321" @=? SCI.encode (small (-87654321) (-5))+            , THU.testCase "U" $ "-8765.4321" @=? SCI.encode (small (-87654321) (-4))+            , THU.testCase "V" $ "-87654.321" @=? SCI.encode (small (-87654321) (-3))+            , THU.testCase "W" $ "-876543.21" @=? SCI.encode (small (-87654321) (-2))+            , THU.testCase "X" $ "-8765432.1" @=? SCI.encode (small (-87654321) (-1))+            , THU.testCase "Y" $ "-87654321" @=? SCI.encode (small (-87654321) 0)+            , THU.testCase "Z" $ "-876543210" @=? SCI.encode (small (-87654321) 1)+            , THU.testCase "AA" $ "-87654321.0" @=? SCI.encode (small (-876543210) (-1))+            ]+        , testGroup+            "large"+            [ THU.testCase "A" $ "5000" @=? SCI.encode (large 5 3)+            , THU.testCase "B" $ "-5000" @=? SCI.encode (large (-5) 3)+            , THU.testCase "C" $ "0.0006" @=? SCI.encode (large 6 (-4))+            , THU.testCase "D" $ "0.087654321" @=? SCI.encode (large 87654321 (-9))+            , THU.testCase "E" $ "0.87654321" @=? SCI.encode (large 87654321 (-8))+            , THU.testCase "F" $ "8.7654321" @=? SCI.encode (large 87654321 (-7))+            , THU.testCase "G" $ "87.654321" @=? SCI.encode (large 87654321 (-6))+            , THU.testCase "H" $ "876.54321" @=? SCI.encode (large 87654321 (-5))+            , THU.testCase "I" $ "8765.4321" @=? SCI.encode (large 87654321 (-4))+            , THU.testCase "J" $ "87654.321" @=? SCI.encode (large 87654321 (-3))+            , THU.testCase "K" $ "876543.21" @=? SCI.encode (large 87654321 (-2))+            , THU.testCase "L" $ "8765432.1" @=? SCI.encode (large 87654321 (-1))+            , THU.testCase "M" $ "87654321" @=? SCI.encode (large 87654321 0)+            , THU.testCase "N" $ "876543210" @=? SCI.encode (large 87654321 1)+            , THU.testCase "O" $ "87654321.0" @=? SCI.encode (large 876543210 (-1))+            , THU.testCase "P" $ "-0.087654321" @=? SCI.encode (large (-87654321) (-9))+            , THU.testCase "Q" $ "-0.87654321" @=? SCI.encode (large (-87654321) (-8))+            , THU.testCase "R" $ "-8.7654321" @=? SCI.encode (large (-87654321) (-7))+            , THU.testCase "S" $ "-87.654321" @=? SCI.encode (large (-87654321) (-6))+            , THU.testCase "T" $ "-876.54321" @=? SCI.encode (large (-87654321) (-5))+            , THU.testCase "U" $ "-8765.4321" @=? SCI.encode (large (-87654321) (-4))+            , THU.testCase "V" $ "-87654.321" @=? SCI.encode (large (-87654321) (-3))+            , THU.testCase "W" $ "-876543.21" @=? SCI.encode (large (-87654321) (-2))+            , THU.testCase "X" $ "-8765432.1" @=? SCI.encode (large (-87654321) (-1))+            , THU.testCase "Y" $ "-87654321" @=? SCI.encode (large (-87654321) 0)+            , THU.testCase "Z" $ "-876543210" @=? SCI.encode (large (-87654321) 1)+            , THU.testCase "AA" $ "-87654321.0" @=? SCI.encode (large (-876543210) (-1))+            ]+        ]     ]-  ]  bytes :: String -> Bytes bytes s = let b = pack ('x' : s) in Bytes b 1 (PM.sizeofByteArray b - 1)@@ -266,22 +284,22 @@ -- The Arbitrary instance for Integer that comes with -- QuickCheck only generates small numbers. newtype LargeInteger = LargeInteger Integer-  deriving (Eq,Show)+  deriving (Eq, Show)  instance QC.Arbitrary LargeInteger where   arbitrary = do-      n <- QC.choose (1, 17)-      sign <- QC.arbitrary-      r <- (if sign then negate else id) . foldr f 0+    n <- QC.choose (1, 17)+    sign <- QC.arbitrary+    r <-+      (if sign then negate else id) . foldr f 0         <$> replicateM n QC.arbitrary-      pure (LargeInteger r)-    where-      f :: Word8 -> Integer -> Integer-      f w acc = (acc `Bits.shiftL` 8) + fromIntegral w+    pure (LargeInteger r)+   where+    f :: Word8 -> Integer -> Integer+    f w acc = (acc `Bits.shiftL` 8) + fromIntegral w   shrink (LargeInteger x)     | x > 3 =         [ LargeInteger (div x 2)         , LargeInteger (div x 3)         ]     | otherwise = []-