{-# language BangPatterns #-}
{-# language LambdaCase #-}
{-# language TypeApplications #-}
{-# language MultiWayIf #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
module Data.Number.Scientific
( Scientific
, Scientific#
, small
, large
, fromFixed
, toWord
, toWord8
, toWord16
, toWord32
, toWord64
, toInt
, toInt32
, toInt64
, withExposed
, parserSignedUtf8Bytes
, parserTrailingUtf8Bytes
, parserUnsignedUtf8Bytes
, parserNegatedUtf8Bytes
, parserNegatedTrailingUtf8Bytes
, parserSignedUtf8Bytes#
, parserTrailingUtf8Bytes#
, parserUnsignedUtf8Bytes#
, parserNegatedUtf8Bytes#
, parserNegatedTrailingUtf8Bytes#
) where
import Prelude hiding (negate)
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.Parser.Unsafe (Parser(..))
import Data.Fixed (Fixed(MkFixed),HasResolution)
import qualified Data.Fixed as Fixed
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 GHC.Exts as Exts
import qualified Prelude as Prelude
data Scientific = Scientific
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
LargeScientific
type Scientific# = (# Int#, Int#, LargeScientific #)
instance Show Scientific where
showsPrec _ (Scientific coeff e largeNum) = if e /= minBound
then showsPrec 0 coeff . showChar 'e' . showsPrec 0 e
else case largeNum of
LargeScientific coeffLarge eLarge ->
showsPrec 0 coeffLarge . showChar 'e' . showsPrec 0 eLarge
instance Eq Scientific where
Scientific coeffA eA largeA == Scientific coeffB eB largeB
| eA == minBound && eB == minBound = eqLargeScientific largeA largeB
| eA == minBound = eqLargeScientific largeA (LargeScientific (fromIntegral coeffB) (fromIntegral eB))
| eB == minBound = eqLargeScientific (LargeScientific (fromIntegral coeffA) (fromIntegral eA)) largeB
| eA >= maxBound - padding || eB >= maxBound - padding = eqLargeScientific
(LargeScientific (fromIntegral coeffA) (fromIntegral eA))
(LargeScientific (fromIntegral coeffA) (fromIntegral eB))
| otherwise = eqSmall coeffA eA coeffB eB
data LargeScientific = LargeScientific !Integer !Integer
padding :: Int
padding = 50
eqSmall :: Int -> Int -> Int -> Int -> Bool
eqSmall cA0 eA0 cB0 eB0 =
let (cA,eA) = smallNormalize cA0 eA0
(cB,eB) = smallNormalize cB0 eB0
in cA == cB && eA == eB
eqLargeScientific :: LargeScientific -> LargeScientific -> Bool
eqLargeScientific a b =
let LargeScientific cA eA = largeNormalize a
LargeScientific cB eB = largeNormalize b
in cA == cB && eA == eB
zeroLarge :: LargeScientific
{-# noinline zeroLarge #-}
zeroLarge = LargeScientific 0 0
small ::
Int
-> Int
-> Scientific
small !coeff !e = if e /= minBound
then Scientific coeff e zeroLarge
else large (fromIntegral coeff) (fromIntegral e)
large ::
Integer
-> Integer
-> Scientific
large coeff e =
let !b = LargeScientific coeff e
in Scientific 0 minBound b
fromFixed :: HasResolution e => Fixed e -> Scientific
fromFixed n@(MkFixed coeff) =
let !b = LargeScientific coeff
(fromIntegral (Prelude.negate (logBase10 0 (Fixed.resolution n))))
in Scientific 0 minBound b
toWord8 :: Scientific -> Maybe Word8
{-# inline toWord8 #-}
toWord8 (Scientific (I# coeff) (I# e) largeNum) = case toWord8# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | w #) -> Just (W8# w)
toWord16 :: Scientific -> Maybe Word16
{-# inline toWord16 #-}
toWord16 (Scientific (I# coeff) (I# e) largeNum) = case toWord16# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | w #) -> Just (W16# w)
toWord32 :: Scientific -> Maybe Word32
{-# inline toWord32 #-}
toWord32 (Scientific (I# coeff) (I# e) largeNum) = case toWord32# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | w #) -> Just (W32# w)
toInt32 :: Scientific -> Maybe Int32
{-# inline toInt32 #-}
toInt32 (Scientific (I# coeff) (I# e) largeNum) = case toInt32# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | w #) -> Just (I32# w)
toWord64 :: Scientific -> Maybe Word64
{-# inline toWord64 #-}
toWord64 (Scientific (I# coeff) (I# e) largeNum) = case toWord# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | w #) -> Just (W64# w)
toWord :: Scientific -> Maybe Word
{-# inline toWord #-}
toWord (Scientific (I# coeff) (I# e) largeNum) = case toWord# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | w #) -> Just (W# w)
toInt :: Scientific -> Maybe Int
{-# inline toInt #-}
toInt (Scientific (I# coeff) (I# e) largeNum) = case toInt# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | i #) -> Just (I# i)
toInt64 :: Scientific -> Maybe Int64
{-# inline toInt64 #-}
toInt64 (Scientific (I# coeff) (I# e) largeNum) = case toInt# coeff e largeNum of
(# (# #) | #) -> Nothing
(# | i #) -> Just (I64# i)
withExposed ::
(Int -> Int -> a)
-> (Integer -> Integer -> a)
-> Scientific
-> a
withExposed f g (Scientific coeff theExp big) = if theExp /= minBound
then f coeff theExp
else case big of
LargeScientific coeff' theExp' -> g coeff' theExp'
toSmallHelper ::
(Int -> Int -> (# (# #) | Word# #) )
-> (LargeScientific -> (# (# #) | Word# #) )
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Word# #)
{-# inline toSmallHelper #-}
toSmallHelper fromSmall fromLarge coefficient0# exponent0# large0 =
if exponent0 /= minBound
then fromSmall coefficient0 exponent0
else fromLarge large0
where
coefficient0 = I# coefficient0#
exponent0 = I# exponent0#
toSmallIntHelper ::
(Int -> Int -> (# (# #) | Int# #) )
-> (LargeScientific -> (# (# #) | Int# #) )
-> Int#
-> Int#
-> LargeScientific
-> (# (# #) | Int# #)
{-# inline toSmallIntHelper #-}
toSmallIntHelper fromSmall fromLarge coefficient0# exponent0# large0 =
if exponent0 /= minBound
then fromSmall coefficient0 exponent0
else fromLarge large0
where
coefficient0 = I# coefficient0#
exponent0 = I# exponent0#
toWord8# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord8# #-}
toWord8# coefficient0# exponent0# large0 =
toSmallHelper smallToWord8 largeToWord8
coefficient0# exponent0# large0
toWord16# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord16# #-}
toWord16# coefficient0# exponent0# largeNum =
toSmallHelper smallToWord16 largeToWord16
coefficient0# exponent0# largeNum
toWord32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord32# #-}
toWord32# coefficient0# exponent0# largeNum =
toSmallHelper smallToWord32 largeToWord32
coefficient0# exponent0# largeNum
toInt32# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
{-# noinline toInt32# #-}
toInt32# coefficient0# exponent0# largeNum =
toSmallIntHelper smallToInt32 largeToInt32
coefficient0# exponent0# largeNum
toWord# :: Int# -> Int# -> LargeScientific -> (# (# #) | Word# #)
{-# noinline toWord# #-}
toWord# coefficient0# exponent0# largeNum =
toSmallHelper smallToWord largeToWord
coefficient0# exponent0# largeNum
toInt# :: Int# -> Int# -> LargeScientific -> (# (# #) | Int# #)
{-# noinline toInt# #-}
toInt# coefficient0# exponent0# largeNum =
toSmallIntHelper smallToInt largeToInt
coefficient0# exponent0# largeNum
smallToWord32 :: Int -> Int -> (# (# #) | Word# #)
smallToWord32 !coefficient0 !exponent0
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 10, coefficient >= 0, coefficient <= 0xFFFFFFFF
= word32Exp10 (fromIntegral @Int @Word coefficient) expon
| otherwise = (# (# #) | #)
smallToInt32 :: Int -> Int -> (# (# #) | Int# #)
smallToInt32 !coefficient0 !exponent0
| coefficient0 == 0 = (# | 0# #)
| (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 10
, coefficient >= fromIntegral @Int32 @Int (minBound :: Int32)
, coefficient <= fromIntegral @Int32 @Int (maxBound :: Int32)
= if coefficient >= 0
then posInt32Exp10 coefficient expon
else negInt32Exp10 coefficient expon
| otherwise = (# (# #) | #)
smallToWord :: Int -> Int -> (# (# #) | Word# #)
smallToWord !coefficient0 !exponent0
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 30, coefficient >= 0
= wordExp10 (fromIntegral @Int @Word coefficient) expon
| otherwise = (# (# #) | #)
smallToInt :: Int -> Int -> (# (# #) | Int# #)
smallToInt !coefficient0 !exponent0
| coefficient0 == 0 = (# | 0# #)
| (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 30
= if coefficient >= 0
then posIntExp10 coefficient expon
else negIntExp10 coefficient expon
| otherwise = (# (# #) | #)
smallToWord16 :: Int -> Int -> (# (# #) | Word# #)
smallToWord16 !coefficient0 !exponent0
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 5, coefficient >= 0, coefficient < 65536
, r <- exp10 coefficient expon
, y@(W16# y# ) <- fromIntegral @Int @Word16 r
, fromIntegral @Word16 @Int y == r
= (# | y# #)
| otherwise = (# (# #) | #)
smallToWord8 :: Int -> Int -> (# (# #) | Word# #)
smallToWord8 !coefficient0 !exponent0
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- incrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 3, coefficient >= 0, coefficient < 256
, r <- exp10 coefficient expon
, y@(W8# y# ) <- fromIntegral @Int @Word8 r
, fromIntegral @Word8 @Int y == r
= (# | y# #)
| otherwise = (# (# #) | #)
largeToWord8 :: LargeScientific -> (# (# #) | Word# #)
largeToWord8 (LargeScientific coefficient0 exponent0)
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 3, coefficient >= 0, coefficient < 256
, r <- exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)
, y@(W8# y# ) <- fromIntegral @Int @Word8 r
, fromIntegral @Word8 @Int y == r
= (# | y# #)
| otherwise = (# (# #) | #)
largeToWord16 :: LargeScientific -> (# (# #) | Word# #)
largeToWord16 (LargeScientific coefficient0 exponent0)
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 5, coefficient >= 0, coefficient < 65536
, r <- exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)
, y@(W16# y# ) <- fromIntegral @Int @Word16 r
, fromIntegral @Word16 @Int y == r
= (# | y# #)
| otherwise = (# (# #) | #)
largeToWord32 :: LargeScientific -> (# (# #) | Word# #)
largeToWord32 (LargeScientific coefficient0 exponent0)
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 10, coefficient >= 0, coefficient <= 0xFFFFFFFF
= word32Exp10 (fromIntegral @Integer @Word coefficient) (fromIntegral @Integer @Int expon)
| otherwise = (# (# #) | #)
largeToWord :: LargeScientific -> (# (# #) | Word# #)
largeToWord (LargeScientific coefficient0 exponent0)
| coefficient0 == 0 = (# | 0## #)
| (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 30, coefficient >= 0, coefficient <= (fromIntegral @Word @Integer maxBound)
= wordExp10 (fromIntegral @Integer @Word coefficient) (fromIntegral @Integer @Int expon)
| otherwise = (# (# #) | #)
largeToInt32 :: LargeScientific -> (# (# #) | Int# #)
largeToInt32 (LargeScientific coefficient0 exponent0)
| coefficient0 == 0 = (# | 0# #)
| (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 10
, coefficient >= (fromIntegral @Int32 @Integer minBound)
, coefficient <= (fromIntegral @Int32 @Integer maxBound)
= if coefficient >= 0
then posInt32Exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)
else negInt32Exp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)
| otherwise = (# (# #) | #)
largeToInt :: LargeScientific -> (# (# #) | Int# #)
largeToInt (LargeScientific coefficient0 exponent0)
| coefficient0 == 0 = (# | 0# #)
| (coefficient,expon) <- largeIncrementNegativeExp coefficient0 exponent0
, expon >= 0, expon < 30
, coefficient >= (fromIntegral @Int @Integer minBound)
, coefficient <= (fromIntegral @Int @Integer maxBound)
= if coefficient >= 0
then posIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)
else negIntExp10 (fromIntegral @Integer @Int coefficient) (fromIntegral @Integer @Int expon)
| otherwise = (# (# #) | #)
word32Exp10 :: Word -> Int -> (# (# #) | Word# #)
word32Exp10 !a@(W# a# ) !e = case e of
0 -> (# | a# #)
_ -> let (overflow, a') = timesWord2 a 10 in
if overflow || (a' > 0xFFFFFFFF)
then (# (# #) | #)
else word32Exp10 a' (e - 1)
posInt32Exp10 :: Int -> Int -> (# (# #) | Int# #)
posInt32Exp10 !a@(I# a# ) !e = case e of
0 -> (# | a# #)
_ -> if a < posInt32PreUpper
then let a' = a * 10 in
if a' >= a && a' <= fromIntegral (maxBound :: Int32)
then posInt32Exp10 a' (e - 1)
else (# (# #) | #)
else (# (# #) | #)
negInt32Exp10 :: Int -> Int -> (# (# #) | Int# #)
negInt32Exp10 !a@(I# a# ) !e = case e of
0 -> (# | a# #)
_ -> if a > negInt32PreLower
then let a' = a * 10 in
if a' <= a && a' >= fromIntegral (minBound :: Int32)
then negInt32Exp10 a' (e - 1)
else (# (# #) | #)
else (# (# #) | #)
wordExp10 :: Word -> Int -> (# (# #) | Word# #)
wordExp10 !a@(W# a# ) !e = case e of
0 -> (# | a# #)
_ -> let (overflow, a') = timesWord2 a 10 in if overflow
then (# (# #) | #)
else wordExp10 a' (e - 1)
posIntExp10 :: Int -> Int -> (# (# #) | Int# #)
posIntExp10 !a@(I# a# ) !e = case e of
0 -> (# | a# #)
_ -> if a < posIntPreUpper
then let a' = a * 10 in
if a' >= a
then posIntExp10 a' (e - 1)
else (# (# #) | #)
else (# (# #) | #)
negIntExp10 :: Int -> Int -> (# (# #) | Int# #)
negIntExp10 !a@(I# a# ) !e = case e of
0 -> (# | a# #)
_ -> if a > negIntPreLower
then let a' = a * 10 in
if a' <= a
then negIntExp10 a' (e - 1)
else (# (# #) | #)
else (# (# #) | #)
posIntPreUpper :: Int
posIntPreUpper = div maxBound 10 + 10
negIntPreLower :: Int
negIntPreLower = div minBound 10 - 10
posInt32PreUpper :: Int
posInt32PreUpper = 214748370
negInt32PreLower :: Int
negInt32PreLower = (-214748370)
timesWord2 :: Word -> Word -> (Bool, Word)
timesWord2 (W# a) (W# b) =
let !(# c, r #) = Exts.timesWord2# a b
in (case c of { 0## -> False; _ -> True}, W# r)
exp10 :: Int -> Int -> Int
exp10 !a !e = case e of
0 -> a
_ -> exp10 (a * 10) (e - 1)
largeNormalize :: LargeScientific -> LargeScientific
largeNormalize s@(LargeScientific w _) = case w of
0 -> LargeScientific 0 0
_ -> largeNormalizeLoop s
largeNormalizeLoop :: LargeScientific -> LargeScientific
largeNormalizeLoop (LargeScientific w e) = case quotRem w 10 of
(q,r) -> case r of
0 -> largeNormalizeLoop (LargeScientific q (e + 1))
_ -> LargeScientific w e
largeIncrementNegativeExp :: Integer -> Integer -> (Integer,Integer)
largeIncrementNegativeExp w e = if e >= 0
then (w,e)
else case quotRem w 10 of
(q,r) -> case r of
0 -> largeIncrementNegativeExp q (e + 1)
_ -> (w,e)
smallNormalize :: Int -> Int -> (Int,Int)
smallNormalize (I# w) (I# e) = case w of
0# -> (0,0)
_ -> case smallNormalize# w e of
(# w', e' #) -> (I# w', I# e')
incrementNegativeExp :: Int -> Int -> (Int,Int)
incrementNegativeExp (I# w) (I# e) = case incrementNegativeExp# w e of
(# w', e' #) -> (I# w', I# e')
incrementNegativeExp# :: Int# -> Int# -> (# Int#, Int# #)
{-# noinline incrementNegativeExp# #-}
incrementNegativeExp# w# e# = if I# e# >= 0
then (# w#, e# #)
else case quotRem (I# w# ) 10 of
(I# q#,r) -> case r of
0 -> incrementNegativeExp# q# (e# +# 1# )
_ -> (# w#, e# #)
smallNormalize# :: Int# -> Int# -> (# Int#, Int# #)
{-# noinline smallNormalize# #-}
smallNormalize# w# e# = case quotRem (I# w# ) 10 of
(I# q#,r) -> case r of
0 -> smallNormalize# q# (e# +# 1# )
_ -> (# w#, e# #)
parserSignedUtf8Bytes :: e -> Parser e s Scientific
parserSignedUtf8Bytes e = boxScientific (parserSignedUtf8Bytes# e)
parserUnsignedUtf8Bytes :: e -> Parser e s Scientific
parserUnsignedUtf8Bytes e = boxScientific (parserUnsignedUtf8Bytes# e)
parserNegatedUtf8Bytes :: e -> Parser e s Scientific
parserNegatedUtf8Bytes e = boxScientific (parserNegatedUtf8Bytes# e)
parserTrailingUtf8Bytes# ::
e
-> Int#
-> Parser e s Scientific#
{-# noinline parserTrailingUtf8Bytes# #-}
parserTrailingUtf8Bytes# e leader =
mapIntPairToScientific (parseSmallTrailing# leader)
`orElseScientific`
upcastLargeScientific (parseLargeTrailing e (I# leader))
parserNegatedTrailingUtf8Bytes# ::
e
-> Int#
-> Parser e s Scientific#
{-# noinline parserNegatedTrailingUtf8Bytes# #-}
parserNegatedTrailingUtf8Bytes# e leader =
mapNegateIntPairToScientific (parseSmallTrailing# leader)
`orElseScientific`
upcastNegatedLargeScientific (parseLargeTrailing e (I# leader))
parserSignedUtf8Bytes# ::
e
-> Parser e s Scientific#
parserSignedUtf8Bytes# e = Latin.any e `bindToScientific` \c -> case c of
'+' -> parserUnsignedUtf8Bytes# e
'-' -> parserNegatedUtf8Bytes# e
_ -> Unsafe.unconsume 1 `bindToScientific` \_ ->
parserUnsignedUtf8Bytes# e
parserUnsignedUtf8Bytes# ::
e
-> Parser e s Scientific#
parserUnsignedUtf8Bytes# e =
mapIntPairToScientific parseSmall#
`orElseScientific`
upcastLargeScientific (parseLarge e)
parserNegatedUtf8Bytes# ::
e
-> Parser e s Scientific#
parserNegatedUtf8Bytes# e =
mapNegateIntPairToScientific parseSmall#
`orElseScientific`
upcastNegatedLargeScientific (parseLarge e)
parserTrailingUtf8Bytes ::
e
-> Int
-> Parser e s Scientific
parserTrailingUtf8Bytes e (I# leader) =
boxScientific (parserTrailingUtf8Bytes# e leader)
parserNegatedTrailingUtf8Bytes ::
e
-> Int
-> Parser e s Scientific
parserNegatedTrailingUtf8Bytes e (I# leader) =
boxScientific (parserNegatedTrailingUtf8Bytes# e leader)
parseLarge :: e -> Parser e s LargeScientific
parseLarge e = do
coeff <- Latin.decUnsignedInteger e
parseLargeCommon e coeff
parseLargeTrailing :: e -> Int -> Parser e s LargeScientific
parseLargeTrailing e !leader = do
coeff <- Latin.decTrailingInteger leader
parseLargeCommon e coeff
parseLargeCommon :: e -> Integer -> Parser e s LargeScientific
{-# noinline parseLargeCommon #-}
parseLargeCommon e coeff = do
Latin.trySatisfyThen (pure (LargeScientific coeff 0)) $ \c -> case c of
'.' -> Just $ do
!start <- Unsafe.cursor
afterDot <- Latin.decUnsignedInteger e
!end <- Unsafe.cursor
let !logDenom = end - start
!coeffFinal = (integerTenExp coeff logDenom) + afterDot
Latin.trySatisfy (\ch -> ch == 'e' || ch == 'E') >>= \case
True -> attemptLargeExp e coeffFinal (unI (Prelude.negate logDenom))
False -> pure $! LargeScientific coeffFinal $! fromIntegral $! Prelude.negate logDenom
'e' -> Just (attemptLargeExp e coeff 0# )
'E' -> Just (attemptLargeExp e coeff 0# )
_ -> Nothing
parseSmall# :: Parser () s (# Int#, Int# #)
parseSmall# =
Latin.decUnsignedInt# () `Parser.bindFromIntToIntPair` \coeff# ->
parseSmallCommon# coeff#
parseSmallTrailing# :: Int# -> Parser () s (# Int#, Int# #)
parseSmallTrailing# leader =
Latin.decTrailingInt# () leader `Parser.bindFromIntToIntPair` \coeff# ->
parseSmallCommon# coeff#
parseSmallCommon# :: Int# -> Parser () s (# Int#, Int# #)
{-# noinline parseSmallCommon# #-}
parseSmallCommon# coeff# =
Latin.trySatisfyThen (Parser.pureIntPair (# coeff#, 0# #)) $ \c -> case c of
'.' -> Just $
Unsafe.cursor `Parser.bindFromLiftedToIntPair` \start ->
Latin.decUnsignedInt# () `Parser.bindFromIntToIntPair` \afterDot# ->
Unsafe.cursor `Parser.bindFromLiftedToIntPair` \end ->
let !logDenom = end - start
goCoeff !coeffShifted !expon = case expon of
0 ->
let !(I# coeffShifted# ) = coeffShifted
!(# coeffFinal, overflowed #) =
Exts.addIntC# coeffShifted# afterDot#
in case overflowed of
0# -> Latin.trySatisfy (\ch -> ch == 'e' || ch == 'E') `Parser.bindFromLiftedToIntPair` \b -> case b of
True -> attemptSmallExp coeffFinal (unI (Prelude.negate logDenom))
False -> Parser.pureIntPair (# coeffFinal, unI (Prelude.negate logDenom) #)
_ -> Parser.failIntPair ()
_ ->
let coeffShifted' = coeffShifted * 10
in if coeffShifted' >= coeffShifted
then goCoeff coeffShifted' (expon - 1)
else Parser.failIntPair ()
in goCoeff (I# coeff# ) logDenom
'e' -> Just (attemptSmallExp coeff# 0#)
'E' -> Just (attemptSmallExp coeff# 0#)
_ -> Nothing
attemptLargeExp ::
e
-> Integer
-> Int#
-> Parser e s LargeScientific
{-# noinline attemptLargeExp #-}
attemptLargeExp e signedCoeff !deltaExp# = do
expon <- Latin.decSignedInteger e
let !exponent' = expon + fromIntegral (I# deltaExp# )
pure (LargeScientific signedCoeff exponent')
attemptSmallExp :: Int# -> Int# -> Parser () s (# Int#, Int# #)
{-# noinline attemptSmallExp #-}
attemptSmallExp !signedCoeff# !deltaExp# = Parser.unboxIntPair $ do
e <- Latin.decSignedInt ()
if e > (minBound + padding)
then pure (signedCoeff, e + deltaExp)
else Parser.fail ()
where
signedCoeff = I# signedCoeff#
deltaExp = I# deltaExp#
boxScientific :: Parser s e Scientific# -> Parser s e Scientific
boxScientific (Parser f) = Parser
(\x s0 -> case f x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# (# w, y, z #), b, c #) #) -> (# s1, (# | (# Scientific (I# w) (I# y) z, b, c #) #) #)
)
unI :: Int -> Int#
unI (I# i) = i
orElseScientific :: Parser x s Scientific# -> Parser e s Scientific# -> Parser e s Scientific#
{-# inline orElseScientific #-}
orElseScientific (Parser f) (Parser g) = Parser
(\x s0 -> case f x s0 of
(# s1, r0 #) -> case r0 of
(# _ | #) -> g x s1
(# | r #) -> (# s1, (# | r #) #)
)
integerTenExp :: Integer -> Int -> Integer
integerTenExp !r !e = case e of
0 -> r
1 -> r * 10
2 -> r * 100
3 -> r * 1000
4 -> r * 10000
5 -> r * 100000
6 -> r * 1000000
7 -> r * 10000000
8 -> r * 100000000
_ -> integerTenExp (r * 1000000000) (e - 9)
logBase10 :: Int -> Integer -> Int
logBase10 !acc i = if i == 1
then acc
else logBase10 (acc + 1) (div i 10)
upcastLargeScientific ::
Parser e s LargeScientific
-> Parser e s Scientific#
upcastLargeScientific (Parser g) = Parser
(\x s0 -> case g x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# (# 0#, unI minBound, a #), b, c #) #) #)
)
upcastNegatedLargeScientific ::
Parser e s LargeScientific
-> Parser e s Scientific#
upcastNegatedLargeScientific (Parser g) = Parser
(\x s0 -> case g x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# LargeScientific w y, b, c #) #) -> (# s1, (# | (# (# 0#, unI minBound, LargeScientific (Prelude.negate w) y #), b, c #) #) #)
)
mapIntPairToScientific ::
Parser e s (# Int#, Int# #)
-> Parser e s Scientific#
mapIntPairToScientific (Parser g) = Parser
(\x s0 -> case g x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# (# y, z #), b, c #) #) -> (# s1, (# | (# (# y, z, zeroLarge #), b, c #) #) #)
)
mapNegateIntPairToScientific ::
Parser e s (# Int#, Int# #)
-> Parser e s Scientific#
mapNegateIntPairToScientific (Parser g) = Parser
(\x s0 -> case g x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# (# y, z #), b, c #) #) -> (# s1, (# | (# (# Exts.negateInt# y, z, zeroLarge #), b, c #) #) #)
)
bindToScientific :: Parser s e a -> (a -> Parser s e Scientific#) -> Parser s e Scientific#
{-# inline bindToScientific #-}
bindToScientific (Parser f) g = Parser
(\x@(# arr, _, _ #) s0 -> case f x s0 of
(# s1, r0 #) -> case r0 of
(# e | #) -> (# s1, (# e | #) #)
(# | (# y, b, c #) #) ->
runParser (g y) (# arr, b, c #) s1
)