{-# LANGUAGE BangPatterns
           , NumericUnderscores
           , UnboxedTuples #-}

{- | Functions for parsing bounded numbers expressed as fractions.

     Parsing functions in this module are only guaranteed to operate correctly when
     their arguments are sensible and the input number has no leading zeroes.

     == Example

     Converting @"-1200.00340e6"@ to an 'Int32', skipping operations
     outside of this module:

 @
 >>> 'parse' ('fracInt32Dec' () Minus (FracInt 0 0) 0) "1200.00340e6"
 (Scrap 4 ".00340e6" End,Right (FracInt 12 2))

 >>> parse (fracInt32Dec () Minus (FracInt 12 2) 4) "00340e6"
 (Scrap 5 "e6" End,Right (FracInt 12000034 8))

 >>> let ex = 6 + 4 -- Exponent plus number of digits before decimal point

 >>> 'fracToInt32' Minus (FracInt 12000034 8) ex
 Proper (-12000034000)
 @

     Similarly, @"123456789098.7654321e-17"@ to 'Float':

 @
 >>> parse ('fracFloat23Dec' (FracFloat 0 0)) "123456789098.7654321e-17"
 (Scrap 12 ".7654321e-17" End,Right (FracFloat 123456789 9))

 >>> parse (fracFloat23Dec (FracFloat 123456789 9)) "7654321e-17"
 (Scrap 7 "e-17" End,Right (FracFloat 123456789 9))

 >>> 'fracToFloat' Plus (FracFloat 123456789 9) ((-17) + 12)
 1.2345679e-6
 @
 -}

module Parser.Lathe.Numeric.Fractional
  ( -- * Representation
    Sign (..)
  , OverUnder (..)
    -- ** Unsigned integral
  , FracWord (..)

    -- | === Conversions
  , fracToWord8
  , fracToWord16
  , fracToWord32
  , fracToWord64
  , fracToWord

    -- ** Signed integral
  , FracInt (..)

    -- | === Conversions
  , fracToInt8
  , fracToInt16
  , fracToInt32
  , fracToInt64
  , fracToInt

    -- ** Floating-point
  , FracFloat (..)

  , fracToFloat
  , fracToDouble

    -- * Parsing
    -- ** Decimal
    -- *** Unsigned integral
  , fracWord8Dec
  , fracWord16Dec
  , fracWord32Dec
  , fracWord64Dec
  , fracWordDec

    -- *** Signed integral
  , fracInt8Dec
  , fracInt16Dec
  , fracInt32Dec
  , fracInt64Dec
  , fracIntDec

    -- *** Floating-point
  , fracFloat23Dec
  , fracFloat52Dec
  ) where

import           Parser.Lathe.Radix
import           Parser.Lathe.Internal
import           Parser.Lathe.Internal.Bitness
import           Parser.Lathe.Numeric.Integral.Internal
import           Parser.Lathe.Numeric.Internal

import           Control.Monad.ST
import           Data.Primitive.PrimArray
import           Data.Int
import           Data.Ratio
import           Data.Word
import           GHC.Float (castWord32ToFloat, castWord64ToDouble)



-- All powers of 10 that fit into an unsigned platform integer.
powersOf10 :: PrimArray Word
powersOf10 :: PrimArray Word
powersOf10 =
  (forall s. ST s (PrimArray Word)) -> PrimArray Word
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (PrimArray Word)) -> PrimArray Word)
-> (forall s. ST s (PrimArray Word)) -> PrimArray Word
forall a b. (a -> b) -> a -> b
$ do
    let len :: Int
len = Int -> Int -> Int
forall a. a -> a -> a
caseWordSize_32_64 Int
10 Int
20

    MutablePrimArray (PrimState (ST s)) Word
arr <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len

    let go :: Word -> Int -> ST s ()
go !Word
v !Int
n
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise = do
              MutablePrimArray (PrimState (ST s)) Word -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState (ST s)) Word
arr Int
n Word
v

              let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                  v' :: Word
v' = Word
v Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
10
              Word -> Int -> ST s ()
go Word
v' Int
n'

    Word -> Int -> ST s ()
go Word
1 Int
0

    MutablePrimArray (PrimState (ST s)) Word -> ST s (PrimArray Word)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray (PrimState (ST s)) Word
arr



-- | Whether the integer can be represented properly.
data OverUnder a = Proper !a
                 | Over      -- ^ Overflow.
                 | Under     -- ^ Underflow.
                   deriving Int -> OverUnder a -> ShowS
[OverUnder a] -> ShowS
OverUnder a -> String
(Int -> OverUnder a -> ShowS)
-> (OverUnder a -> String)
-> ([OverUnder a] -> ShowS)
-> Show (OverUnder a)
forall a. Show a => Int -> OverUnder a -> ShowS
forall a. Show a => [OverUnder a] -> ShowS
forall a. Show a => OverUnder a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OverUnder a -> ShowS
showsPrec :: Int -> OverUnder a -> ShowS
$cshow :: forall a. Show a => OverUnder a -> String
show :: OverUnder a -> String
$cshowList :: forall a. Show a => [OverUnder a] -> ShowS
showList :: [OverUnder a] -> ShowS
Show



-- | Intermediate representation of an unsigned integer.
data FracWord word = FracWord
                       !word -- ^ Either @0@ or a number with a non-zero lowest digit.
                       !Int  -- ^ Number of decimal digits consumed by this integer.
                     deriving Int -> FracWord word -> ShowS
