{-# 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
    -- * 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 GHC.Exts (Int#,Word#,Int(I#),(+#))
import GHC.Word (Word(W#),Word8(W8#),Word16(W16#),Word32(W32#),Word64(W64#))
import GHC.Int (Int64(I64#),Int32(I32#))
import Data.Bytes.Builder (Builder)
import Data.Bytes.Parser.Unsafe (Parser(..))
import Data.Fixed (Fixed(MkFixed),HasResolution)
import Data.Primitive (ByteArray(ByteArray))
import Data.Text.Short (ShortText)
import Data.ByteString.Short.Internal (ShortByteString(SBS))
import Data.Bytes.Types (Bytes(Bytes))

import qualified Arithmetic.Nat as Nat
import qualified Data.Fixed as Fixed
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Types as BT
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.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 :: Int -> Scientific -> ShowS
showsPrec Int
_ (Scientific Int
coeff Int
e LargeScientific
largeNum) = if Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall a. Bounded a => a
minBound
    then Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Int
coeff ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'e' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Int
e
    else case LargeScientific
largeNum of
      LargeScientific Integer
coeffLarge Integer
eLarge ->
        Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Integer
coeffLarge ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'e' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Integer
eLarge

instance Eq Scientific where
  Scientific Int
coeffA Int
eA LargeScientific
largeA == :: Scientific -> Scientific -> Bool
== Scientific Int
coeffB Int
eB LargeScientific
largeB
    | Int
eA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Int
eB Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = LargeScientific -> LargeScientific -> Bool
eqLargeScientific LargeScientific
largeA LargeScientific
largeB
    | Int
eA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = LargeScientific -> LargeScientific -> Bool
eqLargeScientific LargeScientific
largeA (Integer -> Integer -> LargeScientific
LargeScientific (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
coeffB) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eB))
    | Int
eB Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = LargeScientific -> LargeScientific -> Bool
eqLargeScientific (Integer -> Integer -> LargeScientific
LargeScientific (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
coeffA) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eA)) LargeScientific
largeB
    | Int
eA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padding Bool -> Bool -> Bool
|| Int
eB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padding = LargeScientific -> LargeScientific -> Bool
eqLargeScientific
        (Integer -> Integer -> LargeScientific
LargeScientific (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
coeffA) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eA))
        (Integer -> Integer -> LargeScientific
LargeScientific (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
coeffA) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eB))
    | Bool
otherwise = Int -> Int -> Int -> Int -> Bool
eqSmall Int
coeffA Int
eA Int
coeffB Int
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 :: Int
padding = Int
50

eqSmall :: Int -> Int -> Int -> Int -> Bool
eqSmall :: Int -> Int -> Int -> Int -> Bool
eqSmall Int
cA0 Int
eA0 Int
cB0 Int
eB0 =
  let (Int
cA,Int
eA) = Int -> Int -> (Int, Int)
smallNormalize Int
cA0 Int
eA0
      (Int
cB,Int
eB) = Int -> Int -> (Int, Int)
smallNormalize Int
cB0 Int
eB0
   in Int
cA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cB Bool -> Bool -> Bool
&& Int
eA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
eB

eqLargeScientific :: LargeScientific -> LargeScientific -> Bool
eqLargeScientific :: LargeScientific -> LargeScientific -> Bool
eqLargeScientific LargeScientific
a LargeScientific
b =
  let LargeScientific Integer
cA Integer
eA = LargeScientific -> LargeScientific
largeNormalize LargeScientific
a 
      LargeScientific Integer
cB Integer
eB = LargeScientific -> LargeScientific
largeNormalize LargeScientific
b
   in Integer
cA Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
cB Bool -> Bool -> Bool
&& Integer
eA Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
eB

zeroLarge :: LargeScientific
{-# noinline zeroLarge #-}
zeroLarge :: LargeScientific
zeroLarge = Integer -> Integer -> LargeScientific
LargeScientific Integer
0 Integer
0

-- | Construct a 'Scientific' from a coefficient and exponent
-- that fit in a machine word.
small ::
     Int -- ^ Coefficient
  -> Int -- ^ Exponent
  -> Scientific
small :: Int -> Int -> Scientific
small !Int
coeff !Int
e = if Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall a. Bounded a => a
minBound
  then Int -> Int -> LargeScientific -> Scientific
Scientific Int
coeff Int
e LargeScientific
zeroLarge
  else Integer -> Integer -> Scientific
large (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
coeff) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e)

-- | Construct a 'Scientific' from a coefficient and exponent
-- of arbitrary size.
large ::
     Integer -- ^ Coefficient
  -> Integer -- ^ Exponent
  -> Scientific
large :: Integer -> Integer -> Scientific
large Integer
coeff Integer
e =
  let !b :: LargeScientific
b = Integer -> Integer -> LargeScientific
LargeScientific Integer
coeff Integer
e
   in Int -> Int -> LargeScientific -> Scientific
Scientific Int
0 Int
forall a. Bounded a => a
minBound LargeScientific
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 :: Fixed e -> Scientific
fromFixed n :: Fixed e
n@(MkFixed Integer
coeff) =
  let !b :: LargeScientific
b = Integer -> Integer -> LargeScientific
LargeScientific Integer
coeff
        (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
Prelude.negate (Int -> Integer -> Int
logBase10 Int
0 (Fixed e -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
Fixed.resolution Fixed e
n))))
   in Int -> Int -> LargeScientific -> Scientific
Scientific Int
0 Int
forall a. Bounded a => a
minBound LargeScientific
b

toWord8 :: Scientific -> Maybe Word8
{-# inline toWord8 #-}
toWord8 :: Scientific -> Maybe Word8
toWord8 (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord8# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Word8
forall a. Maybe a
Nothing
  (# | Word#
w #) -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word# -> Word8
W8# Word#
w)

toWord16 :: Scientific -> Maybe Word16
{-# inline toWord16 #-}
toWord16 :: Scientific -> Maybe Word16
toWord16 (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord16# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Word16
forall a. Maybe a
Nothing
  (# | Word#
w #) -> Word16 -> Maybe Word16
forall a. a -> Maybe a
Just (Word# -> Word16
W16# Word#
w)

toWord32 :: Scientific -> Maybe Word32
{-# inline toWord32 #-}
toWord32 :: Scientific -> Maybe Word32
toWord32 (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord32# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Word32
forall a. Maybe a
Nothing
  (# | Word#
w #) -> Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word# -> Word32
W32# Word#
w)

toInt32 :: Scientific -> Maybe Int32
{-# inline toInt32 #-}
toInt32 :: Scientific -> Maybe Int32
toInt32 (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
toInt32# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Int32
forall a. Maybe a
Nothing
  (# | Int#
w #) -> Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Int# -> Int32
I32# Int#
w)

toWord64 :: Scientific -> Maybe Word64
{-# inline toWord64 #-}
toWord64 :: Scientific -> Maybe Word64
toWord64 (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Word64
forall a. Maybe a
Nothing
  (# | Word#
w #) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word# -> Word64
W64# Word#
w)

toWord :: Scientific -> Maybe Word
{-# inline toWord #-}
toWord :: Scientific -> Maybe Word
toWord (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Word
forall a. Maybe a
Nothing
  (# | Word#
w #) -> Word -> Maybe Word
forall a. a -> Maybe a
Just (Word# -> Word
W# Word#
w)

toInt :: Scientific -> Maybe Int
{-# inline toInt #-}
toInt :: Scientific -> Maybe Int
toInt (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
toInt# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Int
forall a. Maybe a
Nothing
  (# | Int#
i #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int# -> Int
I# Int#
i)

toInt64 :: Scientific -> Maybe Int64
{-# inline toInt64 #-}
toInt64 :: Scientific -> Maybe Int64
toInt64 (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) = case Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
toInt# Int#
coeff Int#
e LargeScientific
largeNum of
  (# (# #) | #) -> Maybe Int64
forall a. Maybe a
Nothing
  (# | Int#
i #) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int# -> Int64
I64# Int#
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 :: Int -> Scientific -> Maybe Int64
roundShiftedToInt64 (I# Int#
adj) (Scientific (I# Int#
coeff) (I# Int#
e) LargeScientific
largeNum) =
  case Int# -> Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
roundToInt# Int#
coeff Int#
e Int#
adj LargeScientific
largeNum of
     (# (# #) | #) -> Maybe Int64
forall a. Maybe a
Nothing
     (# | Int#
i #) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int# -> Int64
I64# Int#
i)

-- | Convert a 64-bit unsigned word to a 'Scientific'.
fromWord64 :: Word64 -> Scientific
fromWord64 :: Word64 -> Scientific
fromWord64 !Word64
w = if Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
9223372036854775807
  then Int -> Int -> LargeScientific -> Scientific
Scientific (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w) Int
0 LargeScientific
zeroLarge
  else
    let !b :: LargeScientific
b = Integer -> Integer -> LargeScientific
LargeScientific (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w) Integer
0
     in Int -> Int -> LargeScientific -> Scientific
Scientific Int
0 Int
forall a. Bounded a => a
minBound LargeScientific
b

-- | Convert an 8-bit unsigned word to a 'Scientific'.
fromWord8 :: Word8 -> Scientific
{-# inline fromWord8 #-}
fromWord8 :: Word8 -> Scientific
fromWord8 !Word8
w = Int -> Int -> LargeScientific -> Scientific
Scientific (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) Int
0 LargeScientific
zeroLarge

-- | Convert a 16-bit unsigned word to a 'Scientific'.
fromWord16 :: Word16 -> Scientific
{-# inline fromWord16 #-}
fromWord16 :: Word16 -> Scientific
fromWord16 !Word16
w = Int -> Int -> LargeScientific -> Scientific
Scientific (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w) Int
0 LargeScientific
zeroLarge

-- | Convert a 32-bit unsigned word to a 'Scientific'.
fromWord32 :: Word32 -> Scientific
{-# inline fromWord32 #-}
fromWord32 :: Word32 -> Scientific
fromWord32 !Word32
w = Int -> Int -> LargeScientific -> Scientific
Scientific (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w) Int
0 LargeScientific
zeroLarge

-- | Is the number represented in scientific notation greater than the
-- 64-bit integer argument?
greaterThanInt64 :: Scientific -> Int64 -> Bool
greaterThanInt64 :: Scientific -> Int64 -> Bool
greaterThanInt64 (Scientific coeff0 :: Int
coeff0@(I# Int#
coeff0# ) Int
e0 LargeScientific
large0) tgt :: Int64
tgt@(I64# Int#
tgt# )
  | Int
e0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = LargeScientific -> Int64 -> Bool
largeGreaterThanInt64 LargeScientific
large0 Int64
tgt
  | Int
coeff0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int64
0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
tgt
  | Int
e0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int# -> Int64
I64# Int#
coeff0# Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
tgt
  | Int
coeff0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
      if | Int64
tgt Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 -> Bool
True
         | Int
e0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> case Int -> Int -> (# (# #) | Int# #)
smallToInt Int
coeff0 Int
e0 of
             (# (# #) | #) -> Bool
True
             (# | Int#
i# #) -> Int# -> Int64
I64# Int#
i# Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
tgt
           -- In last case, e0 is less than zero.
         | Bool
otherwise -> case Int -> Int -> (# (# #) | Int# #)
posIntExp10 (Int# -> Int
I# Int#
tgt#) (Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e0) of
             (# (# #) | #) -> Bool
False
             (# | Int#
i# #) -> Int# -> Int64
I64# Int#
coeff0# Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int# -> Int64
I64# Int#
i#
  | Bool
otherwise = -- Coefficent is negative
      if | Int64
tgt Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 -> Bool
False
         | Int
e0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> case Int -> Int -> (# (# #) | Int# #)
smallToInt Int
coeff0 Int
e0 of
             (# (# #) | #) -> Bool
False
             (# | Int#
i# #) -> Int# -> Int64
I64# Int#
i# Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
tgt
           -- In last case, e0 is less than zero.
         | Bool
otherwise -> case Int -> Int -> (# (# #) | Int# #)
negIntExp10 (Int# -> Int
I# Int#
tgt#) (Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e0) of
             (# (# #) | #) -> Bool
True
             (# | Int#
i# #) -> Int# -> Int64
I64# Int#
coeff0# Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int# -> Int64
I64# Int#
i#

largeGreaterThanInt64 :: LargeScientific -> Int64 -> Bool
largeGreaterThanInt64 :: LargeScientific -> Int64 -> Bool
largeGreaterThanInt64 large0 :: LargeScientific
large0@(LargeScientific Integer
coeff Integer
e) !Int64
tgt
  | Integer
coeff Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Int64
0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
tgt
  | Integer
e Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer
coeff Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer Int64
tgt
  | Integer
coeff Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 =
      if | Int64
tgt Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 -> Bool
True
         | Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 -> case LargeScientific -> (# (# #) | Int# #)
largeToInt LargeScientific
large0 of
             (# (# #) | #) -> Bool
True
             (# | Int#
i# #) -> Int# -> Int64
I64# Int#
i# Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
tgt
         | Bool
otherwise -> case Bool -> Integer -> Integer -> Estimate
posSciLowerBound Bool
False Integer
coeff Integer
e of
             Exactly Integer
n -> Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer Int64
tgt
             LowerBoundedMagnitude Integer
n -> (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer Int64
tgt
  | Bool
otherwise = -- Coefficent is negative
      if | Int64
tgt Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 -> Bool
False
         | Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 -> case LargeScientific -> (# (# #) | Int# #)
largeToInt LargeScientific
large0 of
             (# (# #) | #) -> Bool
False
             (# | Int#
i# #) -> Int# -> Int64
I64# Int#
i# Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
tgt
         | Bool
otherwise -> case Bool -> Integer -> Integer -> Estimate
posSciLowerBound Bool
False Integer
coeff Integer
e of
             Exactly Integer
n -> Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer Int64
tgt
             LowerBoundedMagnitude Integer
n -> Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer Int64
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 :: (Int -> Int -> a) -> (Integer -> Integer -> a) -> Scientific -> a
withExposed Int -> Int -> a
f Integer -> Integer -> a
g (Scientific Int
coeff Int
theExp LargeScientific
big) = if Int
theExp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall a. Bounded a => a
minBound
  then Int -> Int -> a
f Int
coeff Int
theExp
  else case LargeScientific
big of
    LargeScientific Integer
coeff' Integer
theExp' -> Integer -> Integer -> a
g Integer
coeff' Integer
theExp'

toSmallHelper ::
     (Int -> Int -> (# (# #) | Word# #) ) -- small
  -> (LargeScientific -> (# (# #) | Word# #) ) -- large
  -> Int#
  -> Int#
  -> LargeScientific
  -> (# (# #) | Word# #)
{-# inline toSmallHelper #-}
toSmallHelper :: (Int -> Int -> (# (# #) | Word# #))
-> (LargeScientific -> (# (# #) | Word# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Word# #)
toSmallHelper Int -> Int -> (# (# #) | Word# #)
fromSmall LargeScientific -> (# (# #) | Word# #)
fromLarge Int#
coefficient0# Int#
exponent0# LargeScientific
large0 =
  if Int
exponent0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall a. Bounded a => a
minBound
    then Int -> Int -> (# (# #) | Word# #)
fromSmall Int
coefficient0 Int
exponent0
    else LargeScientific -> (# (# #) | Word# #)
fromLarge LargeScientific
large0
  where
  coefficient0 :: Int
coefficient0 = Int# -> Int
I# Int#
coefficient0#
  exponent0 :: Int
exponent0 = Int# -> Int
I# Int#
exponent0#

toSmallIntHelper ::
     (Int -> Int -> (# (# #) | Int# #) ) -- small
  -> (LargeScientific -> (# (# #) | Int# #) ) -- large
  -> Int#
  -> Int#
  -> LargeScientific
  -> (# (# #) | Int# #)
{-# inline toSmallIntHelper #-}
toSmallIntHelper :: (Int -> Int -> (# (# #) | Int# #))
-> (LargeScientific -> (# (# #) | Int# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Int# #)
toSmallIntHelper Int -> Int -> (# (# #) | Int# #)
fromSmall LargeScientific -> (# (# #) | Int# #)
fromLarge Int#
coefficient0# Int#
exponent0# LargeScientific
large0 =
  if Int
exponent0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall a. Bounded a => a
minBound
    then Int -> Int -> (# (# #) | Int# #)
fromSmall Int
coefficient0 Int
exponent0
    else LargeScientific -> (# (# #) | Int# #)
fromLarge LargeScientific
large0
  where
  coefficient0 :: Int
coefficient0 = Int# -> Int
I# Int#
coefficient0#
  exponent0 :: Int
exponent0 = Int# -> Int
I# Int#
exponent0#


toWord8# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord8# #-}
toWord8# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord8# Int#
coefficient0# Int#
exponent0# LargeScientific
large0 = 
  (Int -> Int -> (# (# #) | Word# #))
-> (LargeScientific -> (# (# #) | Word# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Word# #)
toSmallHelper Int -> Int -> (# (# #) | Word# #)
smallToWord8 LargeScientific -> (# (# #) | Word# #)
largeToWord8
    Int#
coefficient0# Int#
exponent0# LargeScientific
large0

toWord16# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord16# #-}
toWord16# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord16# Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum =
  (Int -> Int -> (# (# #) | Word# #))
-> (LargeScientific -> (# (# #) | Word# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Word# #)
toSmallHelper Int -> Int -> (# (# #) | Word# #)
smallToWord16 LargeScientific -> (# (# #) | Word# #)
largeToWord16
    Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum

toWord32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord32# #-}
toWord32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord32# Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum =
  (Int -> Int -> (# (# #) | Word# #))
-> (LargeScientific -> (# (# #) | Word# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Word# #)
toSmallHelper Int -> Int -> (# (# #) | Word# #)
smallToWord32 LargeScientific -> (# (# #) | Word# #)
largeToWord32
    Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum

toInt32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
{-# noinline toInt32# #-}
toInt32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
toInt32# Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum =
  (Int -> Int -> (# (# #) | Int# #))
-> (LargeScientific -> (# (# #) | Int# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Int# #)
toSmallIntHelper Int -> Int -> (# (# #) | Int# #)
smallToInt32 LargeScientific -> (# (# #) | Int# #)
largeToInt32
    Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum

toWord# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord# #-}
toWord# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
toWord# Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum =
  (Int -> Int -> (# (# #) | Word# #))
-> (LargeScientific -> (# (# #) | Word# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Word# #)
toSmallHelper Int -> Int -> (# (# #) | Word# #)
smallToWord LargeScientific -> (# (# #) | Word# #)
largeToWord
    Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum

toInt# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
{-# noinline toInt# #-}
toInt# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
toInt# Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum =
  (Int -> Int -> (# (# #) | Int# #))
-> (LargeScientific -> (# (# #) | Int# #))
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Int# #)
toSmallIntHelper Int -> Int -> (# (# #) | Int# #)
smallToInt LargeScientific -> (# (# #) | Int# #)
largeToInt
    Int#
coefficient0# Int#
exponent0# LargeScientific
largeNum

roundToInt# :: Int# -> Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
{-# noinline roundToInt# #-}
roundToInt# :: Int# -> Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
roundToInt# Int#
coefficient0# Int#
exponent0# Int#
adjustment0# LargeScientific
largeNum =
  if Int
exponent0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall a. Bounded a => a
minBound
    then
      if | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (# | Int#
0# #)
         | Int
exponent0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
200) -> (# (# #) | #)
         | Int
exponent0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
forall a. Bounded a => a
minBound Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
200) -> (# (# #) | #)
         | Int
adjustment0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100 -> (# (# #) | #)
         | Int
adjustment0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (-Int
100) -> (# (# #) | #)
         | Bool
otherwise ->
             Int -> Int -> (# (# #) | Int# #)
roundSmallToInt Int
coefficient0 (Int# -> Int
I# (Int#
exponent0# Int# -> Int# -> Int#
+# Int#
adjustment0#))
    else Int -> LargeScientific -> (# (# #) | Int# #)
roundLargeToInt Int
adjustment0 LargeScientific
largeNum
  where
  coefficient0 :: Int
coefficient0 = Int# -> Int
I# Int#
coefficient0#
  exponent0 :: Int
exponent0 = Int# -> Int
I# Int#
exponent0#
  adjustment0 :: Int
adjustment0 = Int# -> Int
I# Int#
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 :: Int -> Int -> (# (# #) | Word# #)
smallToWord32 !Int
coefficient0 !Int
exponent0
  | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (# | Word#
0## #)
  | (Int
coefficient,Int
expon) <- Int -> Int -> (Int, Int)
incrementNegativeExp Int
coefficient0 Int
exponent0
  , Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10, Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFFFFFF
    = Word -> Int -> (# (# #) | Word# #)
word32Exp10 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word Int
coefficient) Int
expon
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized coefficient and exponent.
smallToInt32 :: Int -> Int -> (# (# #) | Int# #)
smallToInt32 :: Int -> Int -> (# (# #) | Int# #)
smallToInt32 !Int
coefficient0 !Int
exponent0
  | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (# | Int#
0# #)
  | (Int
coefficient,Int
expon) <- Int -> Int -> (Int, Int)
incrementNegativeExp Int
coefficient0 Int
exponent0
  , Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10
  , Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int (Int32
forall a. Bounded a => a
minBound :: Int32)
  , Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int (Int32
forall a. Bounded a => a
maxBound :: Int32)
    = if Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then Int -> Int -> (# (# #) | Int# #)
posInt32Exp10 Int
coefficient Int
expon
        else Int -> Int -> (# (# #) | Int# #)
negInt32Exp10 Int
coefficient Int
expon
  | Bool
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 :: Int -> Int -> (# (# #) | Word# #)
smallToWord !Int
coefficient0 !Int
exponent0
  | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (# | Word#
0## #)
  | (Int
coefficient,Int
expon) <- Int -> Int -> (Int, Int)
incrementNegativeExp Int
coefficient0 Int
exponent0
  , Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30, Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
    = Word -> Int -> (# (# #) | Word# #)
wordExp10 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word Int
coefficient) Int
expon
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized coefficient and exponent.
smallToInt :: Int -> Int -> (# (# #) | Int# #)
smallToInt :: Int -> Int -> (# (# #) | Int# #)
smallToInt !Int
coefficient0 !Int
exponent0
  | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (# | Int#
0# #)
  | (Int
coefficient,Int
expon) <- Int -> Int -> (Int, Int)
incrementNegativeExp Int
coefficient0 Int
exponent0
  , Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30
    = if Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then Int -> Int -> (# (# #) | Int# #)
posIntExp10 Int
coefficient Int
expon
        else Int -> Int -> (# (# #) | Int# #)
negIntExp10 Int
coefficient Int
expon
  | Bool
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 :: Int -> Int -> (# (# #) | Int# #)
roundSmallToInt !Int
coefficient0 !Int
exponent0
  | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (# | Int#
0# #)
  | (coefficient :: Int
coefficient@(I# Int#
coefficient# ),Int
expon) <- Int -> Int -> (Int, Int)
incrementNegativeExp Int
coefficient0 Int
exponent0
  , Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30 = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
expon Int
0 of
      Ordering
EQ -> (# | Int#
coefficient# #)
      Ordering
GT -> if Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then Int -> Int -> (# (# #) | Int# #)
posIntExp10 Int
coefficient Int
expon
        else Int -> Int -> (# (# #) | Int# #)
negIntExp10 Int
coefficient Int
expon
      Ordering
LT -> if Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then (# | Int -> Int -> Int#
roundPosIntNegExp10 Int
coefficient Int
expon #)
        else (# | Int -> Int -> Int#
roundNegIntNegExp10 Int
coefficient Int
expon #)
  | Bool
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 :: Int -> Int -> (# (# #) | Word# #)
smallToWord16 !Int
coefficient0 !Int
exponent0
  | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (# | Word#
0## #)
  | (Int
coefficient,Int
expon) <- Int -> Int -> (Int, Int)
incrementNegativeExp Int
coefficient0 Int
exponent0
  , Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5, Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
65536
  , Int
r <- Int -> Int -> Int
exp10 Int
coefficient Int
expon
  , y :: Word16
y@(W16# Word#
y# ) <- Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word16 Int
r
  , Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
    = (# | Word#
y# #)
  | Bool
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 :: Int -> Int -> (# (# #) | Word# #)
smallToWord8 !Int
coefficient0 !Int
exponent0
  | Int
coefficient0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (# | Word#
0## #)
  | (Int
coefficient,Int
expon) <- Int -> Int -> (Int, Int)
incrementNegativeExp Int
coefficient0 Int
exponent0
  , Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3, Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
coefficient Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256
  , Int
r <- Int -> Int -> Int
exp10 Int
coefficient Int
expon
  , y :: Word8
y@(W8# Word#
y# ) <- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word8 Int
r
  , Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Int Word8
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
    = (# | Word#
y# #)
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized
largeToWord8 :: LargeScientific -> (# (# #) | Word# #)
largeToWord8 :: LargeScientific -> (# (# #) | Word# #)
largeToWord8 (LargeScientific Integer
coefficient0 Integer
exponent0)
  | Integer
coefficient0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (# | Word#
0## #)
  | (Integer
coefficient,Integer
expon) <- Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
coefficient0 Integer
exponent0
  , Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
3, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
256
  , Int
r <- Int -> Int -> Int
exp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
  , y :: Word8
y@(W8# Word#
y# ) <- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word8 Int
r
  , Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Int Word8
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
    = (# | Word#
y# #)
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized
largeToWord16 :: LargeScientific -> (# (# #) | Word# #)
largeToWord16 :: LargeScientific -> (# (# #) | Word# #)
largeToWord16 (LargeScientific Integer
coefficient0 Integer
exponent0)
  | Integer
coefficient0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (# | Word#
0## #)
  | (Integer
coefficient,Integer
expon) <- Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
coefficient0 Integer
exponent0
  , Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
5, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
65536
  , Int
r <- Int -> Int -> Int
exp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
  , y :: Word16
y@(W16# Word#
y# ) <- Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word16 Int
r
  , Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
    = (# | Word#
y# #)
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized
largeToWord32 :: LargeScientific -> (# (# #) | Word# #)
largeToWord32 :: LargeScientific -> (# (# #) | Word# #)
largeToWord32 (LargeScientific Integer
coefficient0 Integer
exponent0)
  | Integer
coefficient0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (# | Word#
0## #)
  | (Integer
coefficient,Integer
expon) <- Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
coefficient0 Integer
exponent0
  , Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
10, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0xFFFFFFFF
    = Word -> Int -> (# (# #) | Word# #)
word32Exp10 (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Word Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized, this targets the native word size
largeToWord :: LargeScientific -> (# (# #) | Word# #)
largeToWord :: LargeScientific -> (# (# #) | Word# #)
largeToWord (LargeScientific Integer
coefficient0 Integer
exponent0)
  | Integer
coefficient0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (# | Word#
0## #)
  | (Integer
coefficient,Integer
expon) <- Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
coefficient0 Integer
exponent0
  , Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
30, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Integer Word
forall a. Bounded a => a
maxBound)
    = Word -> Int -> (# (# #) | Word# #)
wordExp10 (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Word Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized
largeToInt32 :: LargeScientific -> (# (# #) | Int# #)
largeToInt32 :: LargeScientific -> (# (# #) | Int# #)
largeToInt32 (LargeScientific Integer
coefficient0 Integer
exponent0)
  | Integer
coefficient0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (# | Int#
0# #)
  | (Integer
coefficient,Integer
expon) <- Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
coefficient0 Integer
exponent0
  , Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
10
  , Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Integer Int32
forall a. Bounded a => a
minBound)
  , Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Integer Int32
forall a. Bounded a => a
maxBound)
    = if Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
        then Int -> Int -> (# (# #) | Int# #)
posInt32Exp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
        else Int -> Int -> (# (# #) | Int# #)
negInt32Exp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized, this targets the native word size
largeToInt :: LargeScientific -> (# (# #) | Int# #)
largeToInt :: LargeScientific -> (# (# #) | Int# #)
largeToInt (LargeScientific Integer
coefficient0 Integer
exponent0)
  | Integer
coefficient0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (# | Int#
0# #)
  | (Integer
coefficient,Integer
expon) <- Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
coefficient0 Integer
exponent0
  , Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
30
  , Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer Int
forall a. Bounded a => a
minBound)
  , Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer Int
forall a. Bounded a => a
maxBound)
    = if Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
        then Int -> Int -> (# (# #) | Int# #)
posIntExp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
        else Int -> Int -> (# (# #) | Int# #)
negIntExp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
  | Bool
otherwise = (# (# #) | #)

-- Arguments are non-normalized, this targets the native word size
roundLargeToInt :: Int -> LargeScientific -> (# (# #) | Int# #)
roundLargeToInt :: Int -> LargeScientific -> (# (# #) | Int# #)
roundLargeToInt !Int
adj (LargeScientific Integer
coefficient0 Integer
exponent0)
  | Integer
coefficient0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = (# | Int#
0# #)
  | (Integer
coefficient,Integer
expon) <- Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
coefficient0 Integer
exponent1
  , Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
30
    = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
expon Integer
0 of
        Ordering
EQ -> case Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient of
          I# Int#
r -> (# | Int#
r #)
        Ordering
GT ->
          if Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer Int
forall a. Bounded a => a
minBound) Bool -> Bool -> Bool
&& Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer Int
forall a. Bounded a => a
maxBound)
            then if Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
              then Int -> Int -> (# (# #) | Int# #)
posIntExp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
              else Int -> Int -> (# (# #) | Int# #)
negIntExp10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
coefficient) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Int Integer
expon)
            else (# (# #) | #)
        Ordering
LT -> if Integer
expon Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (-Integer
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.
               (# | Int#
0# #)
          else if Integer
coefficient Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
            then Integer -> Int -> (# (# #) | Int# #)
roundPosIntegerNegExp10 Integer
coefficient (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
expon)
            else Integer -> Int -> (# (# #) | Int# #)
roundNegIntegerNegExp10 Integer
coefficient (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
expon)
  | Bool
otherwise = (# (# #) | #)
  where
  exponent1 :: Integer
exponent1 = Integer
exponent0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
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 :: Word -> Int -> (# (# #) | Word# #)
word32Exp10 !a :: Word
a@(W# Word#
a# ) !Int
e = case Int
e of
  Int
0 -> (# | Word#
a# #)
  Int
_ -> let (Bool
overflow, Word
a') = Word -> Word -> (Bool, Word)
timesWord2 Word
a Word
10 in
    if Bool
overflow Bool -> Bool -> Bool
|| (Word
a' Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0xFFFFFFFF)
      then (# (# #) | #)
      else Word -> Int -> (# (# #) | Word# #)
word32Exp10 Word
a' (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Int -> Int -> (# (# #) | Int# #)
posInt32Exp10 !a :: Int
a@(I# Int#
a# ) !Int
e = case Int
e of
  Int
0 -> (# | Int#
a# #)
  Int
_ -> if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
posInt32PreUpper
    then let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 in
      if Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
a Bool -> Bool -> Bool
&& Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
maxBound :: Int32)
        then Int -> Int -> (# (# #) | Int# #)
posInt32Exp10 Int
a' (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Int -> Int -> (# (# #) | Int# #)
negInt32Exp10 !a :: Int
a@(I# Int#
a# ) !Int
e = case Int
e of
  Int
0 -> (# | Int#
a# #)
  Int
_ -> if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
negInt32PreLower
    then let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 in
      if Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
a Bool -> Bool -> Bool
&& Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
minBound :: Int32)
        then Int -> Int -> (# (# #) | Int# #)
negInt32Exp10 Int
a' (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        else (# (# #) | #)
    else (# (# #) | #)

-- Precondition: the exponent is non-negative. This returns
-- an unboxed Nothing on overflow.
wordExp10 :: Word -> Int -> (# (# #) | Word# #)
wordExp10 :: Word -> Int -> (# (# #) | Word# #)
wordExp10 !a :: Word
a@(W# Word#
a# ) !Int
e = case Int
e of
  Int
0 -> (# | Word#
a# #)
  Int
_ -> let (Bool
overflow, Word
a') = Word -> Word -> (Bool, Word)
timesWord2 Word
a Word
10 in if Bool
overflow
    then (# (# #) | #)
    else Word -> Int -> (# (# #) | Word# #)
wordExp10 Word
a' (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Int -> Int -> (# (# #) | Int# #)
posIntExp10 !a :: Int
a@(I# Int#
a# ) !Int
e = case Int
e of
  Int
0 -> (# | Int#
a# #)
  Int
_ -> if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
posIntPreUpper
    then let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 in
      if Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
a
        then Int -> Int -> (# (# #) | Int# #)
posIntExp10 Int
a' (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Int -> Int -> Int#
roundPosIntNegExp10 !a :: Int
a@(I# Int#
a# ) !Int
e = case Int
e of
  Int
0 -> Int#
a#
  Int
_ -> Int -> Int -> Int#
roundPosIntNegExp10 (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
a Int
10) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Integer -> Int -> (# (# #) | Int# #)
roundPosIntegerNegExp10 !Integer
a !Int
e = case Int
e of
  Int
0 -> if Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer Int
forall a. Bounded a => a
maxBound
    then (# (# #) | #)
    else case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
a of
      I# Int#
a# -> (# | Int#
a# #)
  Int
_ -> case Integer
a of
    Integer
0 -> (# | Int#
0# #)
    Integer
_ -> Integer -> Int -> (# (# #) | Int# #)
roundPosIntegerNegExp10 (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
a Integer
10) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Int -> Int -> (# (# #) | Int# #)
negIntExp10 !a :: Int
a@(I# Int#
a# ) !Int
e = case Int
e of
  Int
0 -> (# | Int#
a# #)
  Int
_ -> if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
negIntPreLower
    then let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 in
      if Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
a
        then Int -> Int -> (# (# #) | Int# #)
negIntExp10 Int
a' (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Int -> Int -> Int#
roundNegIntNegExp10 !a :: Int
a@(I# Int#
a# ) !Int
e = case Int
e of
  Int
0 -> Int#
a#
  Int
_ -> Int -> Int -> Int#
roundNegIntNegExp10 (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
a Int
10) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Integer -> Int -> (# (# #) | Int# #)
roundNegIntegerNegExp10 !Integer
a !Int
e = case Int
e of
  Int
0 -> if Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer Int
forall a. Bounded a => a
maxBound
    then (# (# #) | #)
    else case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
a of
      I# Int#
a# -> (# | Int#
a# #)
  Int
_ -> case Integer
a of
    Integer
0 -> (# | Int#
0# #)
    Integer
_ -> Integer -> Int -> (# (# #) | Int# #)
roundNegIntegerNegExp10 (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
a Integer
10) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Int
posIntPreUpper = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
forall a. Bounded a => a
maxBound Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10

negIntPreLower :: Int
negIntPreLower :: Int
negIntPreLower = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
forall a. Bounded a => a
minBound Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10

posInt32PreUpper :: Int
posInt32PreUpper :: Int
posInt32PreUpper = Int
214748370

negInt32PreLower :: Int
negInt32PreLower :: Int
negInt32PreLower = (-Int
214748370)

-- Bool is true if overflow happened
timesWord2 :: Word -> Word -> (Bool, Word)
timesWord2 :: Word -> Word -> (Bool, Word)
timesWord2 (W# Word#
a) (W# Word#
b) =
  let !(# Word#
c, Word#
r #) = Word# -> Word# -> (# Word#, Word# #)
Exts.timesWord2# Word#
a Word#
b
   in (case Word#
c of { Word#
0## -> Bool
False; Word#
_ -> Bool
True}, Word# -> Word
W# Word#
r)

-- Precondition: the exponent is non-negative
exp10 :: Int -> Int -> Int
exp10 :: Int -> Int -> Int
exp10 !Int
a !Int
e = case Int
e of
  Int
0 -> Int
a
  Int
_ -> Int -> Int -> Int
exp10 (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

largeNormalize :: LargeScientific -> LargeScientific
largeNormalize :: LargeScientific -> LargeScientific
largeNormalize s :: LargeScientific
s@(LargeScientific Integer
w Integer
_) = case Integer
w of
  Integer
0 -> Integer -> Integer -> LargeScientific
LargeScientific Integer
0 Integer
0
  Integer
_ -> LargeScientific -> LargeScientific
largeNormalizeLoop LargeScientific
s

-- Precondition: the coefficient is non-zero
largeNormalizeLoop :: LargeScientific -> LargeScientific
largeNormalizeLoop :: LargeScientific -> LargeScientific
largeNormalizeLoop (LargeScientific Integer
w Integer
e) = case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
w Integer
10 of
  (Integer
q,Integer
r) -> case Integer
r of
    Integer
0 -> LargeScientific -> LargeScientific
largeNormalizeLoop (Integer -> Integer -> LargeScientific
LargeScientific Integer
q (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1))
    Integer
_ -> Integer -> Integer -> LargeScientific
LargeScientific Integer
w Integer
e

largeIncrementNegativeExp :: Integer -> Integer -> (Integer,Integer)
largeIncrementNegativeExp :: Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
w Integer
e = if Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
  then (Integer
w,Integer
e)
  else case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
w Integer
10 of
    (Integer
q,Integer
r) -> case Integer
r of
      Integer
0 -> Integer -> Integer -> (Integer, Integer)
largeIncrementNegativeExp Integer
q (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
      Integer
_ -> (Integer
w,Integer
e)

smallNormalize :: Int -> Int -> (Int,Int)
smallNormalize :: Int -> Int -> (Int, Int)
smallNormalize (I# Int#
w) (I# Int#
e) = case Int#
w of
  Int#
0# -> (Int
0,Int
0)
  Int#
_ -> case Int# -> Int# -> (# Int#, Int# #)
smallNormalize# Int#
w Int#
e of
    (# Int#
w', Int#
e' #) -> (Int# -> Int
I# Int#
w', Int# -> Int
I# Int#
e')

incrementNegativeExp :: Int -> Int -> (Int,Int)
incrementNegativeExp :: Int -> Int -> (Int, Int)
incrementNegativeExp (I# Int#
w) (I# Int#
e) = case Int# -> Int# -> (# Int#, Int# #)
incrementNegativeExp# Int#
w Int#
e of
  (# Int#
w', Int#
e' #) -> (Int# -> Int
I# Int#
w', Int# -> Int
I# Int#
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# :: Int# -> Int# -> (# Int#, Int# #)
incrementNegativeExp# Int#
w# Int#
e# = if Int# -> Int
I# Int#
e# Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  then (# Int#
w#, Int#
e# #)
  else case Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem (Int# -> Int
I# Int#
w# ) Int
10 of
    (I# Int#
q#,Int
r) -> case Int
r of
      Int
0 -> Int# -> Int# -> (# Int#, Int# #)
incrementNegativeExp# Int#
q# (Int#
e# Int# -> Int# -> Int#
+# Int#
1# )
      Int
_ -> (# Int#
w#, Int#
e# #)

-- Precondition: coefficient is not zero. If it is,
-- this will loop.
smallNormalize# :: Int# -> Int# -> (# Int#, Int# #)
{-# noinline smallNormalize# #-}
smallNormalize# :: Int# -> Int# -> (# Int#, Int# #)
smallNormalize# Int#
w# Int#
e# = case Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem (Int# -> Int
I# Int#
w# ) Int
10 of
  (I# Int#
q#,Int
r) -> case Int
r of
    Int
0 -> Int# -> Int# -> (# Int#, Int# #)
smallNormalize# Int#
q# (Int#
e# Int# -> Int# -> Int#
+# Int#
1# )
    Int
_ -> (# Int#
w#, Int#
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 -> Parser e s Scientific
parserSignedUtf8Bytes e
e = Parser e s Scientific# -> Parser e s Scientific
forall s e. Parser s e Scientific# -> Parser s e Scientific
boxScientific (e -> Parser e s Scientific#
forall e s. e -> Parser e s Scientific#
parserSignedUtf8Bytes# e
e)

-- | Variant of 'parserSignedUtf8Bytes' that rejects strings with
-- a leading plus or minus sign.
parserUnsignedUtf8Bytes :: e -> Parser e s Scientific
parserUnsignedUtf8Bytes :: e -> Parser e s Scientific
parserUnsignedUtf8Bytes e
e = Parser e s Scientific# -> Parser e s Scientific
forall s e. Parser s e Scientific# -> Parser s e Scientific
boxScientific (e -> Parser e s Scientific#
forall e s. e -> Parser e s Scientific#
parserUnsignedUtf8Bytes# e
e)

-- | Variant of 'parserUnsignedUtf8Bytes' that negates the result.
parserNegatedUtf8Bytes :: e -> Parser e s Scientific
parserNegatedUtf8Bytes :: e -> Parser e s Scientific
parserNegatedUtf8Bytes e
e = Parser e s Scientific# -> Parser e s Scientific
forall s e. Parser s e Scientific# -> Parser s e Scientific
boxScientific (e -> Parser e s Scientific#
forall e s. e -> Parser e s Scientific#
parserNegatedUtf8Bytes# e
e)

parserTrailingUtf8Bytes# ::
     e -- ^ Error message
  -> Int# -- ^ Leading digit
  -> Parser e s Scientific#
{-# noinline parserTrailingUtf8Bytes# #-}
parserTrailingUtf8Bytes# :: e -> Int# -> Parser e s Scientific#
parserTrailingUtf8Bytes# e
e Int#
leader =
  Parser () s (# Int#, Int# #) -> Parser () s Scientific#
forall e s. Parser e s (# Int#, Int# #) -> Parser e s Scientific#
mapIntPairToScientific (Int# -> Parser () s (# Int#, Int# #)
forall s. Int# -> Parser () s (# Int#, Int# #)
parseSmallTrailing# Int#
leader)
  Parser () s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
forall x s e.
Parser x s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
`orElseScientific`
  Parser e s LargeScientific -> Parser e s Scientific#
forall e s. Parser e s LargeScientific -> Parser e s Scientific#
upcastLargeScientific (e -> Int -> Parser e s LargeScientific
forall e s. e -> Int -> Parser e s LargeScientific
parseLargeTrailing e
e (Int# -> Int
I# Int#
leader))

parserNegatedTrailingUtf8Bytes# ::
     e -- ^ Error message
  -> Int# -- ^ Leading digit
  -> Parser e s Scientific#
{-# noinline parserNegatedTrailingUtf8Bytes# #-}
parserNegatedTrailingUtf8Bytes# :: e -> Int# -> Parser e s Scientific#
parserNegatedTrailingUtf8Bytes# e
e Int#
leader =
  Parser () s (# Int#, Int# #) -> Parser () s Scientific#
forall e s. Parser e s (# Int#, Int# #) -> Parser e s Scientific#
mapNegateIntPairToScientific (Int# -> Parser () s (# Int#, Int# #)
forall s. Int# -> Parser () s (# Int#, Int# #)
parseSmallTrailing# Int#
leader)
  Parser () s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
forall x s e.
Parser x s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
`orElseScientific`
  Parser e s LargeScientific -> Parser e s Scientific#
forall e s. Parser e s LargeScientific -> Parser e s Scientific#
upcastNegatedLargeScientific (e -> Int -> Parser e s LargeScientific
forall e s. e -> Int -> Parser e s LargeScientific
parseLargeTrailing e
e (Int# -> Int
I# Int#
leader))

parserSignedUtf8Bytes# ::
     e -- ^ Error message
  -> Parser e s Scientific#
parserSignedUtf8Bytes# :: e -> Parser e s Scientific#
parserSignedUtf8Bytes# e
e = e -> Parser e s Char
forall e s. e -> Parser e s Char
Latin.any e
e Parser e s Char
-> (Char -> Parser e s Scientific#) -> Parser e s Scientific#
forall s e a.
Parser s e a
-> (a -> Parser s e Scientific#) -> Parser s e Scientific#
`bindToScientific` \Char
c -> case Char
c of
  Char
'+' -> e -> Parser e s Scientific#
forall e s. e -> Parser e s Scientific#
parserUnsignedUtf8Bytes# e
e
  Char
'-' -> e -> Parser e s Scientific#
forall e s. e -> Parser e s Scientific#
parserNegatedUtf8Bytes# e
e
  Char
_ -> Int -> Parser e s ()
forall e s. Int -> Parser e s ()
Unsafe.unconsume Int
1 Parser e s ()
-> (() -> Parser e s Scientific#) -> Parser e s Scientific#
forall s e a.
Parser s e a
-> (a -> Parser s e Scientific#) -> Parser s e Scientific#
`bindToScientific` \()
_ ->
    e -> Parser e s Scientific#
forall e s. e -> Parser e s Scientific#
parserUnsignedUtf8Bytes# e
e

-- | Variant of 'parseUnsignedUtf8Bytes' where all arguments are
-- unboxed.
parserUnsignedUtf8Bytes# ::
     e -- ^ Error message
  -> Parser e s Scientific#
parserUnsignedUtf8Bytes# :: e -> Parser e s Scientific#
parserUnsignedUtf8Bytes# e
e =
  Parser () s (# Int#, Int# #) -> Parser () s Scientific#
forall e s. Parser e s (# Int#, Int# #) -> Parser e s Scientific#
mapIntPairToScientific Parser () s (# Int#, Int# #)
forall s. Parser () s (# Int#, Int# #)
parseSmall#
  Parser () s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
forall x s e.
Parser x s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
`orElseScientific`
  Parser e s LargeScientific -> Parser e s Scientific#
forall e s. Parser e s LargeScientific -> Parser e s Scientific#
upcastLargeScientific (e -> Parser e s LargeScientific
forall e s. e -> Parser e s LargeScientific
parseLarge e
e)

-- Negates the result after parsing the bytes.
parserNegatedUtf8Bytes# ::
     e -- ^ Error message
  -> Parser e s Scientific#
parserNegatedUtf8Bytes# :: e -> Parser e s Scientific#
parserNegatedUtf8Bytes# e
e =
  Parser () s (# Int#, Int# #) -> Parser () s Scientific#
forall e s. Parser e s (# Int#, Int# #) -> Parser e s Scientific#
mapNegateIntPairToScientific Parser () s (# Int#, Int# #)
forall s. Parser () s (# Int#, Int# #)
parseSmall#
  Parser () s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
forall x s e.
Parser x s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
`orElseScientific`
  Parser e s LargeScientific -> Parser e s Scientific#
forall e s. Parser e s LargeScientific -> Parser e s Scientific#
upcastNegatedLargeScientific (e -> Parser e s LargeScientific
forall e s. e -> Parser e s LargeScientific
parseLarge e
e)

parserTrailingUtf8Bytes ::
     e -- ^ Error message
  -> Int -- ^ Leading digit, should be between @-9@ and @9@.
  -> Parser e s Scientific
parserTrailingUtf8Bytes :: e -> Int -> Parser e s Scientific
parserTrailingUtf8Bytes e
e (I# Int#
leader) =
  Parser e s Scientific# -> Parser e s Scientific
forall s e. Parser s e Scientific# -> Parser s e Scientific
boxScientific (e -> Int# -> Parser e s Scientific#
forall e s. e -> Int# -> Parser e s Scientific#
parserTrailingUtf8Bytes# e
e Int#
leader)

parserNegatedTrailingUtf8Bytes ::
     e -- ^ Error message
  -> Int -- ^ Leading digit, should be between @-9@ and @9@.
  -> Parser e s Scientific
parserNegatedTrailingUtf8Bytes :: e -> Int -> Parser e s Scientific
parserNegatedTrailingUtf8Bytes e
e (I# Int#
leader) =
  Parser e s Scientific# -> Parser e s Scientific
forall s e. Parser s e Scientific# -> Parser s e Scientific
boxScientific (e -> Int# -> Parser e s Scientific#
forall e s. e -> Int# -> Parser e s Scientific#
parserNegatedTrailingUtf8Bytes# e
e Int#
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 -> Parser e s LargeScientific
parseLarge e
e = do
  Integer
coeff <- e -> Parser e s Integer
forall e s. e -> Parser e s Integer
Latin.decUnsignedInteger e
e
  e -> Integer -> Parser e s LargeScientific
forall e s. e -> Integer -> Parser e s LargeScientific
parseLargeCommon e
e Integer
coeff

parseLargeTrailing :: e -> Int -> Parser e s LargeScientific
parseLargeTrailing :: e -> Int -> Parser e s LargeScientific
parseLargeTrailing e
e !Int
leader = do
  Integer
coeff <- Int -> Parser e s Integer
forall e s. Int -> Parser e s Integer
Latin.decTrailingInteger Int
leader
  e -> Integer -> Parser e s LargeScientific
forall e s. e -> Integer -> Parser e s LargeScientific
parseLargeCommon e
e Integer
coeff

parseLargeCommon :: e -> Integer -> Parser e s LargeScientific
{-# noinline parseLargeCommon #-}
parseLargeCommon :: e -> Integer -> Parser e s LargeScientific
parseLargeCommon e
e Integer
coeff = do
  Parser e s LargeScientific
-> (Char -> Maybe (Parser e s LargeScientific))
-> Parser e s LargeScientific
forall e s a.
Parser e s a -> (Char -> Maybe (Parser e s a)) -> Parser e s a
Latin.trySatisfyThen (LargeScientific -> Parser e s LargeScientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer -> LargeScientific
LargeScientific Integer
coeff Integer
0)) ((Char -> Maybe (Parser e s LargeScientific))
 -> Parser e s LargeScientific)
-> (Char -> Maybe (Parser e s LargeScientific))
-> Parser e s LargeScientific
forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
    Char
'.' -> Parser e s LargeScientific -> Maybe (Parser e s LargeScientific)
forall a. a -> Maybe a
Just (Parser e s LargeScientific -> Maybe (Parser e s LargeScientific))
-> Parser e s LargeScientific -> Maybe (Parser e s LargeScientific)
forall a b. (a -> b) -> a -> b
$ do
      !Int
start <- Parser e s Int
forall e s. Parser e s Int
Unsafe.cursor
      Integer
afterDot <- e -> Parser e s Integer
forall e s. e -> Parser e s Integer
Latin.decUnsignedInteger e
e
      !Int
end <- Parser e s Int
forall e s. Parser e s Int
Unsafe.cursor
      let !logDenom :: Int
logDenom = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
          !coeffFinal :: Integer
coeffFinal = (Integer -> Int -> Integer
integerTenExp Integer
coeff Int
logDenom) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
afterDot
      (Char -> Bool) -> Parser e s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (\Char
ch -> Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E') Parser e s Bool
-> (Bool -> Parser e s LargeScientific)
-> Parser e s LargeScientific
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> e -> Integer -> Int# -> Parser e s LargeScientific
forall e s. e -> Integer -> Int# -> Parser e s LargeScientific
attemptLargeExp e
e Integer
coeffFinal (Int -> Int#
unI (Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
logDenom))
        Bool
False -> LargeScientific -> Parser e s LargeScientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LargeScientific -> Parser e s LargeScientific)
-> LargeScientific -> Parser e s LargeScientific
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> LargeScientific
LargeScientific Integer
coeffFinal (Integer -> LargeScientific) -> Integer -> LargeScientific
forall a b. (a -> b) -> a -> b
$! Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$! Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
logDenom
    Char
'e' -> Parser e s LargeScientific -> Maybe (Parser e s LargeScientific)
forall a. a -> Maybe a
Just (e -> Integer -> Int# -> Parser e s LargeScientific
forall e s. e -> Integer -> Int# -> Parser e s LargeScientific
attemptLargeExp e
e Integer
coeff Int#
0# )
    Char
'E' -> Parser e s LargeScientific -> Maybe (Parser e s LargeScientific)
forall a. a -> Maybe a
Just (e -> Integer -> Int# -> Parser e s LargeScientific
forall e s. e -> Integer -> Int# -> Parser e s LargeScientific
attemptLargeExp e
e Integer
coeff Int#
0# )
    Char
_ -> Maybe (Parser e s LargeScientific)
forall a. Maybe a
Nothing

-- handles unsigned small numbers
parseSmall# :: Parser () s (# Int#, Int# #)
parseSmall# :: Parser () s (# Int#, Int# #)
parseSmall# =
  () -> Parser () s Int#
forall e s. e -> Parser e s Int#
Latin.decUnsignedInt# () Parser () s Int#
-> (Int# -> Parser () s (# Int#, Int# #))
-> Parser () s (# Int#, Int# #)
forall s e.
Parser s e Int#
-> (Int# -> Parser s e (# Int#, Int# #))
-> Parser s e (# Int#, Int# #)
`Parser.bindFromIntToIntPair` \Int#
coeff# ->
  Int# -> Parser () s (# Int#, Int# #)
forall s. Int# -> Parser () s (# Int#, Int# #)
parseSmallCommon# Int#
coeff#

parseSmallTrailing# :: Int# -> Parser () s (# Int#, Int# #)
parseSmallTrailing# :: Int# -> Parser () s (# Int#, Int# #)
parseSmallTrailing# Int#
leader =
  () -> Int# -> Parser () s Int#
forall e s. e -> Int# -> Parser e s Int#
Latin.decTrailingInt# () Int#
leader Parser () s Int#
-> (Int# -> Parser () s (# Int#, Int# #))
-> Parser () s (# Int#, Int# #)
forall s e.
Parser s e Int#
-> (Int# -> Parser s e (# Int#, Int# #))
-> Parser s e (# Int#, Int# #)
`Parser.bindFromIntToIntPair` \Int#
coeff# ->
  Int# -> Parser () s (# Int#, Int# #)
forall s. Int# -> Parser () s (# Int#, Int# #)
parseSmallCommon# Int#
coeff#

parseSmallCommon# :: Int# -> Parser () s (# Int#, Int# #)
{-# noinline parseSmallCommon# #-}
parseSmallCommon# :: Int# -> Parser () s (# Int#, Int# #)
parseSmallCommon# Int#
coeff# =
  Parser () s (# Int#, Int# #)
-> (Char -> Maybe (Parser () s (# Int#, Int# #)))
-> Parser () s (# Int#, Int# #)
forall e s a.
Parser e s a -> (Char -> Maybe (Parser e s a)) -> Parser e s a
Latin.trySatisfyThen ((# Int#, Int# #) -> Parser () s (# Int#, Int# #)
forall s e. (# Int#, Int# #) -> Parser s e (# Int#, Int# #)
Parser.pureIntPair (# Int#
coeff#, Int#
0# #)) ((Char -> Maybe (Parser () s (# Int#, Int# #)))
 -> Parser () s (# Int#, Int# #))
-> (Char -> Maybe (Parser () s (# Int#, Int# #)))
-> Parser () s (# Int#, Int# #)
forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
    Char
'.' -> Parser () s (# Int#, Int# #)
-> Maybe (Parser () s (# Int#, Int# #))
forall a. a -> Maybe a
Just (Parser () s (# Int#, Int# #)
 -> Maybe (Parser () s (# Int#, Int# #)))
-> Parser () s (# Int#, Int# #)
-> Maybe (Parser () s (# Int#, Int# #))
forall a b. (a -> b) -> a -> b
$
      Parser () s Int
forall e s. Parser e s Int
Unsafe.cursor Parser () s Int
-> (Int -> Parser () s (# Int#, Int# #))
-> Parser () s (# Int#, Int# #)
forall s e a.
Parser s e a
-> (a -> Parser s e (# Int#, Int# #))
-> Parser s e (# Int#, Int# #)
`Parser.bindFromLiftedToIntPair` \Int
start ->
      () -> Parser () s Int#
forall e s. e -> Parser e s Int#
Latin.decUnsignedInt# () Parser () s Int#
-> (Int# -> Parser () s (# Int#, Int# #))
-> Parser () s (# Int#, Int# #)
forall s e.
Parser s e Int#
-> (Int# -> Parser s e (# Int#, Int# #))
-> Parser s e (# Int#, Int# #)
`Parser.bindFromIntToIntPair` \Int#
afterDot# ->
      Parser () s Int
forall e s. Parser e s Int
Unsafe.cursor Parser () s Int
-> (Int -> Parser () s (# Int#, Int# #))
-> Parser () s (# Int#, Int# #)
forall s e a.
Parser s e a
-> (a -> Parser s e (# Int#, Int# #))
-> Parser s e (# Int#, Int# #)
`Parser.bindFromLiftedToIntPair` \Int
end ->
      let !logDenom :: Int
logDenom = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
          goCoeff :: Int -> t -> Parser () e (# Int#, Int# #)
goCoeff !Int
coeffShifted !t
expon = case t
expon of
            t
0 ->
              let !(I# Int#
coeffShifted# ) = Int
coeffShifted
                  !(# Int#
coeffFinal, Int#
overflowed #) =
                    Int# -> Int# -> (# Int#, Int# #)
Exts.addIntC# Int#
coeffShifted# Int#
afterDot#
               in case Int#
overflowed of
                Int#
0# -> (Char -> Bool) -> Parser () e Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (\Char
ch -> Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E') Parser () e Bool
-> (Bool -> Parser () e (# Int#, Int# #))
-> Parser () e (# Int#, Int# #)
forall s e a.
Parser s e a
-> (a -> Parser s e (# Int#, Int# #))
-> Parser s e (# Int#, Int# #)
`Parser.bindFromLiftedToIntPair` \Bool
b -> case Bool
b of
                  Bool
True -> Int# -> Int# -> Parser () e (# Int#, Int# #)
forall s. Int# -> Int# -> Parser () s (# Int#, Int# #)
attemptSmallExp Int#
coeffFinal (Int -> Int#
unI (Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
logDenom))
                  Bool
False -> (# Int#, Int# #) -> Parser () e (# Int#, Int# #)
forall s e. (# Int#, Int# #) -> Parser s e (# Int#, Int# #)
Parser.pureIntPair (# Int#
coeffFinal, Int -> Int#
unI (Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
logDenom) #)
                Int#
_ -> () -> Parser () e (# Int#, Int# #)
forall e s. e -> Parser e s (# Int#, Int# #)
Parser.failIntPair ()
            t
_ ->
              let coeffShifted' :: Int
coeffShifted' = Int
coeffShifted Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10
               in if Int
coeffShifted' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
coeffShifted
                    then Int -> t -> Parser () e (# Int#, Int# #)
goCoeff Int
coeffShifted' (t
expon t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
                    -- If we overflow, fail so that the parser
                    -- for large number will handle it instead.
                    else () -> Parser () e (# Int#, Int# #)
forall e s. e -> Parser e s (# Int#, Int# #)
Parser.failIntPair ()
       in Int -> Int -> Parser () s (# Int#, Int# #)
forall t e.
(Eq t, Num t) =>
Int -> t -> Parser () e (# Int#, Int# #)
goCoeff (Int# -> Int
I# Int#
coeff# ) Int
logDenom
    Char
'e' -> Parser () s (# Int#, Int# #)
-> Maybe (Parser () s (# Int#, Int# #))
forall a. a -> Maybe a
Just (Int# -> Int# -> Parser () s (# Int#, Int# #)
forall s. Int# -> Int# -> Parser () s (# Int#, Int# #)
attemptSmallExp Int#
coeff# Int#
0#)
    Char
'E' -> Parser () s (# Int#, Int# #)
-> Maybe (Parser () s (# Int#, Int# #))
forall a. a -> Maybe a
Just (Int# -> Int# -> Parser () s (# Int#, Int# #)
forall s. Int# -> Int# -> Parser () s (# Int#, Int# #)
attemptSmallExp Int#
coeff# Int#
0#)
    Char
_ -> Maybe (Parser () s (# Int#, Int# #))
forall a. Maybe a
Nothing


-- The delta passed to this is only ever a negative integer.
attemptLargeExp ::
     e
  -> Integer
  -> Int#
  -> Parser e s LargeScientific
{-# noinline attemptLargeExp #-}
attemptLargeExp :: e -> Integer -> Int# -> Parser e s LargeScientific
attemptLargeExp e
e Integer
signedCoeff !Int#
deltaExp# = do
  Integer
expon <- e -> Parser e s Integer
forall e s. e -> Parser e s Integer
Latin.decSignedInteger e
e
  let !exponent' :: Integer
exponent' = Integer
expon Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# Int#
deltaExp# )
  LargeScientific -> Parser e s LargeScientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer -> LargeScientific
LargeScientific Integer
signedCoeff Integer
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 :: Int# -> Int# -> Parser () s (# Int#, Int# #)
attemptSmallExp !Int#
signedCoeff# !Int#
deltaExp# = Parser () s (Int, Int) -> Parser () s (# Int#, Int# #)
forall e s. Parser e s (Int, Int) -> Parser e s (# Int#, Int# #)
Parser.unboxIntPair (Parser () s (Int, Int) -> Parser () s (# Int#, Int# #))
-> Parser () s (Int, Int) -> Parser () s (# Int#, Int# #)
forall a b. (a -> b) -> a -> b
$ do
  Int
e <- () -> Parser () s Int
forall e s. e -> Parser e s Int
Latin.decSignedInt ()
  -- I give this a little extra padding just to be safe.
  if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
forall a. Bounded a => a
minBound Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding)
    then (Int, Int) -> Parser () s (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
signedCoeff, Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltaExp)
    else () -> Parser () s (Int, Int)
forall e s a. e -> Parser e s a
Parser.fail ()
  where
  signedCoeff :: Int
signedCoeff = Int# -> Int
I# Int#
signedCoeff#
  deltaExp :: Int
deltaExp = Int# -> Int
I# Int#
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 s e Scientific# -> Parser s e Scientific
boxScientific (Parser (# ByteArray#, Int#, Int# #) -> ST# e (Result# s Scientific#)
f) = ((# ByteArray#, Int#, Int# #) -> ST# e (Result# s Scientific))
-> Parser s e Scientific
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
Parser
  (\(# ByteArray#, Int#, Int# #)
x State# e
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# e (Result# s Scientific#)
f (# ByteArray#, Int#, Int# #)
x State# e
s0 of
    (# State# e
s1, Result# s Scientific#
r #) -> case Result# s Scientific#
r of
      (# s
e | #) -> (# State# e
s1, (# s
e | #) #)
      (# | (# (# Int#
w, Int#
y, LargeScientific
z #), Int#
b, Int#
c #) #) -> (# State# e
s1, (# | (# Int -> Int -> LargeScientific -> Scientific
Scientific (Int# -> Int
I# Int#
w) (Int# -> Int
I# Int#
y) LargeScientific
z, Int#
b, Int#
c #) #) #)
  )

unI :: Int -> Int#
unI :: Int -> Int#
unI (I# Int#
i) = Int#
i

orElseScientific :: Parser x s Scientific# -> Parser e s Scientific# -> Parser e s Scientific#
{-# inline orElseScientific #-}
orElseScientific :: Parser x s Scientific#
-> Parser e s Scientific# -> Parser e s Scientific#
orElseScientific (Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# x Scientific#)
f) (Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# e Scientific#)
g) = ((# ByteArray#, Int#, Int# #) -> ST# s (Result# e Scientific#))
-> Parser e s Scientific#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
Parser
  (\(# ByteArray#, Int#, Int# #)
x State# s
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# s (Result# x Scientific#)
f (# ByteArray#, Int#, Int# #)
x State# s
s0 of
    (# State# s
s1, Result# x Scientific#
r0 #) -> case Result# x Scientific#
r0 of
      (# x
_ | #) -> (# ByteArray#, Int#, Int# #) -> ST# s (Result# e Scientific#)
g (# ByteArray#, Int#, Int# #)
x State# s
s1
      (# | (# Scientific#, Int#, Int# #)
r #) -> (# State# s
s1, (# | (# Scientific#, Int#, Int# #)
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 :: Integer -> Int -> Integer
integerTenExp !Integer
r !Int
e = case Int
e of
  Int
0 -> Integer
r
  Int
1 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10
  Int
2 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100
  Int
3 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000
  Int
4 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10000
  Int
5 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100000
  Int
6 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000
  Int
7 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10000000
  Int
8 -> Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100000000
  Int
_ -> Integer -> Int -> Integer
integerTenExp (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000000) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Bool -> Integer -> Integer -> Estimate
posSciLowerBound !Bool
wasTruncated !Integer
coeff !Integer
e
  | Integer
e Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = case Bool
wasTruncated of
      Bool
True -> Integer -> Estimate
LowerBoundedMagnitude Integer
coeff
      Bool
False -> Integer -> Estimate
Exactly Integer
coeff
  | Bool
otherwise = let (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
coeff Integer
10 in
      case Integer
q of
        Integer
0 -> Integer -> Estimate
LowerBoundedMagnitude Integer
0
        Integer
_ -> Bool -> Integer -> Integer -> Estimate
posSciLowerBound (Bool
wasTruncated Bool -> Bool -> Bool
|| Integer
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) Integer
q (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
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 :: Int -> Integer -> Int
logBase10 !Int
acc Integer
i = if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
  then Int
acc
  else Int -> Integer -> Int
logBase10 (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
i Integer
10)

upcastLargeScientific ::
     Parser e s LargeScientific
  -> Parser e s Scientific#
upcastLargeScientific :: Parser e s LargeScientific -> Parser e s Scientific#
upcastLargeScientific (Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# e LargeScientific)
g) = ((# ByteArray#, Int#, Int# #) -> ST# s (Result# e Scientific#))
-> Parser e s Scientific#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
Parser
  (\(# ByteArray#, Int#, Int# #)
x State# s
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# s (Result# e LargeScientific)
g (# ByteArray#, Int#, Int# #)
x State# s
s0 of
    (# State# s
s1, Result# e LargeScientific
r #) -> case Result# e LargeScientific
r of
      (# e
e | #) -> (# State# s
s1, (# e
e | #) #)
      (# | (# LargeScientific
a, Int#
b, Int#
c #) #) -> (# State# s
s1, (# | (# (# Int#
0#, Int -> Int#
unI Int
forall a. Bounded a => a
minBound, LargeScientific
a #), Int#
b, Int#
c #) #) #)
  )

upcastNegatedLargeScientific ::
     Parser e s LargeScientific
  -> Parser e s Scientific#
upcastNegatedLargeScientific :: Parser e s LargeScientific -> Parser e s Scientific#
upcastNegatedLargeScientific (Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# e LargeScientific)
g) = ((# ByteArray#, Int#, Int# #) -> ST# s (Result# e Scientific#))
-> Parser e s Scientific#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
Parser
  (\(# ByteArray#, Int#, Int# #)
x State# s
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# s (Result# e LargeScientific)
g (# ByteArray#, Int#, Int# #)
x State# s
s0 of
    (# State# s
s1, Result# e LargeScientific
r #) -> case Result# e LargeScientific
r of
      (# e
e | #) -> (# State# s
s1, (# e
e | #) #)
      (# | (# LargeScientific Integer
w Integer
y, Int#
b, Int#
c #) #) -> (# State# s
s1, (# | (# (# Int#
0#, Int -> Int#
unI Int
forall a. Bounded a => a
minBound, Integer -> Integer -> LargeScientific
LargeScientific (Integer -> Integer
forall a. Num a => a -> a
Prelude.negate Integer
w) Integer
y #), Int#
b, Int#
c #) #) #)
  )

mapIntPairToScientific ::
     Parser e s (# Int#, Int# #)
  -> Parser e s Scientific#
mapIntPairToScientific :: Parser e s (# Int#, Int# #) -> Parser e s Scientific#
mapIntPairToScientific (Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# e (# Int#, Int# #))
g) = ((# ByteArray#, Int#, Int# #) -> ST# s (Result# e Scientific#))
-> Parser e s Scientific#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
Parser
  (\(# ByteArray#, Int#, Int# #)
x State# s
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# s (Result# e (# Int#, Int# #))
g (# ByteArray#, Int#, Int# #)
x State# s
s0 of
    (# State# s
s1, Result# e (# Int#, Int# #)
r #) -> case Result# e (# Int#, Int# #)
r of
      (# e
e | #) -> (# State# s
s1, (# e
e | #) #)
      (# | (# (# Int#
y, Int#
z #), Int#
b, Int#
c #) #) -> (# State# s
s1, (# | (# (# Int#
y, Int#
z, LargeScientific
zeroLarge #), Int#
b, Int#
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 e s (# Int#, Int# #) -> Parser e s Scientific#
mapNegateIntPairToScientific (Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# e (# Int#, Int# #))
g) = ((# ByteArray#, Int#, Int# #) -> ST# s (Result# e Scientific#))
-> Parser e s Scientific#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
Parser
  (\(# ByteArray#, Int#, Int# #)
x State# s
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# s (Result# e (# Int#, Int# #))
g (# ByteArray#, Int#, Int# #)
x State# s
s0 of
    (# State# s
s1, Result# e (# Int#, Int# #)
r #) -> case Result# e (# Int#, Int# #)
r of
      (# e
e | #) -> (# State# s
s1, (# e
e | #) #)
      (# | (# (# Int#
y, Int#
z #), Int#
b, Int#
c #) #) -> (# State# s
s1, (# | (# (# Int# -> Int#
Exts.negateInt# Int#
y, Int#
z, LargeScientific
zeroLarge #), Int#
b, Int#
c #) #) #)
  )

bindToScientific :: Parser s e a -> (a -> Parser s e Scientific#) -> Parser s e Scientific#
{-# inline bindToScientific #-}
bindToScientific :: Parser s e a
-> (a -> Parser s e Scientific#) -> Parser s e Scientific#
bindToScientific (Parser (# ByteArray#, Int#, Int# #) -> ST# e (Result# s a)
f) a -> Parser s e Scientific#
g = ((# ByteArray#, Int#, Int# #) -> ST# e (Result# s Scientific#))
-> Parser s e Scientific#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
Parser
  (\x :: (# ByteArray#, Int#, Int# #)
x@(# ByteArray#
arr, Int#
_, Int#
_ #) State# e
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# e (Result# s a)
f (# ByteArray#, Int#, Int# #)
x State# e
s0 of
    (# State# e
s1, Result# s a
r0 #) -> case Result# s a
r0 of
      (# s
e | #) -> (# State# e
s1, (# s
e | #) #)
      (# | (# a
y, Int#
b, Int#
c #) #) ->
        Parser s e Scientific#
-> (# ByteArray#, Int#, Int# #) -> ST# e (Result# s Scientific#)
forall e s a.
Parser e s a -> (# ByteArray#, Int#, Int# #) -> ST# s (Result# e a)
runParser (a -> Parser s e Scientific#
g a
y) (# ByteArray#
arr, Int#
b, Int#
c #) State# e
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 :: Scientific -> ShortText
encode Scientific
s = case Chunks -> ByteArray
Chunks.concatU (Int -> Builder -> Chunks
Builder.run Int
128 (Scientific -> Builder
builderUtf8 Scientific
s)) of
  ByteArray ByteArray#
x -> ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS ByteArray#
x)

-- | Variant of 'encode' that provides a builder instead.
builderUtf8 :: Scientific -> Builder
builderUtf8 :: Scientific -> Builder
builderUtf8 (Scientific Int
coeff Int
e LargeScientific
big)
  | Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Builder
Builder.intDec Int
coeff
  | Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = let LargeScientific Integer
coeff' Integer
e' = LargeScientific
big in
      if | Integer
coeff' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Char -> Builder
Builder.ascii Char
'0'
         | Integer
e' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Integer -> Builder
Builder.integerDec Integer
coeff'
         | Integer
e' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
e' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
50 ->
             -- TODO: Add a replicate function to builder to improve this.
             Integer -> Builder
Builder.integerDec Integer
coeff' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bytes -> Builder
Builder.bytes (Int -> Word8 -> Bytes
Bytes.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
e') Word8
0x30)
         | Integer
e' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0, Integer
e' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (-Integer
50), Integer
coeff' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0, Integer
coeff' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
18446744073709551616 ->
             let coeff'' :: Word
coeff'' = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
coeff' :: Word
                 e'' :: Int
e'' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
e' :: Int
              in Bytes -> Builder
Builder.bytes (Word -> Int -> Bytes
encodePosCoeffNegExp Word
coeff'' Int
e'')
         | Integer
e' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0, Integer
e' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (-Integer
50), Integer
coeff' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0, Integer
coeff' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (-Integer
18446744073709551616) ->
             let coeff'' :: Word
coeff'' = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
forall a. Num a => a -> a
Prelude.negate Integer
coeff') :: Word
                 e'' :: Int
e'' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
e' :: Int
              in Bytes -> Builder
Builder.bytes (Word -> Int -> Bytes
encodeNegCoeffNegExp Word
coeff'' Int
e'')
         | Bool
otherwise ->
             Integer -> Builder
Builder.integerDec Integer
coeff'
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
             Char -> Builder
Builder.ascii Char
'e'
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
             Integer -> Builder
Builder.integerDec Integer
e'
  | Bool
otherwise =
      if | Int
coeff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Char -> Builder
Builder.ascii Char
'0'
         | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
50 ->
             -- TODO: Add a replicate function to builder to improve this.
             Int -> Builder
Builder.intDec Int
coeff Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bytes -> Builder
Builder.bytes (Int -> Word8 -> Bytes
Bytes.replicate Int
e Word8
0x30)
         | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (-Int
50) -> if Int
coeff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
             then Bytes -> Builder
Builder.bytes (Word -> Int -> Bytes
encodePosCoeffNegExp (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word Int
coeff) Int
e)
             else Bytes -> Builder
Builder.bytes (Word -> Int -> Bytes
encodeNegCoeffNegExp (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word (Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
coeff)) Int
e)
         | Bool
otherwise -> Nat 41 -> Builder 41 -> Builder
forall (n :: Nat). Nat n -> Builder n -> Builder
Builder.fromBounded Nat 41
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Builder 41 -> Builder) -> Builder 41 -> Builder
forall a b. (a -> b) -> a -> b
$
             Int -> Builder 20
BB.intDec Int
coeff
             Builder 20 -> Builder 21 -> Builder (20 + 21)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
             Char -> Builder 1
BB.ascii Char
'e'
             Builder 1 -> Builder 20 -> Builder (1 + 20)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
             Int -> Builder 20
BB.intDec Int
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 :: Word -> Int -> Bytes
encodePosCoeffNegExp !Word
w !Int
e = (forall s. ST s Bytes) -> Bytes
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Bytes) -> Bytes)
-> (forall s. ST s Bytes) -> Bytes
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
128
  MutableByteArray (PrimState (ST s))
-> Int -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
PM.setByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 Int
128 (Word8
0x30 :: Word8)
  Int
end <- Builder 19 -> MutableByteArray s -> Int -> ST s Int
forall (n :: Nat) s.
Builder n -> MutableByteArray s -> Int -> ST s Int
BBU.pasteST (Word -> Builder 19
BB.wordDec Word
w) MutableByteArray s
dst Int
100
  let dotIx :: Int
dotIx = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e
  let coeffMag :: Int
coeffMag = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100
  let extra :: Int
extra = if Int
coeffMag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e
        then (Int
coeffMag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        else Int
0
  MutableByteArray (PrimState (ST s))
-> Int
-> MutableByteArray (PrimState (ST s))
-> Int
-> Int
-> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.moveByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
1 Int
dotIx
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst (Int
dotIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word8
0x2E :: Word8)
  ByteArray
dst' <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst
  Bytes -> ST s Bytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes :: ByteArray -> Int -> Int -> Bytes
Bytes
    { $sel:array:Bytes :: ByteArray
BT.array=ByteArray
dst'
    , $sel:offset:Bytes :: Int
BT.offset=Int
dotIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
extra
    , $sel:length:Bytes :: Int
BT.length=Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Word -> Int -> Bytes
encodeNegCoeffNegExp !Word
w !Int
e = (forall s. ST s Bytes) -> Bytes
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Bytes) -> Bytes)
-> (forall s. ST s Bytes) -> Bytes
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
128
  MutableByteArray (PrimState (ST s))
-> Int -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
PM.setByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 Int
128 (Word8
0x30 :: Word8)
  Int
end <- Builder 19 -> MutableByteArray s -> Int -> ST s Int
forall (n :: Nat) s.
Builder n -> MutableByteArray s -> Int -> ST s Int
BBU.pasteST (Word -> Builder 19
BB.wordDec Word
w) MutableByteArray s
dst Int
100
  let dotIx :: Int
dotIx = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e
  let coeffMag :: Int
coeffMag = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100
  let extra :: Int
extra = if Int
coeffMag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e
        then (Int
coeffMag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        else Int
0
  MutableByteArray (PrimState (ST s))
-> Int
-> MutableByteArray (PrimState (ST s))
-> Int
-> Int
-> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.moveByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
1 Int
dotIx
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst (Int
dotIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word8
0x2E :: Word8)
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst (Int
dotIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
extra) (Word8
0x2D :: Word8)
  ByteArray
dst' <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst
  Bytes -> ST s Bytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes :: ByteArray -> Int -> Int -> Bytes
Bytes
    { $sel:array:Bytes :: ByteArray
BT.array=ByteArray
dst'
    , $sel:offset:Bytes :: Int
BT.offset=Int
dotIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
extra
    , $sel:length:Bytes :: Int
BT.length=Int -> Int
forall a. Num a => a -> a
Prelude.negate Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra
    }