[FracWord word] -> ShowS
FracWord word -> String
(Int -> FracWord word -> ShowS)
-> (FracWord word -> String)
-> ([FracWord word] -> ShowS)
-> Show (FracWord word)
forall word. Show word => Int -> FracWord word -> ShowS
forall word. Show word => [FracWord word] -> ShowS
forall word. Show word => FracWord word -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall word. Show word => Int -> FracWord word -> ShowS
showsPrec :: Int -> FracWord word -> ShowS
$cshow :: forall word. Show word => FracWord word -> String
show :: FracWord word -> String
$cshowList :: forall word. Show word => [FracWord word] -> ShowS
showList :: [FracWord word] -> ShowS
Show

-- | Convert the intermediate representation into a 'Word8', if possible.
fracToWord8
  :: FracWord Word8
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Word8
fracToWord8 :: FracWord Word8 -> Integer -> OverUnder Word8
fracToWord8 = (Int, Word8, Word8) -> FracWord Word8 -> Integer -> OverUnder Word8
forall w.
(Num w, Ord w) =>
(Int, w, w) -> FracWord w -> Integer -> OverUnder w
fracToWord_ (Int, Word8, Word8)
forall a. Num a => (Int, a, a)
u8

-- | Convert the intermediate representation into a 'Word16', if possible.
fracToWord16
  :: FracWord Word16
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Word16
fracToWord16 :: FracWord Word16 -> Integer -> OverUnder Word16
fracToWord16 = (Int, Word16, Word16)
-> FracWord Word16 -> Integer -> OverUnder Word16
forall w.
(Num w, Ord w) =>
(Int, w, w) -> FracWord w -> Integer -> OverUnder w
fracToWord_ (Int, Word16, Word16)
forall a. Num a => (Int, a, a)
u16

-- | Convert the intermediate representation into a 'Word32', if possible.
fracToWord32
  :: FracWord Word32
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Word32
fracToWord32 :: FracWord Word32 -> Integer -> OverUnder Word32
fracToWord32 = (Int, Word32, Word32)
-> FracWord Word32 -> Integer -> OverUnder Word32
forall w.
(Num w, Ord w) =>
(Int, w, w) -> FracWord w -> Integer -> OverUnder w
fracToWord_ (Int, Word32, Word32)
forall a. Num a => (Int, a, a)
u32

-- | Convert the intermediate representation into a 'Word64', if possible.
fracToWord64
  :: FracWord Word64
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Word64
fracToWord64 :: FracWord Word64 -> Integer -> OverUnder Word64
fracToWord64 = (Int, Word64, Word64)
-> FracWord Word64 -> Integer -> OverUnder Word64
forall w.
(Num w, Ord w) =>
(Int, w, w) -> FracWord w -> Integer -> OverUnder w
fracToWord_ (Int, Word64, Word64)
forall a. Num a => (Int, a, a)
u64

-- | Convert the intermediate representation into a 'Word', if possible.
fracToWord
  :: FracWord Word
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Word
fracToWord :: FracWord Word -> Integer -> OverUnder Word
fracToWord = (Int, Word, Word) -> FracWord Word -> Integer -> OverUnder Word
forall w.
(Num w, Ord w) =>
(Int, w, w) -> FracWord w -> Integer -> OverUnder w
fracToWord_ ((Int, Word, Word) -> (Int, Word, Word) -> (Int, Word, Word)
forall a. a -> a -> a
caseWordSize_32_64 (Int, Word, Word)
forall a. Num a => (Int, a, a)
u32 (Int, Word, Word)
forall a. Num a => (Int, a, a)
u64)

{-# INLINE fracToWord #-}
fracToWord_
  :: (Num w, Ord w) => (Int, w, w) -> FracWord w -> Integer -> OverUnder w
fracToWord_ :: forall w.
(Num w, Ord w) =>
(Int, w, w) -> FracWord w -> Integer -> OverUnder w
fracToWord_ (Int
len, w
bound, w
_tip) (FracWord w
v Int
e) Integer
n =
  case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
n (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e) of
    Ordering
LT -> OverUnder w
forall a. OverUnder a
Under
    Ordering
EQ -> w -> OverUnder w
forall a. a -> OverUnder a
Proper w
v
    Ordering
GT ->
      let n' :: Integer
n' = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
      in case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
n' (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) of
           Ordering
LT -> w -> OverUnder w
forall a. a -> OverUnder a
Proper (w -> OverUnder w) -> w -> OverUnder w
forall a b. (a -> b) -> a -> b
$ w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

           Ordering
EQ -> let v' :: w
v' = w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

                 in if w
v' w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
bound
                      then w -> OverUnder w
forall a. a -> OverUnder a
Proper (w -> OverUnder w) -> w -> OverUnder w
forall a b. (a -> b) -> a -> b
$ w
v' w -> w -> w
forall a. Num a => a -> a -> a
* w
10
                      else OverUnder w
forall a. OverUnder a
Over

           Ordering
GT -> OverUnder w
forall a. OverUnder a
Over



-- | Consume up to 3 decimal digits and any number of zeroes after into a
--   'Word8'-compatible container.
fracWord8Dec
  :: overflow
  -> FracWord Word8
  -> Int64          -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracWord Word8)
fracWord8Dec :: forall overflow.
overflow
-> FracWord Word8 -> Int64 -> Parser overflow (FracWord Word8)
fracWord8Dec = (Int, Word8, Word8)
-> overflow
-> FracWord Word8
-> Int64
-> Parser overflow (FracWord Word8)
forall w overflow.
(Ord w, Num w) =>
(Int, w, w)
-> overflow -> FracWord w -> Int64 -> Parser overflow (FracWord w)
fracWordDec_ (Int, Word8, Word8)
forall a. Num a => (Int, a, a)
u8

-- | Consume up to 5 decimal digits and any number of zeroes after into a
--   'Word16'-compatible container.
fracWord16Dec
  :: overflow
  -> FracWord Word16
  -> Int64           -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracWord Word16)
fracWord16Dec :: forall overflow.
overflow
-> FracWord Word16 -> Int64 -> Parser overflow (FracWord Word16)
fracWord16Dec = (Int, Word16, Word16)
-> overflow
-> FracWord Word16
-> Int64
-> Parser overflow (FracWord Word16)
forall w overflow.
(Ord w, Num w) =>
(Int, w, w)
-> overflow -> FracWord w -> Int64 -> Parser overflow (FracWord w)
fracWordDec_ (Int, Word16, Word16)
forall a. Num a => (Int, a, a)
u16

-- | Consume up to 9 decimal digits and any number of zeroes after into a
--   'Word32'-compatible container.
fracWord32Dec
  :: overflow
  -> FracWord Word32
  -> Int64           -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracWord Word32)
fracWord32Dec :: forall overflow.
overflow
-> FracWord Word32 -> Int64 -> Parser overflow (FracWord Word32)
fracWord32Dec = (Int, Word32, Word32)
-> overflow
-> FracWord Word32
-> Int64
-> Parser overflow (FracWord Word32)
forall w overflow.
(Ord w, Num w) =>
(Int, w, w)
-> overflow -> FracWord w -> Int64 -> Parser overflow (FracWord w)
fracWordDec_ (Int, Word32, Word32)
forall a. Num a => (Int, a, a)
u32

-- | Consume up to 20 decimal digits and any number of zeroes after into a
--   'Word64'-compatible container.
fracWord64Dec
  :: overflow
  -> FracWord Word64
  -> Int64           -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracWord Word64)
fracWord64Dec :: forall overflow.
overflow
-> FracWord Word64 -> Int64 -> Parser overflow (FracWord Word64)
fracWord64Dec = (Int, Word64, Word64)
-> overflow
-> FracWord Word64
-> Int64
-> Parser overflow (FracWord Word64)
forall w overflow.
(Ord w, Num w) =>
(Int, w, w)
-> overflow -> FracWord w -> Int64 -> Parser overflow (FracWord w)
fracWordDec_ (Int, Word64, Word64)
forall a. Num a => (Int, a, a)
u64

-- | Consume up to 9 or 20 decimal digits (depending on current platform's integer size)
--   and any number of zeroes after into a 'Word'-compatible container.
fracWordDec
  :: overflow
  -> FracWord Word
  -> Int64         -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracWord Word)
fracWordDec :: forall overflow.
overflow
-> FracWord Word -> Int64 -> Parser overflow (FracWord Word)
fracWordDec = (Int, Word, Word)
-> overflow
-> FracWord Word
-> Int64
-> Parser overflow (FracWord Word)
forall w overflow.
(Ord w, Num w) =>
(Int, w, w)
-> overflow -> FracWord w -> Int64 -> Parser overflow (FracWord w)
fracWordDec_ ((Int, Word, Word) -> (Int, Word, Word) -> (Int, Word, Word)
forall a. a -> a -> a
caseWordSize_32_64 (Int, Word, Word)
forall a. Num a => (Int, a, a)
u32 (Int, Word, Word)
forall a. Num a => (Int, a, a)
u64)


data State a = State
                 {-# UNPACK #-} !(Flow a)
                 {-# UNPACK #-} !Int      -- ^ Number of bytes consumed total.

data Flow a = Number
                 {-# UNPACK #-} !Enough
                                !a
                 {-# UNPACK #-} !Int      -- ^ Number of significand bytes.
            | Overflow

data Enough = Enough
            | Rush

{-# INLINE fracWordDec_ #-}
fracWordDec_
  :: (Ord w, Num w)
  => (Int, w, w)
  -> overflow -> FracWord w -> Int64
  -> Parser overflow (FracWord w)
fracWordDec_ :: forall w overflow.
(Ord w, Num w) =>
(Int, w, w)
-> overflow -> FracWord w -> Int64 -> Parser overflow (FracWord w)
fracWordDec_ (Int
len, w
bound, w
tip) overflow
overflow = \(FracWord w
v0 Int
e0) Int64
n0 ->
  if Int64
n0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    then w -> Int -> Parser overflow (FracWord w)
forall {word}. word -> Int -> Parser overflow (FracWord word)
fast w
v0 Int
e0
    else do

      let slow :: w -> Int -> Int -> Parser (State w) b
slow !w
v !Int
e !Int
n = do
            Word8
w <- State w -> Parser (State w) Word8
forall end. end -> Parser end Word8
word8 (State w -> Parser (State w) Word8)
-> State w -> Parser (State w) Word8
forall a b. (a -> b) -> a -> b
$ Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Enough w
v Int
e) Int
n
            case Word8 -> Maybe Word8
dec Word8
w of
              Maybe Word8
Nothing -> State w -> Parser (State w) b
forall e a. e -> Parser e a
err (State w -> Parser (State w) b) -> State w -> Parser (State w) b
forall a b. (a -> b) -> a -> b
$ Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Enough w
v Int
e) Int
n
              Just Word8
i  ->
                let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len
                     then if Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00
                            then w -> Int -> Int -> Parser (State w) b
slow w
v Int
e Int
n'
                            else let v' :: w
v' = w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                                (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

                                        w -> w -> w
forall a. Num a => a -> a -> a
+ Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

                                 in w -> Int -> Int -> Parser (State w) b
slow w
v' Int
n' Int
n'

                     else State w -> Parser (State w) b
forall e a. e -> Parser e a
err (State w -> Parser (State w) b) -> State w -> Parser (State w) b
forall a b. (a -> b) -> a -> b
$!
                            if Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00
                              then Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Rush w
v Int
e) Int
n'
                              else let v' :: w
v' = w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                                  (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

                                       v'' :: w
v'' = w
v' w -> w -> w
forall a. Num a => a -> a -> a
* w
10 w -> w -> w
forall a. Num a => a -> a -> a
+ Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

                                   in case w -> w -> Ordering
forall a. Ord a => a -> a -> Ordering
compare w
v' w
bound of
                                        Ordering
LT -> Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Rush w
v'' Int
n') Int
n'

                                        Ordering
EQ -> if Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
tip
                                                then Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Rush w
v'' Int
n') Int
n'
                                                else Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State Flow w
forall a. Flow a
Overflow Int
n

                                        Ordering
GT -> Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State Flow w
forall a. Flow a
Overflow Int
n

      State Flow w
res Int
n' <- w -> Int -> Int -> Parser (State w) (State w)
forall {b}. w -> Int -> Int -> Parser (State w) b
slow w
v0 Int
e0 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n0) Parser (State w) (State w)
-> (State w -> Parser overflow (State w))
-> Parser overflow (State w)
forall e a x. Parser e a -> (e -> Parser x a) -> Parser x a
`catch` State w -> Parser overflow (State w)
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

      let !n1 :: Int64
n1 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n'

      Int64 -> Parser overflow ()
forall never. Int64 -> Parser never ()
unsafeSkipEndOr (Int64
n1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
n0)

      case Flow w
res of
        Number Enough
rush w
v1 Int
e1 -> do
          case Enough
rush of
            Enough
Enough -> FracWord w -> Parser overflow (FracWord w)
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w -> Int -> FracWord w
forall word. word -> Int -> FracWord word
FracWord w
v1 Int
e1)
            Enough
Rush   -> w -> Int -> Parser overflow (FracWord w)
forall {word}. word -> Int -> Parser overflow (FracWord word)
fast w
v1 Int
e1

        Flow w
Overflow -> overflow -> Parser overflow (FracWord w)
forall e a. e -> Parser e a
err overflow
overflow
  where
    fast :: word -> Int -> Parser overflow (FracWord word)
fast !word
v !Int
e = do
      (Word8 -> Bool) -> Parser overflow ()
forall never. (Word8 -> Bool) -> Parser never ()
skipUntilEndOr (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x30)

      let checkOverflow :: Parser Bool b
checkOverflow = do
            Word8
w <- Bool -> Parser Bool Word8
forall end. end -> Parser end Word8
word8 Bool
False
            Bool -> Parser Bool b
forall e a. e -> Parser e a
err (Bool -> (Word8 -> Bool) -> Maybe Word8 -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Word8
_ -> Bool
True) (Maybe Word8 -> Bool) -> Maybe Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe Word8
dec Word8
w)

      Bool
over <- Parser Bool Bool
forall {b}. Parser Bool b
checkOverflow Parser Bool Bool
-> (Bool -> Parser overflow Bool) -> Parser overflow Bool
forall e a x. Parser e a -> (e -> Parser x a) -> Parser x a
`catch` Bool -> Parser overflow Bool
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      if Bool
over
        then overflow -> Parser overflow (FracWord word)
forall e a. e -> Parser e a
err overflow
overflow
        else FracWord word -> Parser overflow (FracWord word)
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (word -> Int -> FracWord word
forall word. word -> Int -> FracWord word
FracWord word
v Int
e)



-- | Intermediate representation of a signed integer.
data FracInt word = FracInt
                      !word -- ^ Either @0@ or a number with a non-zero lowest digit.
                      !Int  -- ^ Number of decimal digits consumed by this integer.
                    deriving Int -> FracInt word -> ShowS
[FracInt word] -> ShowS
FracInt word -> String
(Int -> FracInt word -> ShowS)
-> (FracInt word -> String)
-> ([FracInt word] -> ShowS)
-> Show (FracInt word)
forall word. Show word => Int -> FracInt word -> ShowS
forall word. Show word => [FracInt word] -> ShowS
forall word. Show word => FracInt word -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall word. Show word => Int -> FracInt word -> ShowS
showsPrec :: Int -> FracInt word -> ShowS
$cshow :: forall word. Show word => FracInt word -> String
show :: FracInt word -> String
$cshowList :: forall word. Show word => [FracInt word] -> ShowS
showList :: [FracInt word] -> ShowS
Show

-- | Convert the intermediate representation into an 'Int8', if possible.
fracToInt8
  :: Sign
  -> FracInt Word8
  -> Integer       -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Int8
fracToInt8 :: Sign -> FracInt Word8 -> Integer -> OverUnder Int8
fracToInt8 = (Int, Word8, Word8)
-> Sign -> FracInt Word8 -> Integer -> OverUnder Int8
forall w i.
(Integral w, Num i) =>
(Int, w, w) -> Sign -> FracInt w -> Integer -> OverUnder i
fracToInt_ (Int, Word8, Word8)
forall a. Num a => (Int, a, a)
i8

-- | Convert the intermediate representation into an 'Int16', if possible.
fracToInt16
  :: Sign
  -> FracInt Word16
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Int16
fracToInt16 :: Sign -> FracInt Word16 -> Integer -> OverUnder Int16
fracToInt16 = (Int, Word16, Word16)
-> Sign -> FracInt Word16 -> Integer -> OverUnder Int16
forall w i.
(Integral w, Num i) =>
(Int, w, w) -> Sign -> FracInt w -> Integer -> OverUnder i
fracToInt_ (Int, Word16, Word16)
forall a. Num a => (Int, a, a)
i16

-- | Convert the intermediate representation into an 'Int32', if possible.
fracToInt32
  :: Sign
  -> FracInt Word32
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Int32
fracToInt32 :: Sign -> FracInt Word32 -> Integer -> OverUnder Int32
fracToInt32 = (Int, Word32, Word32)
-> Sign -> FracInt Word32 -> Integer -> OverUnder Int32
forall w i.
(Integral w, Num i) =>
(Int, w, w) -> Sign -> FracInt w -> Integer -> OverUnder i
fracToInt_ (Int, Word32, Word32)
forall a. Num a => (Int, a, a)
i32

-- | Convert the intermediate representation into an 'Int64', if possible.
fracToInt64
  :: Sign
  -> FracInt Word64
  -> Integer        -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Int64
fracToInt64 :: Sign -> FracInt Word64 -> Integer -> OverUnder Int64
fracToInt64 = (Int, Word64, Word64)
-> Sign -> FracInt Word64 -> Integer -> OverUnder Int64
forall w i.
(Integral w, Num i) =>
(Int, w, w) -> Sign -> FracInt w -> Integer -> OverUnder i
fracToInt_ (Int, Word64, Word64)
forall a. Num a => (Int, a, a)
i64

-- | Convert the intermediate representation into an 'Int', if possible.
fracToInt
  :: Sign
  -> FracInt Word
  -> Integer      -- ^ Radix-10 order of magnitude of the expected result.
  -> OverUnder Int
fracToInt :: Sign -> FracInt Word -> Integer -> OverUnder Int
fracToInt = (Int, Word, Word)
-> Sign -> FracInt Word -> Integer -> OverUnder Int
forall w i.
(Integral w, Num i) =>
(Int, w, w) -> Sign -> FracInt w -> Integer -> OverUnder i
fracToInt_ ((Int, Word, Word) -> (Int, Word, Word) -> (Int, Word, Word)
forall a. a -> a -> a
caseWordSize_32_64 (Int, Word, Word)
forall a. Num a => (Int, a, a)
i32 (Int, Word, Word)
forall a. Num a => (Int, a, a)
i64)

{-# INLINE fracToInt #-}
fracToInt_
  :: (Integral w, Num i) => (Int, w, w) -> Sign -> FracInt w -> Integer -> OverUnder i
fracToInt_ :: forall w i.
(Integral w, Num i) =>
(Int, w, w) -> Sign -> FracInt w -> Integer -> OverUnder i
fracToInt_ (Int
len, w
bound, w
_tip) Sign
sign (FracInt w
v Int
e) Integer
n =
  let {-# INLINE signed #-}
      signed :: a -> b
signed a
x = case Sign
sign of
                   Sign
Plus  -> a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
                   Sign
Minus -> a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> a
forall a. Num a => a -> a
negate a
x)

  in case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
n (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e) of
       Ordering
LT -> OverUnder i
forall a. OverUnder a
Under
       Ordering
EQ -> i -> OverUnder i
forall a. a -> OverUnder a
Proper (i -> OverUnder i) -> i -> OverUnder i
forall a b. (a -> b) -> a -> b
$ w -> i
forall a b. (Integral a, Num b) => a -> b
signed w
v
       Ordering
GT ->
         let n' :: Integer
n' = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
         in case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
n' (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) of
              Ordering
LT -> i -> OverUnder i
forall a. a -> OverUnder a
Proper (i -> OverUnder i) -> (w -> i) -> w -> OverUnder i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> i
forall a b. (Integral a, Num b) => a -> b
signed (w -> OverUnder i) -> w -> OverUnder i
forall a b. (a -> b) -> a -> b
$ w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                            (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

              Ordering
EQ -> let v' :: w
v' = w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                   (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

                    in if w
v' w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
bound
                         then i -> OverUnder i
forall a. a -> OverUnder a
Proper (i -> OverUnder i) -> (w -> i) -> w -> OverUnder i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> i
forall a b. (Integral a, Num b) => a -> b
signed (w -> OverUnder i) -> w -> OverUnder i
forall a b. (a -> b) -> a -> b
$ w
v' w -> w -> w
forall a. Num a => a -> a -> a
* w
10
                         else OverUnder i
forall a. OverUnder a
Over

              Ordering
GT -> OverUnder i
forall a. OverUnder a
Over



-- | Consume up to 3 decimal digits and any number of zeroes after into an
--   'Int8'-compatible container.
fracInt8Dec
  :: overflow
  -> Sign
  -> FracInt Word8
  -> Int64         -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracInt Word8)
fracInt8Dec :: forall overflow.
overflow
-> Sign
-> FracInt Word8
-> Int64
-> Parser overflow (FracInt Word8)
fracInt8Dec = (Int, Word8, Word8)
-> overflow
-> Sign
-> FracInt Word8
-> Int64
-> Parser overflow (FracInt Word8)
forall w overflow.
(Show w, Ord w, Num w) =>
(Int, w, w)
-> overflow
-> Sign
-> FracInt w
-> Int64
-> Parser overflow (FracInt w)
fracIntDec_ (Int, Word8, Word8)
forall a. Num a => (Int, a, a)
i8

-- | Consume up to 5 decimal digits and any number of zeroes after into an
--   'Int16'-compatible container.
fracInt16Dec
  :: overflow
  -> Sign
  -> FracInt Word16
  -> Int64          -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracInt Word16)
fracInt16Dec :: forall overflow.
overflow
-> Sign
-> FracInt Word16
-> Int64
-> Parser overflow (FracInt Word16)
fracInt16Dec = (Int, Word16, Word16)
-> overflow
-> Sign
-> FracInt Word16
-> Int64
-> Parser overflow (FracInt Word16)
forall w overflow.
(Show w, Ord w, Num w) =>
(Int, w, w)
-> overflow
-> Sign
-> FracInt w
-> Int64
-> Parser overflow (FracInt w)
fracIntDec_ (Int, Word16, Word16)
forall a. Num a => (Int, a, a)
i16

-- | Consume up to 9 decimal digits and any number of zeroes after into an
--   'Int32'-compatible container.
fracInt32Dec
  :: overflow
  -> Sign
  -> FracInt Word32
  -> Int64          -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracInt Word32)
fracInt32Dec :: forall overflow.
overflow
-> Sign
-> FracInt Word32
-> Int64
-> Parser overflow (FracInt Word32)
fracInt32Dec = (Int, Word32, Word32)
-> overflow
-> Sign
-> FracInt Word32
-> Int64
-> Parser overflow (FracInt Word32)
forall w overflow.
(Show w, Ord w, Num w) =>
(Int, w, w)
-> overflow
-> Sign
-> FracInt w
-> Int64
-> Parser overflow (FracInt w)
fracIntDec_ (Int, Word32, Word32)
forall a. Num a => (Int, a, a)
i32

-- | Consume up to 19 decimal digits and any number of zeroes after into an
--   'Int64'-compatible container.
fracInt64Dec
  :: overflow
  -> Sign
  -> FracInt Word64
  -> Int64          -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracInt Word64)
fracInt64Dec :: forall overflow.
overflow
-> Sign
-> FracInt Word64
-> Int64
-> Parser overflow (FracInt Word64)
fracInt64Dec = (Int, Word64, Word64)
-> overflow
-> Sign
-> FracInt Word64
-> Int64
-> Parser overflow (FracInt Word64)
forall w overflow.
(Show w, Ord w, Num w) =>
(Int, w, w)
-> overflow
-> Sign
-> FracInt w
-> Int64
-> Parser overflow (FracInt w)
fracIntDec_ (Int, Word64, Word64)
forall a. Num a => (Int, a, a)
i64

-- | Consume up to 9 or 19 decimal digits (depending on current platform's integer size)
--   and any number of zeroes after into an 'Int'-compatible container.
fracIntDec
  :: overflow
  -> Sign
  -> FracInt Word
  -> Int64        -- ^ Number of decimal digits consumed by this number.
  -> Parser overflow (FracInt Word)
fracIntDec :: forall overflow.
overflow
-> Sign -> FracInt Word -> Int64 -> Parser overflow (FracInt Word)
fracIntDec = (Int, Word, Word)
-> overflow
-> Sign
-> FracInt Word
-> Int64
-> Parser overflow (FracInt Word)
forall w overflow.
(Show w, Ord w, Num w) =>
(Int, w, w)
-> overflow
-> Sign
-> FracInt w
-> Int64
-> Parser overflow (FracInt w)
fracIntDec_ ((Int, Word, Word) -> (Int, Word, Word) -> (Int, Word, Word)
forall a. a -> a -> a
caseWordSize_32_64 (Int, Word, Word)
forall a. Num a => (Int, a, a)
i32 (Int, Word, Word)
forall a. Num a => (Int, a, a)
i64)


{-# INLINE fracIntDec_ #-}
fracIntDec_
  :: (Show w, Ord w, Num w)
  => (Int, w, w)
  -> overflow -> Sign -> FracInt w -> Int64
  -> Parser overflow (FracInt w)
fracIntDec_ :: forall w overflow.
(Show w, Ord w, Num w) =>
(Int, w, w)
-> overflow
-> Sign
-> FracInt w
-> Int64
-> Parser overflow (FracInt w)
fracIntDec_ (Int
len, w
bound, w
tip) overflow
overflow Sign
sign = \(FracInt w
v0 Int
e0) Int64
n0 ->
  if Int64
n0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    then w -> Int -> Parser overflow (FracInt w)
forall {word}. word -> Int -> Parser overflow (FracInt word)
fast w
v0 Int
e0
    else do

      let slow :: w -> Int -> Int -> Parser (State w) b
slow !w
v !Int
e !Int
n = do
            Word8
w <- State w -> Parser (State w) Word8
forall end. end -> Parser end Word8
word8 (State w -> Parser (State w) Word8)
-> State w -> Parser (State w) Word8
forall a b. (a -> b) -> a -> b
$ Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Enough w
v Int
e) Int
n
            case Word8 -> Maybe Word8
dec Word8
w of
              Maybe Word8
Nothing -> State w -> Parser (State w) b
forall e a. e -> Parser e a
err (State w -> Parser (State w) b) -> State w -> Parser (State w) b
forall a b. (a -> b) -> a -> b
$ Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Enough w
v Int
e) Int
n
              Just Word8
i  ->
                let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len
                     then if Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00
                            then w -> Int -> Int -> Parser (State w) b
slow w
v Int
e Int
n'
                            else let v' :: w
v' = w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                                (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

                                        w -> w -> w
forall a. Num a => a -> a -> a
+ Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

                                 in w -> Int -> Int -> Parser (State w) b
slow w
v' Int
n' Int
n'

                     else State w -> Parser (State w) b
forall e a. e -> Parser e a
err (State w -> Parser (State w) b) -> State w -> Parser (State w) b
forall a b. (a -> b) -> a -> b
$!
                            if Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00
                              then Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Rush w
v Int
e) Int
n'
                              else let v' :: w
v' = w
v w -> w -> w
forall a. Num a => a -> a -> a
* Word -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                                  (PrimArray Word -> Int -> Word
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Word
powersOf10 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))

                                       v'' :: w
v'' = w
v' w -> w -> w
forall a. Num a => a -> a -> a
* w
10 w -> w -> w
forall a. Num a => a -> a -> a
+ Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

                                   in case w -> w -> Ordering
forall a. Ord a => a -> a -> Ordering
compare w
v' w
bound of
                                        Ordering
LT -> Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Rush w
v'' Int
n') Int
n'

                                        Ordering
EQ -> if Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= case Sign
sign of
                                                                     Sign
Plus  -> w
tip
                                                                     Sign
Minus -> w
tip w -> w -> w
forall a. Num a => a -> a -> a
+ w
1

                                                then Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State (Enough -> w -> Int -> Flow w
forall a. Enough -> a -> Int -> Flow a
Number Enough
Rush w
v'' Int
n') Int
n'
                                                else Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State Flow w
forall a. Flow a
Overflow Int
n

                                        Ordering
GT -> Flow w -> Int -> State w
forall a. Flow a -> Int -> State a
State Flow w
forall a. Flow a
Overflow Int
n

      State Flow w
res Int
n' <- w -> Int -> Int -> Parser (State w) (State w)
forall {b}. w -> Int -> Int -> Parser (State w) b
slow w
v0 Int
e0 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n0) Parser (State w) (State w)
-> (State w -> Parser overflow (State w))
-> Parser overflow (State w)
forall e a x. Parser e a -> (e -> Parser x a) -> Parser x a
`catch` State w -> Parser overflow (State w)
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

      let !n1 :: Int64
n1 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n'

      Int64 -> Parser overflow ()
forall never. Int64 -> Parser never ()
unsafeSkipEndOr (Int64
n1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
n0)

      case Flow w
res of
        Number Enough
rush w
v1 Int
e1 -> do
          case Enough
rush of
            Enough
Enough -> FracInt w -> Parser overflow (FracInt w)
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w -> Int -> FracInt w
forall word. word -> Int -> FracInt word
FracInt w
v1 Int
e1)
            Enough
Rush   -> w -> Int -> Parser overflow (FracInt w)
forall {word}. word -> Int -> Parser overflow (FracInt word)
fast w
v1 Int
e1

        Flow w
Overflow -> overflow -> Parser overflow (FracInt w)
forall e a. e -> Parser e a
err overflow
overflow
  where
    fast :: word -> Int -> Parser overflow (FracInt word)
fast !word
v !Int
e = do
      (Word8 -> Bool) -> Parser overflow ()
forall never. (Word8 -> Bool) -> Parser never ()
skipUntilEndOr (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x30)

      let checkOverflow :: Parser Bool b
checkOverflow = do
            Word8
w <- Bool -> Parser Bool Word8
forall end. end -> Parser end Word8
word8 Bool
False
            Bool -> Parser Bool b
forall e a. e -> Parser e a
err (Bool -> (Word8 -> Bool) -> Maybe Word8 -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Word8
_ -> Bool
True) (Maybe Word8 -> Bool) -> Maybe Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe Word8
dec Word8
w)

      Bool
over <- Parser Bool Bool
forall {b}. Parser Bool b
checkOverflow Parser Bool Bool
-> (Bool -> Parser overflow Bool) -> Parser overflow Bool
forall e a x. Parser e a -> (e -> Parser x a) -> Parser x a
`catch` Bool -> Parser overflow Bool
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      if Bool
over
        then overflow -> Parser overflow (FracInt word)
forall e a. e -> Parser e a
err overflow
overflow
        else FracInt word -> Parser overflow (FracInt word)
forall a. a -> Parser overflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (word -> Int -> FracInt word
forall word. word -> Int -> FracInt word
FracInt word
v Int
e)



-- | Intermediate representation of a floating-point number's significand.
data FracFloat word = FracFloat
                        !word -- ^ Significand in untrimmed integer form.
                        !Int  -- ^ Number of decimal digits consumed by the significand.
                      deriving Int -> FracFloat word -> ShowS
[FracFloat word] -> ShowS
FracFloat word -> String
(Int -> FracFloat word -> ShowS)
-> (FracFloat word -> String)
-> ([FracFloat word] -> ShowS)
-> Show (FracFloat word)
forall word. Show word => Int -> FracFloat word -> ShowS
forall word. Show word => [FracFloat word] -> ShowS
forall word. Show word => FracFloat word -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall word. Show word => Int -> FracFloat word -> ShowS
showsPrec :: Int -> FracFloat word -> ShowS
$cshow :: forall word. Show word => FracFloat word -> String
show :: FracFloat word -> String
$cshowList :: forall word. Show word => [FracFloat word] -> ShowS
showList :: [FracFloat word] -> ShowS
Show



-- | Convert the intermediate representation to a 'Float'.
fracToFloat
  :: Sign
  -> FracFloat Word32
  -> Integer          -- ^ Radix-10 order of magnitude of the expected result.
  -> Float
fracToFloat :: Sign -> FracFloat Word32 -> Integer -> Float
fracToFloat Sign
sig (FracFloat Word32
v Int
e) Integer
n =
  let f :: Float
f | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>   Integer
39  = Word32 -> Float
castWord32ToFloat Word32
0x7F80_0000 -- infinity
        | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>    Integer
0  = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
n) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e))
        | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (-Integer
44) = Float
0
        | Bool
otherwise = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n)))

  in case Sign
sig of
       Sign
Plus  -> Float
f
       Sign
Minus -> Float -> Float
forall a. Num a => a -> a
negate Float
f

-- | Convert the intermediate representation to a 'Double'.
fracToDouble
  :: Sign
  -> FracFloat Word64
  -> Integer          -- ^ Radix-10 order of magnitude of the expected result.
  -> Double
fracToDouble :: Sign -> FracFloat Word64 -> Integer -> Double
fracToDouble Sign
sig (FracFloat Word64
v Int
e) Integer
n =
  let f :: Double
f | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>   Integer
309  = Word64 -> Double
castWord64ToDouble Word64
0x7FF0_0000_0000_0000 -- infinity
        | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>     Integer
0  = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
n) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e))
        | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (-Integer
323) = Double
0
        | Bool
otherwise  = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n)))

  in case Sign
sig of
       Sign
Plus  -> Double
f
       Sign
Minus -> Double -> Double
forall a. Num a => a -> a
negate Double
f



-- | Consume any number of consecutive decimal digits into a 'Float'-compatible
--   container.
--
--   The container retains no more than 9 leading decimal digits.
fracFloat23Dec :: FracFloat Word32 -> Parser never (FracFloat Word32)
fracFloat23Dec :: forall never. FracFloat Word32 -> Parser never (FracFloat Word32)
fracFloat23Dec = Int -> FracFloat Word32 -> Parser never (FracFloat Word32)
forall w e. Num w => Int -> FracFloat w -> Parser e (FracFloat w)
fracFloatDec_ Int
8

-- | Consume any number of consecutive decimal digits into a 'Double'-compatible
--   container.
--
--   The container retains no more than 17 leading decimal digits.
fracFloat52Dec :: FracFloat Word64 -> Parser never (FracFloat Word64)
fracFloat52Dec :: forall never. FracFloat Word64 -> Parser never (FracFloat Word64)
fracFloat52Dec = Int -> FracFloat Word64 -> Parser never (FracFloat Word64)
forall w e. Num w => Int -> FracFloat w -> Parser e (FracFloat w)
fracFloatDec_ Int
16



data Fate a = Fate
                {-# UNPACK #-} !Gear
                               !a
                {-# UNPACK #-} !Int  -- ^ Number of bytes consumed.

data Gear = Slow
          | Fast

{-# INLINE fracFloatDec_ #-}
fracFloatDec_ :: Num w => Int -> FracFloat w -> Parser e (FracFloat w)
fracFloatDec_ :: forall w e. Num w => Int -> FracFloat w -> Parser e (FracFloat w)
fracFloatDec_ Int
len = \(FracFloat w
v0 Int
e) ->
  if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
    then w -> Int -> Parser e (FracFloat w)
forall {word} {never}. word -> Int -> Parser never (FracFloat word)
fast w
v0 Int
e
    else do

      let slow :: t -> Int -> Parser (Fate t) b
slow !t
v !Int
n = do
            Word8
w <- Fate t -> Parser (Fate t) Word8
forall end. end -> Parser end Word8
word8 (Fate t -> Parser (Fate t) Word8)
-> Fate t -> Parser (Fate t) Word8
forall a b. (a -> b) -> a -> b
$ Gear -> t -> Int -> Fate t
forall a. Gear -> a -> Int -> Fate a
Fate Gear
Slow t
v Int
n
            case Word8 -> Maybe Word8
dec Word8
w of
              Maybe Word8
Nothing -> Fate t -> Parser (Fate t) b
forall e a. e -> Parser e a
err (Fate t -> Parser (Fate t) b) -> Fate t -> Parser (Fate t) b
forall a b. (a -> b) -> a -> b
$ Gear -> t -> Int -> Fate t
forall a. Gear -> a -> Int -> Fate a
Fate Gear
Slow t
v Int
n
              Just Word8
i  -> let !v' :: t
v' = t
v t -> t -> t
forall a. Num a => a -> a -> a
* t
10 t -> t -> t
forall a. Num a => a -> a -> a
+ Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i
                             !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

                         in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e
                              then t -> Int -> Parser (Fate t) b
slow t
v' Int
n'
                              else Fate t -> Parser (Fate t) b
forall e a. e -> Parser e a
err (Fate t -> Parser (Fate t) b) -> Fate t -> Parser (Fate t) b
forall a b. (a -> b) -> a -> b
$ Gear -> t -> Int -> Fate t
forall a. Gear -> a -> Int -> Fate a
Fate Gear
Fast t
v' Int
n'

      Fate Gear
gear w
v1 Int
n <- w -> Int -> Parser (Fate w) (Fate w)
forall {t} {b}. Num t => t -> Int -> Parser (Fate t) b
slow w
v0 Int
0 Parser (Fate w) (Fate w)
-> (Fate w -> Parser e (Fate w)) -> Parser e (Fate w)
forall e a x. Parser e a -> (e -> Parser x a) -> Parser x a
`catch` Fate w -> Parser e (Fate w)
forall a. a -> Parser e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Int64 -> Parser e ()
forall never. Int64 -> Parser never ()
unsafeSkipEndOr (Int64 -> Parser e ()) -> Int64 -> Parser e ()
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

      let !e' :: Int
e' = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
      case Gear
gear of
        Gear
Slow -> FracFloat w -> Parser e (FracFloat w)
forall a. a -> Parser e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w -> Int -> FracFloat w
forall word. word -> Int -> FracFloat word
FracFloat w
v1 Int
e')
        Gear
Fast -> w -> Int -> Parser e (FracFloat w)
forall {word} {never}. word -> Int -> Parser never (FracFloat word)
fast w
v1 Int
e'
  where
    fast :: word -> Int -> Parser never (FracFloat word)
fast !word
v !Int
e = do
      (Word8 -> Bool) -> Parser never ()
forall never. (Word8 -> Bool) -> Parser never ()
skipUntilEndOr (Bool -> (Word8 -> Bool) -> Maybe Word8 -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Word8
_ -> Bool
False) (Maybe Word8 -> Bool) -> (Word8 -> Maybe Word8) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Maybe Word8
dec)
      FracFloat word -> Parser never (FracFloat word)
forall a. a -> Parser never a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (word -> Int -> FracFloat word
forall word. word -> Int -> FracFloat word
FracFloat word
v Int
e)