{-# LANGUAGE ScopedTypeVariables, ExplicitForAll #-}
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
module Data.ByteString.Builder.RealFloat.Internal
( mask
, NonNumbersAndZero(..)
, toCharsNonNumbersAndZero
, decimalLength9
, decimalLength17
, Mantissa
, pow5bits
, log10pow2
, log10pow5
, pow5_factor
, multipleOfPowerOf5
, multipleOfPowerOf2
, acceptBounds
, BoundsState(..)
, trimTrailing
, trimNoTrailing
, closestCorrectlyRounded
, toCharsScientific
, fquot10
, frem10
, fquot5
, frem5
, dquot10
, dquotRem10
, dquot5
, drem5
, dquot100
, timesWord2
, castDoubleToWord64
, castFloatToWord32
, getWord64At
, getWord128At
, boolToWord32
, boolToWord64
, int32ToInt
, intToInt32
, word32ToInt
, word64ToInt
, word32ToWord64
, word64ToWord32
, module Data.ByteString.Builder.RealFloat.TableGenerator
) where
import Control.Monad (foldM)
import Data.Bits (Bits(..), FiniteBits(..))
import Data.ByteString.Internal (c2w)
import Data.ByteString.Builder.Prim.Internal (BoundedPrim, boundedPrim)
import Data.ByteString.Builder.RealFloat.TableGenerator
import Data.ByteString.Utils.ByteOrder
import Data.ByteString.Utils.UnalignedAccess
#if PURE_HASKELL
import qualified Data.ByteString.Internal.Pure as Pure
#else
import Foreign.C.Types
#endif
import Data.Char (ord)
import GHC.Int (Int(..), Int32(..))
import GHC.IO (IO(..), unIO)
import GHC.Prim
import GHC.Ptr (Ptr(..), plusPtr, castPtr)
import GHC.Types (isTrue#)
import GHC.Word (Word8, Word16(..), Word32(..), Word64(..))
import qualified Foreign.Storable as S (poke)
#include <ghcautoconf.h>
#include "MachDeps.h"
#if WORD_SIZE_IN_BITS < 64 && !MIN_VERSION_ghc_prim(0,8,0)
import GHC.IntWord64
#endif
import Data.ByteString.Builder.Prim.Internal.Floating
(castFloatToWord32, castDoubleToWord64)
{-# INLINABLE mask #-}
mask :: (Bits a, Integral a) => Int -> a
mask :: forall a. (Bits a, Integral a) => Int -> a
mask = (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) a
1 (a -> a) -> (Int -> a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL a
1
{-# INLINABLE boolToWord32 #-}
boolToWord32 :: Bool -> Word32
boolToWord32 :: Bool -> Word32
boolToWord32 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (Bool -> Int) -> Bool -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum
{-# INLINABLE boolToWord64 #-}
boolToWord64 :: Bool -> Word64
boolToWord64 :: Bool -> Word64
boolToWord64 = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (Bool -> Int) -> Bool -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum
{-# INLINABLE int32ToInt #-}
int32ToInt :: Int32 -> Int
int32ToInt :: Int32 -> Int
int32ToInt = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINABLE intToInt32 #-}
intToInt32 :: Int -> Int32
intToInt32 :: Int -> Int32
intToInt32 = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINABLE word32ToInt #-}
word32ToInt :: Word32 -> Int
word32ToInt :: Word32 -> Int
word32ToInt = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINABLE word64ToInt #-}
word64ToInt :: Word64 -> Int
word64ToInt :: Word64 -> Int
word64ToInt = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINABLE word32ToWord64 #-}
word32ToWord64 :: Word32 -> Word64
word32ToWord64 :: Word32 -> Word64
word32ToWord64 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINABLE word64ToWord32 #-}
word64ToWord32 :: Word64 -> Word32
word64ToWord32 :: Word64 -> Word32
word64ToWord32 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
decimalLength9 :: Word32 -> Int
decimalLength9 :: Word32 -> Int
decimalLength9 Word32
v
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
100000000 = Int
9
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
10000000 = Int
8
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
1000000 = Int
7
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
100000 = Int
6
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
10000 = Int
5
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
1000 = Int
4
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
100 = Int
3
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
10 = Int
2
| Bool
otherwise = Int
1
decimalLength17 :: Word64 -> Int
decimalLength17 :: Word64 -> Int
decimalLength17 Word64
v
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
10000000000000000 = Int
17
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1000000000000000 = Int
16
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
100000000000000 = Int
15
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
10000000000000 = Int
14
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1000000000000 = Int
13
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
100000000000 = Int
12
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
10000000000 = Int
11
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1000000000 = Int
10
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
100000000 = Int
9
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
10000000 = Int
8
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1000000 = Int
7
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
100000 = Int
6
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
10000 = Int
5
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1000 = Int
4
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
100 = Int
3
| Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
10 = Int
2
| Bool
otherwise = Int
1
maxEncodedLength :: Int
maxEncodedLength :: Int
maxEncodedLength = Int
32
pokeAll :: String -> Ptr Word8 -> IO (Ptr Word8)
pokeAll :: String -> Ptr Word8 -> IO (Ptr Word8)
pokeAll String
s Ptr Word8
ptr = (Ptr Word8 -> Char -> IO (Ptr Word8))
-> Ptr Word8 -> String -> IO (Ptr Word8)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Ptr Word8 -> Char -> IO (Ptr Word8)
forall {b}. Ptr Word8 -> Char -> IO (Ptr b)
pokeOne Ptr Word8
ptr String
s
where pokeOne :: Ptr Word8 -> Char -> IO (Ptr b)
pokeOne Ptr Word8
p Char
c = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke Ptr Word8
p (Char -> Word8
c2w Char
c) IO () -> IO (Ptr b) -> IO (Ptr b)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO (Ptr b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
p Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
boundString :: String -> BoundedPrim ()
boundString :: String -> BoundedPrim ()
boundString String
s = Int -> (() -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim ()
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boundedPrim Int
maxEncodedLength ((() -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim ())
-> (() -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim ()
forall a b. (a -> b) -> a -> b
$ (Ptr Word8 -> IO (Ptr Word8)) -> () -> Ptr Word8 -> IO (Ptr Word8)
forall a b. a -> b -> a
const (String -> Ptr Word8 -> IO (Ptr Word8)
pokeAll String
s)
data NonNumbersAndZero = NonNumbersAndZero
{ NonNumbersAndZero -> Bool
negative :: Bool
, NonNumbersAndZero -> Bool
exponent_all_one :: Bool
, NonNumbersAndZero -> Bool
mantissa_non_zero :: Bool
}
toCharsNonNumbersAndZero :: NonNumbersAndZero -> BoundedPrim ()
toCharsNonNumbersAndZero :: NonNumbersAndZero -> BoundedPrim ()
toCharsNonNumbersAndZero NonNumbersAndZero{Bool
negative :: NonNumbersAndZero -> Bool
exponent_all_one :: NonNumbersAndZero -> Bool
mantissa_non_zero :: NonNumbersAndZero -> Bool
negative :: Bool
exponent_all_one :: Bool
mantissa_non_zero :: Bool
..}
| Bool
mantissa_non_zero = String -> BoundedPrim ()
boundString String
"NaN"
| Bool
exponent_all_one = String -> BoundedPrim ()
boundString (String -> BoundedPrim ()) -> String -> BoundedPrim ()
forall a b. (a -> b) -> a -> b
$ String
signStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Infinity"
| Bool
otherwise = String -> BoundedPrim ()
boundString (String -> BoundedPrim ()) -> String -> BoundedPrim ()
forall a b. (a -> b) -> a -> b
$ String
signStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"0.0e0"
where signStr :: String
signStr = if Bool
negative then String
"-" else String
""
acceptBounds :: Mantissa a => a -> Bool
acceptBounds :: forall a. Mantissa a => a -> Bool
acceptBounds a
_ = Bool
False
pow5bitsUnboxed :: Int# -> Int#
pow5bitsUnboxed :: Int# -> Int#
pow5bitsUnboxed Int#
e = (Int#
e Int# -> Int# -> Int#
*# Int#
1217359#) Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
19# Int# -> Int# -> Int#
+# Int#
1#
log10pow2Unboxed :: Int# -> Int#
log10pow2Unboxed :: Int# -> Int#
log10pow2Unboxed Int#
e = (Int#
e Int# -> Int# -> Int#
*# Int#
78913#) Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
18#
log10pow5Unboxed :: Int# -> Int#
log10pow5Unboxed :: Int# -> Int#
log10pow5Unboxed Int#
e = (Int#
e Int# -> Int# -> Int#
*# Int#
732923#) Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
20#
pow5bits, log10pow2, log10pow5 :: Int -> Int
pow5bits :: Int -> Int
pow5bits = (Int# -> Int#) -> Int -> Int
wrapped Int# -> Int#
pow5bitsUnboxed
log10pow2 :: Int -> Int
log10pow2 = (Int# -> Int#) -> Int -> Int
wrapped Int# -> Int#
log10pow2Unboxed
log10pow5 :: Int -> Int
log10pow5 = (Int# -> Int#) -> Int -> Int
wrapped Int# -> Int#
log10pow5Unboxed
fquot10 :: Word32 -> Word32
fquot10 :: Word32 -> Word32
fquot10 Word32
w = Word64 -> Word32
word64ToWord32 ((Word32 -> Word64
word32ToWord64 Word32
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
0xCCCCCCCD) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
35)
frem10 :: Word32 -> Word32
frem10 :: Word32 -> Word32
frem10 Word32
w = Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32 -> Word32
fquot10 Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
10
fquotRem10 :: Word32 -> (Word32, Word32)
fquotRem10 :: Word32 -> (Word32, Word32)
fquotRem10 Word32
w =
let w' :: Word32
w' = Word32 -> Word32
fquot10 Word32
w
in (Word32
w', Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32 -> Word32
fquot10 Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
10)
fquot100 :: Word32 -> Word32
fquot100 :: Word32 -> Word32
fquot100 Word32
w = Word64 -> Word32
word64ToWord32 ((Word32 -> Word64
word32ToWord64 Word32
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
0x51EB851F) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
37)
fquotRem10000 :: Word32 -> (Word32, Word32)
fquotRem10000 :: Word32 -> (Word32, Word32)
fquotRem10000 Word32
w =
let w' :: Word32
w' = Word64 -> Word32
word64ToWord32 ((Word32 -> Word64
word32ToWord64 Word32
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
0xD1B71759) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
45)
in (Word32
w', Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
w' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
10000)
fquot5 :: Word32 -> Word32
fquot5 :: Word32 -> Word32
fquot5 Word32
w = Word64 -> Word32
word64ToWord32 ((Word32 -> Word64
word32ToWord64 Word32
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
0xCCCCCCCD) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
34)
frem5 :: Word32 -> Word32
frem5 :: Word32 -> Word32
frem5 Word32
w = Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32 -> Word32
fquot5 Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
5
dquot10 :: Word64 -> Word64
dquot10 :: Word64 -> Word64
dquot10 Word64
w =
let !(Word64
rdx, Word64
_) = Word64
w Word64 -> Word64 -> (Word64, Word64)
`timesWord2` Word64
0xCCCCCCCCCCCCCCCD
in Word64
rdx Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3
dquot100 :: Word64 -> Word64
dquot100 :: Word64 -> Word64
dquot100 Word64
w =
let !(Word64
rdx, Word64
_) = (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2) Word64 -> Word64 -> (Word64, Word64)
`timesWord2` Word64
0x28F5C28F5C28F5C3
in Word64
rdx Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2
dquotRem10000 :: Word64 -> (Word64, Word64)
dquotRem10000 :: Word64 -> (Word64, Word64)
dquotRem10000 Word64
w =
let !(Word64
rdx, Word64
_) = Word64
w Word64 -> Word64 -> (Word64, Word64)
`timesWord2` Word64
0x346DC5D63886594B
w' :: Word64
w' = Word64
rdx Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
11
in (Word64
w', Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
w' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10000)
dquotRem10 :: Word64 -> (Word64, Word64)
dquotRem10 :: Word64 -> (Word64, Word64)
dquotRem10 Word64
w =
let w' :: Word64
w' = Word64 -> Word64
dquot10 Word64
w
in (Word64
w', Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
w' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10)
dquot5 :: Word64 -> Word64
dquot5 :: Word64 -> Word64
dquot5 Word64
w =
let !(Word64
rdx, Word64
_) = Word64
w Word64 -> Word64 -> (Word64, Word64)
`timesWord2` Word64
0xCCCCCCCCCCCCCCCD
in Word64
rdx Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2
drem5 :: Word64 -> Word64
drem5 :: Word64 -> Word64
drem5 Word64
w = Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64 -> Word64
dquot5 Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
5
dquotRem5 :: Word64 -> (Word64, Word64)
dquotRem5 :: Word64 -> (Word64, Word64)
dquotRem5 Word64
w =
let w' :: Word64
w' = Word64 -> Word64
dquot5 Word64
w
in (Word64
w', Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
w' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
5)
wrapped :: (Int# -> Int#) -> Int -> Int
wrapped :: (Int# -> Int#) -> Int -> Int
wrapped Int# -> Int#
f (I# Int#
w) = Int# -> Int
I# (Int# -> Int#
f Int#
w)
#if WORD_SIZE_IN_BITS == 32
packWord64 :: Word# -> Word# -> Word64#
packWord64 hi lo = case hostByteOrder of
BigEndian ->
((wordToWord64# lo) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# hi)
LittleEndian ->
((wordToWord64# hi) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# lo)
unpackWord64 :: Word64# -> (# Word#, Word# #)
unpackWord64 w = case hostByteOrder of
BigEndian ->
(# word64ToWord# w
, word64ToWord# (w `uncheckedShiftRL64#` 32#)
#)
LittleEndian ->
(# word64ToWord# (w `uncheckedShiftRL64#` 32#)
, word64ToWord# w
#)
plusWord64 :: Word64# -> Word64# -> Word64#
plusWord64 x y =
let !(# x_h, x_l #) = unpackWord64 x
!(# y_h, y_l #) = unpackWord64 y
lo = x_l `plusWord#` y_l
carry = int2Word# (lo `ltWord#` x_l)
hi = x_h `plusWord#` y_h `plusWord#` carry
in packWord64 hi lo
#endif
timesWord2 :: Word64 -> Word64 -> (Word64, Word64)
timesWord2 :: Word64 -> Word64 -> (Word64, Word64)
timesWord2 Word64
a Word64
b =
let ra :: WORD64
ra = Word64 -> WORD64
forall a. Mantissa a => a -> WORD64
raw Word64
a
rb :: WORD64
rb = Word64 -> WORD64
forall a. Mantissa a => a -> WORD64
raw Word64
b
#if WORD_SIZE_IN_BITS >= 64
#if __GLASGOW_HASKELL__ < 903
!(# hi, lo #) = ra `timesWord2#` rb
#else
!(# Word#
hi_, Word#
lo_ #) = WORD64 -> Word#
word64ToWord# WORD64
ra Word# -> Word# -> (# Word#, Word# #)
`timesWord2#` WORD64 -> Word#
word64ToWord# WORD64
rb
hi :: WORD64
hi = Word# -> WORD64
wordToWord64# Word#
hi_
lo :: WORD64
lo = Word# -> WORD64
wordToWord64# Word#
lo_
#endif
#else
!(# x_h, x_l #) = unpackWord64 ra
!(# y_h, y_l #) = unpackWord64 rb
!(# phh_h, phh_l #) = x_h `timesWord2#` y_h
!(# phl_h, phl_l #) = x_h `timesWord2#` y_l
!(# plh_h, plh_l #) = x_l `timesWord2#` y_h
!(# pll_h, pll_l #) = x_l `timesWord2#` y_l
phh = packWord64 phh_h phh_l
phl = packWord64 phl_h phl_l
!(# mh, ml #) = unpackWord64 (phl
`plusWord64` (wordToWord64# pll_h)
`plusWord64` (wordToWord64# plh_l))
hi = phh
`plusWord64` (wordToWord64# mh)
`plusWord64` (wordToWord64# plh_h)
lo = packWord64 ml pll_l
#endif
in (WORD64 -> Word64
W64# WORD64
hi, WORD64 -> Word64
W64# WORD64
lo)
type WORD64 =
#if WORD_SIZE_IN_BITS < 64 || __GLASGOW_HASKELL__ >= 903
Word64#
#else
Word#
#endif
pow5_factor :: WORD64 -> Int# -> Int#
pow5_factor :: WORD64 -> Int# -> Int#
pow5_factor WORD64
w Int#
count =
let !(W64# WORD64
q, W64# WORD64
r) = Word64 -> (Word64, Word64)
dquotRem5 (WORD64 -> Word64
W64# WORD64
w)
#if WORD_SIZE_IN_BITS >= 64 && __GLASGOW_HASKELL__ < 903
in case r `eqWord#` 0## of
#else
in case WORD64
r WORD64 -> WORD64 -> Int#
`eqWord64#` Word# -> WORD64
wordToWord64# Word#
0## of
#endif
Int#
0# -> Int#
count
Int#
_ -> WORD64 -> Int# -> Int#
pow5_factor WORD64
q (Int#
count Int# -> Int# -> Int#
+# Int#
1#)
multipleOfPowerOf5 :: Mantissa a => a -> Int -> Bool
multipleOfPowerOf5 :: forall a. Mantissa a => a -> Int -> Bool
multipleOfPowerOf5 a
value (I# Int#
p) = Int# -> Bool
isTrue# (WORD64 -> Int# -> Int#
pow5_factor (a -> WORD64
forall a. Mantissa a => a -> WORD64
raw a
value) Int#
0# Int# -> Int# -> Int#
>=# Int#
p)
multipleOfPowerOf2 :: Mantissa a => a -> Int -> Bool
multipleOfPowerOf2 :: forall a. Mantissa a => a -> Int -> Bool
multipleOfPowerOf2 a
value Int
p = (a
value a -> a -> a
forall a. Bits a => a -> a -> a
.&. Int -> a
forall a. (Bits a, Integral a) => Int -> a
mask Int
p) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
class (FiniteBits a, Integral a) => Mantissa a where
unsafeRaw :: a -> Word#
raw :: a -> WORD64
decimalLength :: a -> Int
boolToWord :: Bool -> a
quotRem10 :: a -> (a, a)
quot10 :: a -> a
quot100 :: a -> a
quotRem100 :: a -> (a, a)
quotRem10000 :: a -> (a, a)
instance Mantissa Word32 where
#if __GLASGOW_HASKELL__ >= 902
unsafeRaw :: Word32 -> Word#
unsafeRaw (W32# Word32#
w) = Word32# -> Word#
word32ToWord# Word32#
w
#else
unsafeRaw (W32# w) = w
#endif
#if WORD_SIZE_IN_BITS >= 64 && __GLASGOW_HASKELL__ < 903
raw = unsafeRaw
#else
raw :: Word32 -> WORD64
raw Word32
w = Word# -> WORD64
wordToWord64# (Word32 -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw Word32
w)
#endif
decimalLength :: Word32 -> Int
decimalLength = Word32 -> Int
decimalLength9
boolToWord :: Bool -> Word32
boolToWord = Bool -> Word32
boolToWord32
{-# INLINE quotRem10 #-}
quotRem10 :: Word32 -> (Word32, Word32)
quotRem10 = Word32 -> (Word32, Word32)
fquotRem10
{-# INLINE quot10 #-}
quot10 :: Word32 -> Word32
quot10 = Word32 -> Word32
fquot10
{-# INLINE quot100 #-}
quot100 :: Word32 -> Word32
quot100 = Word32 -> Word32
fquot100
quotRem100 :: Word32 -> (Word32, Word32)
quotRem100 Word32
w =
let w' :: Word32
w' = Word32 -> Word32
fquot100 Word32
w
in (Word32
w', (Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
w' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
100))
quotRem10000 :: Word32 -> (Word32, Word32)
quotRem10000 = Word32 -> (Word32, Word32)
fquotRem10000
instance Mantissa Word64 where
#if WORD_SIZE_IN_BITS >= 64 && __GLASGOW_HASKELL__ < 903
unsafeRaw (W64# w) = w
#else
unsafeRaw :: Word64 -> Word#
unsafeRaw (W64# WORD64
w) = WORD64 -> Word#
word64ToWord# WORD64
w
#endif
raw :: Word64 -> WORD64
raw (W64# WORD64
w) = WORD64
w
decimalLength :: Word64 -> Int
decimalLength = Word64 -> Int
decimalLength17
boolToWord :: Bool -> Word64
boolToWord = Bool -> Word64
boolToWord64
{-# INLINE quotRem10 #-}
quotRem10 :: Word64 -> (Word64, Word64)
quotRem10 = Word64 -> (Word64, Word64)
dquotRem10
{-# INLINE quot10 #-}
quot10 :: Word64 -> Word64
quot10 = Word64 -> Word64
dquot10
{-# INLINE quot100 #-}
quot100 :: Word64 -> Word64
quot100 = Word64 -> Word64
dquot100
quotRem100 :: Word64 -> (Word64, Word64)
quotRem100 Word64
w =
let w' :: Word64
w' = Word64 -> Word64
dquot100 Word64
w
in (Word64
w', (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
w' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
100))
quotRem10000 :: Word64 -> (Word64, Word64)
quotRem10000 = Word64 -> (Word64, Word64)
dquotRem10000
data BoundsState a = BoundsState
{ forall a. BoundsState a -> a
vu :: !a
, forall a. BoundsState a -> a
vv :: !a
, forall a. BoundsState a -> a
vw :: !a
, forall a. BoundsState a -> a
lastRemovedDigit :: !a
, forall a. BoundsState a -> Bool
vuIsTrailingZeros :: !Bool
, forall a. BoundsState a -> Bool
vvIsTrailingZeros :: !Bool
}
trimTrailing :: (Show a, Mantissa a) => BoundsState a -> (BoundsState a, Int32)
trimTrailing :: forall a.
(Show a, Mantissa a) =>
BoundsState a -> (BoundsState a, Int32)
trimTrailing !BoundsState a
initial = (BoundsState a
res, Int32
r Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
r')
where
!(BoundsState a
d', Int32
r) = BoundsState a -> (BoundsState a, Int32)
forall {a} {b}.
(Mantissa a, Num b) =>
BoundsState a -> (BoundsState a, b)
trimTrailing' BoundsState a
initial
!(BoundsState a
d'', Int32
r') = if BoundsState a -> Bool
forall a. BoundsState a -> Bool
vuIsTrailingZeros BoundsState a
d' then BoundsState a -> (BoundsState a, Int32)
forall {a} {b}.
(Mantissa a, Num b) =>
BoundsState a -> (BoundsState a, b)
trimTrailing'' BoundsState a
d' else (BoundsState a
d', Int32
0)
res :: BoundsState a
res = if BoundsState a -> Bool
forall a. BoundsState a -> Bool
vvIsTrailingZeros BoundsState a
d'' Bool -> Bool -> Bool
&& BoundsState a -> a
forall a. BoundsState a -> a
lastRemovedDigit BoundsState a
d'' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
5 Bool -> Bool -> Bool
&& BoundsState a -> a
forall a. BoundsState a -> a
vv BoundsState a
d'' a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
then BoundsState a
d''
else BoundsState a
d''
trimTrailing' :: BoundsState a -> (BoundsState a, b)
trimTrailing' !BoundsState a
d
| a
vw' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
vu' =
(b -> b) -> (BoundsState a, b) -> (BoundsState a, b)
forall a b. (a -> b) -> (BoundsState a, a) -> (BoundsState a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b -> b
forall a. Num a => a -> a -> a
(+) b
1) ((BoundsState a, b) -> (BoundsState a, b))
-> (BoundsState a -> (BoundsState a, b))
-> BoundsState a
-> (BoundsState a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundsState a -> (BoundsState a, b)
trimTrailing' (BoundsState a -> (BoundsState a, b))
-> BoundsState a -> (BoundsState a, b)
forall a b. (a -> b) -> a -> b
$
BoundsState a
d { vu = vu'
, vv = vv'
, vw = vw'
, lastRemovedDigit = vvRem
, vuIsTrailingZeros = vuIsTrailingZeros d && vuRem == 0
, vvIsTrailingZeros = vvIsTrailingZeros d && lastRemovedDigit d == 0
}
| Bool
otherwise = (BoundsState a
d, b
0)
where
!(a
vv', a
vvRem) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem10 (a -> (a, a)) -> a -> (a, a)
forall a b. (a -> b) -> a -> b
$ BoundsState a -> a
forall a. BoundsState a -> a
vv BoundsState a
d
!(a
vu', a
vuRem) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem10 (a -> (a, a)) -> a -> (a, a)
forall a b. (a -> b) -> a -> b
$ BoundsState a -> a
forall a. BoundsState a -> a
vu BoundsState a
d
!(a
vw', a
_ ) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem10 (a -> (a, a)) -> a -> (a, a)
forall a b. (a -> b) -> a -> b
$ BoundsState a -> a
forall a. BoundsState a -> a
vw BoundsState a
d
trimTrailing'' :: BoundsState a -> (BoundsState a, b)
trimTrailing'' !BoundsState a
d
| a
vuRem a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 =
(b -> b) -> (BoundsState a, b) -> (BoundsState a, b)
forall a b. (a -> b) -> (BoundsState a, a) -> (BoundsState a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b -> b
forall a. Num a => a -> a -> a
(+) b
1) ((BoundsState a, b) -> (BoundsState a, b))
-> (BoundsState a -> (BoundsState a, b))
-> BoundsState a
-> (BoundsState a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundsState a -> (BoundsState a, b)
trimTrailing'' (BoundsState a -> (BoundsState a, b))
-> BoundsState a -> (BoundsState a, b)
forall a b. (a -> b) -> a -> b
$
BoundsState a
d { vu = vu'
, vv = vv'
, vw = vw'
, lastRemovedDigit = vvRem
, vvIsTrailingZeros = vvIsTrailingZeros d && lastRemovedDigit d == 0
}
| Bool
otherwise = (BoundsState a
d, b
0)
where
!(a
vu', a
vuRem) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem10 (a -> (a, a)) -> a -> (a, a)
forall a b. (a -> b) -> a -> b
$ BoundsState a -> a
forall a. BoundsState a -> a
vu BoundsState a
d
!(a
vv', a
vvRem) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem10 (a -> (a, a)) -> a -> (a, a)
forall a b. (a -> b) -> a -> b
$ BoundsState a -> a
forall a. BoundsState a -> a
vv BoundsState a
d
!(a
vw', a
_ ) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem10 (a -> (a, a)) -> a -> (a, a)
forall a b. (a -> b) -> a -> b
$ BoundsState a -> a
forall a. BoundsState a -> a
vw BoundsState a
d
trimNoTrailing :: Mantissa a => BoundsState a -> (BoundsState a, Int32)
trimNoTrailing :: forall a. Mantissa a => BoundsState a -> (BoundsState a, Int32)
trimNoTrailing !(BoundsState a
u a
v a
w a
ld Bool
_ Bool
_) =
(a -> a -> a -> a -> Bool -> Bool -> BoundsState a
forall a. a -> a -> a -> a -> Bool -> Bool -> BoundsState a
BoundsState a
ru' a
rv' a
0 a
ld' Bool
False Bool
False, Int32
c)
where
!(a
ru', a
rv', a
ld', Int32
c) = a -> a -> a -> a -> Int32 -> (a, a, a, Int32)
forall {a} {c} {d}.
(Mantissa a, Mantissa c, Num d) =>
a -> c -> a -> c -> d -> (a, c, c, d)
trimNoTrailing' a
u a
v a
w a
ld Int32
0
trimNoTrailing' :: a -> c -> a -> c -> d -> (a, c, c, d)
trimNoTrailing' a
u' c
v' a
w' c
lastRemoved d
count
| a
vw' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
vu' =
a -> c -> a -> c -> d -> (a, c, c, d)
trimNoTrailing'' a
vu' c
vv' a
vw' (c -> c
forall a. Mantissa a => a -> a
quot10 (c
v' c -> c -> c
forall a. Num a => a -> a -> a
- (c
vv' c -> c -> c
forall a. Num a => a -> a -> a
* c
100))) (d
count d -> d -> d
forall a. Num a => a -> a -> a
+ d
2)
| Bool
otherwise =
a -> c -> a -> c -> d -> (a, c, c, d)
trimNoTrailing'' a
u' c
v' a
w' c
lastRemoved d
count
where
!vw' :: a
vw' = a -> a
forall a. Mantissa a => a -> a
quot100 a
w'
!vu' :: a
vu' = a -> a
forall a. Mantissa a => a -> a
quot100 a
u'
!vv' :: c
vv' = c -> c
forall a. Mantissa a => a -> a
quot100 c
v'
trimNoTrailing'' :: a -> c -> a -> c -> d -> (a, c, c, d)
trimNoTrailing'' a
u' c
v' a
w' c
lastRemoved d
count
| a
vw' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
vu' = a -> c -> a -> c -> d -> (a, c, c, d)
trimNoTrailing' a
vu' c
vv' a
vw' c
lastRemoved' (d
count d -> d -> d
forall a. Num a => a -> a -> a
+ d
1)
| Bool
otherwise = (a
u', c
v', c
lastRemoved, d
count)
where
!(c
vv', c
lastRemoved') = c -> (c, c)
forall a. Mantissa a => a -> (a, a)
quotRem10 c
v'
!vu' :: a
vu' = a -> a
forall a. Mantissa a => a -> a
quot10 a
u'
!vw' :: a
vw' = a -> a
forall a. Mantissa a => a -> a
quot10 a
w'
{-# INLINE closestCorrectlyRounded #-}
closestCorrectlyRounded :: Mantissa a => Bool -> BoundsState a -> a
closestCorrectlyRounded :: forall a. Mantissa a => Bool -> BoundsState a -> a
closestCorrectlyRounded Bool
acceptBound BoundsState a
s = BoundsState a -> a
forall a. BoundsState a -> a
vv BoundsState a
s a -> a -> a
forall a. Num a => a -> a -> a
+ Bool -> a
forall a. Mantissa a => Bool -> a
boolToWord Bool
roundUp
where
outsideBounds :: Bool
outsideBounds = Bool -> Bool
not (BoundsState a -> Bool
forall a. BoundsState a -> Bool
vuIsTrailingZeros BoundsState a
s) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
acceptBound
roundUp :: Bool
roundUp = (BoundsState a -> a
forall a. BoundsState a -> a
vv BoundsState a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== BoundsState a -> a
forall a. BoundsState a -> a
vu BoundsState a
s Bool -> Bool -> Bool
&& Bool
outsideBounds) Bool -> Bool -> Bool
|| BoundsState a -> a
forall a. BoundsState a -> a
lastRemovedDigit BoundsState a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
5
asciiRaw :: Int -> Word#
asciiRaw :: Int -> Word#
asciiRaw (I# Int#
i) = Int# -> Word#
int2Word# Int#
i
asciiZero :: Int
asciiZero :: Int
asciiZero = Char -> Int
ord Char
'0'
asciiDot :: Int
asciiDot :: Int
asciiDot = Char -> Int
ord Char
'.'
asciiMinus :: Int
asciiMinus :: Int
asciiMinus = Char -> Int
ord Char
'-'
ascii_e :: Int
ascii_e :: Int
ascii_e = Char -> Int
ord Char
'e'
toAscii :: Word# -> Word#
toAscii :: Word# -> Word#
toAscii Word#
a = Word#
a Word# -> Word# -> Word#
`plusWord#` Int -> Word#
asciiRaw Int
asciiZero
{-# INLINE getWord64At #-}
getWord64At :: Ptr Word64 -> Int -> Word64
getWord64At :: Ptr Word64 -> Int -> Word64
getWord64At (Ptr Addr#
arr) (I# Int#
i) = WORD64 -> Word64
W64# (Addr# -> Int# -> WORD64
indexWord64OffAddr# Addr#
arr Int#
i)
{-# INLINE getWord128At #-}
getWord128At :: Ptr Word64 -> Int -> (Word64, Word64)
getWord128At :: Ptr Word64 -> Int -> (Word64, Word64)
getWord128At (Ptr Addr#
arr) (I# Int#
i) = let
!hi :: Word64
hi = WORD64 -> Word64
W64# (Addr# -> Int# -> WORD64
indexWord64OffAddr# Addr#
arr (Int#
i Int# -> Int# -> Int#
*# Int#
2# Int# -> Int# -> Int#
+# Int#
1#))
!lo :: Word64
lo = WORD64 -> Word64
W64# (Addr# -> Int# -> WORD64
indexWord64OffAddr# Addr#
arr (Int#
i Int# -> Int# -> Int#
*# Int#
2#))
in (Word64
hi, Word64
lo)
packWord16 :: Word# -> Word# -> Word#
packWord16 :: Word# -> Word# -> Word#
packWord16 Word#
l Word#
h = case ByteOrder
hostByteOrder of
ByteOrder
BigEndian ->
(Word#
h Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
8#) Word# -> Word# -> Word#
`or#` Word#
l
ByteOrder
LittleEndian ->
(Word#
l Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
8#) Word# -> Word# -> Word#
`or#` Word#
h
unpackWord16 :: Word# -> (# Word#, Word# #)
unpackWord16 :: Word# -> (# Word#, Word# #)
unpackWord16 Word#
w = case ByteOrder
hostByteOrder of
ByteOrder
BigEndian ->
(# Word#
w Word# -> Word# -> Word#
`and#` Word#
0xff##, Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
8# #)
ByteOrder
LittleEndian ->
(# Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
8#, Word#
w Word# -> Word# -> Word#
`and#` Word#
0xff## #)
digit_table :: Ptr Word16
digit_table :: Ptr Word16
digit_table =
#if PURE_HASKELL
castPtr Pure.digit_pairs_table
#else
Ptr CChar -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
c_digit_pairs_table
foreign import ccall "&hs_bytestring_digit_pairs_table"
c_digit_pairs_table :: Ptr CChar
#endif
unsafeAt :: Ptr Word16 -> Int# -> Word#
unsafeAt :: Ptr Word16 -> Int# -> Word#
unsafeAt (Ptr Addr#
a) Int#
i =
#if __GLASGOW_HASKELL__ >= 902
Word16# -> Word#
word16ToWord# (Addr# -> Int# -> Word16#
indexWord16OffAddr# Addr#
a Int#
i)
#else
indexWord16OffAddr# a i
#endif
copyWord16 :: Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 :: Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 Word#
w Addr#
a State# RealWorld
s = let
#if __GLASGOW_HASKELL__ >= 902
w16 :: Word16#
w16 = Word# -> Word16#
wordToWord16# Word#
w
#else
w16 = w
#endif
in case IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (Word16 -> Ptr Word8 -> IO ()
unalignedWriteU16 (Word16# -> Word16
W16# Word16#
w16) (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
a)) State# RealWorld
s of
(# State# RealWorld
s', ()
_ #) -> State# RealWorld
s'
poke :: Addr# -> Word# -> State# d -> State# d
poke :: forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
a Word#
w State# d
s =
#if __GLASGOW_HASKELL__ >= 902
Addr# -> Int# -> Word8# -> State# d -> State# d
forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
a Int#
0# (Word# -> Word8#
wordToWord8# Word#
w) State# d
s
#else
writeWord8OffAddr# a 0# w s
#endif
{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word32 -> State# RealWorld -> (# Addr#, State# RealWorld #) #-}
{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word64 -> State# RealWorld -> (# Addr#, State# RealWorld #) #-}
writeMantissa :: forall a. (Mantissa a) => Addr# -> Int# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
writeMantissa :: forall a.
Mantissa a =>
Addr#
-> Int# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
writeMantissa Addr#
ptr Int#
olength = Addr# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
forall {a}.
Mantissa a =>
Addr# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
go (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
olength)
where
go :: Addr# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
go Addr#
p a
mantissa State# RealWorld
s1
| a
mantissa a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10000 =
let !(a
m', a
c) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem10000 a
mantissa
!(a
c1, a
c0) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem100 a
c
s2 :: State# RealWorld
s2 = Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 (Ptr Word16
digit_table Ptr Word16 -> Int# -> Word#
`unsafeAt` Word# -> Int#
word2Int# (a -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw a
c0)) (Addr#
p Addr# -> Int# -> Addr#
`plusAddr#` (Int#
-1#)) State# RealWorld
s1
s3 :: State# RealWorld
s3 = Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 (Ptr Word16
digit_table Ptr Word16 -> Int# -> Word#
`unsafeAt` Word# -> Int#
word2Int# (a -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw a
c1)) (Addr#
p Addr# -> Int# -> Addr#
`plusAddr#` (Int#
-3#)) State# RealWorld
s2
in Addr# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
go (Addr#
p Addr# -> Int# -> Addr#
`plusAddr#` (Int#
-4#)) a
m' State# RealWorld
s3
| a
mantissa a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
100 =
let !(a
m', a
c) = a -> (a, a)
forall a. Mantissa a => a -> (a, a)
quotRem100 a
mantissa
s2 :: State# RealWorld
s2 = Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 (Ptr Word16
digit_table Ptr Word16 -> Int# -> Word#
`unsafeAt` Word# -> Int#
word2Int# (a -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw a
c)) (Addr#
p Addr# -> Int# -> Addr#
`plusAddr#` (Int#
-1#)) State# RealWorld
s1
in a -> State# RealWorld -> (# Addr#, State# RealWorld #)
forall {a}.
Mantissa a =>
a -> State# RealWorld -> (# Addr#, State# RealWorld #)
finalize a
m' State# RealWorld
s2
| Bool
otherwise = a -> State# RealWorld -> (# Addr#, State# RealWorld #)
forall {a}.
Mantissa a =>
a -> State# RealWorld -> (# Addr#, State# RealWorld #)
finalize a
mantissa State# RealWorld
s1
finalize :: a -> State# RealWorld -> (# Addr#, State# RealWorld #)
finalize a
mantissa State# RealWorld
s1
| a
mantissa a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10 =
let !bs :: Word#
bs = Ptr Word16
digit_table Ptr Word16 -> Int# -> Word#
`unsafeAt` Word# -> Int#
word2Int# (a -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw a
mantissa)
!(# Word#
lsb, Word#
msb #) = Word# -> (# Word#, Word# #)
unpackWord16 Word#
bs
s2 :: State# RealWorld
s2 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#) Word#
lsb State# RealWorld
s1
s3 :: State# RealWorld
s3 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) (Int -> Word#
asciiRaw Int
asciiDot) State# RealWorld
s2
s4 :: State# RealWorld
s4 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
ptr Word#
msb State# RealWorld
s3
in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` (Int#
olength Int# -> Int# -> Int#
+# Int#
1#), State# RealWorld
s4 #)
| (Int# -> Int
I# Int#
olength) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 =
let s2 :: State# RealWorld
s2 = Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 (Word# -> Word# -> Word#
packWord16 (Int -> Word#
asciiRaw Int
asciiDot) (Word# -> Word#
toAscii (a -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw a
mantissa))) Addr#
ptr State# RealWorld
s1
in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` (Int#
olength Int# -> Int# -> Int#
+# Int#
1#), State# RealWorld
s2 #)
| Bool
otherwise =
let s2 :: State# RealWorld
s2 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#) (Int -> Word#
asciiRaw Int
asciiZero) State# RealWorld
s1
s3 :: State# RealWorld
s3 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) (Int -> Word#
asciiRaw Int
asciiDot) State# RealWorld
s2
s4 :: State# RealWorld
s4 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
ptr (Word# -> Word#
toAscii (a -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw a
mantissa)) State# RealWorld
s3
in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
3#, State# RealWorld
s4 #)
writeExponent :: Addr# -> Int32 -> State# RealWorld -> (# Addr#, State# RealWorld #)
writeExponent :: Addr# -> Int32 -> State# RealWorld -> (# Addr#, State# RealWorld #)
writeExponent Addr#
ptr !Int32
expo State# RealWorld
s1
| Int32
expo Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
100 =
let !(Word32
e1, Word32
e0) = Word32 -> (Word32, Word32)
fquotRem10 (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
expo)
s2 :: State# RealWorld
s2 = Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 (Ptr Word16
digit_table Ptr Word16 -> Int# -> Word#
`unsafeAt` Word# -> Int#
word2Int# (Word32 -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw Word32
e1)) Addr#
ptr State# RealWorld
s1
s3 :: State# RealWorld
s3 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#) (Word# -> Word#
toAscii (Word32 -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw Word32
e0)) State# RealWorld
s2
in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
3#, State# RealWorld
s3 #)
| Int32
expo Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
10 =
let s2 :: State# RealWorld
s2 = Word# -> Addr# -> State# RealWorld -> State# RealWorld
copyWord16 (Ptr Word16
digit_table Ptr Word16 -> Int# -> Word#
`unsafeAt` Int#
e) Addr#
ptr State# RealWorld
s1
in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#, State# RealWorld
s2 #)
| Bool
otherwise =
let s2 :: State# RealWorld
s2 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
ptr (Word# -> Word#
toAscii (Int# -> Word#
int2Word# Int#
e)) State# RealWorld
s1
in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#, State# RealWorld
s2 #)
where !(I# Int#
e) = Int32 -> Int
int32ToInt Int32
expo
writeSign :: Addr# -> Bool -> State# d -> (# Addr#, State# d #)
writeSign :: forall d. Addr# -> Bool -> State# d -> (# Addr#, State# d #)
writeSign Addr#
ptr Bool
True State# d
s1 =
let s2 :: State# d
s2 = Addr# -> Word# -> State# d -> State# d
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
ptr (Int -> Word#
asciiRaw Int
asciiMinus) State# d
s1
in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#, State# d
s2 #)
writeSign Addr#
ptr Bool
False State# d
s = (# Addr#
ptr, State# d
s #)
{-# INLINABLE toCharsScientific #-}
{-# SPECIALIZE toCharsScientific :: Bool -> Word32 -> Int32 -> BoundedPrim () #-}
{-# SPECIALIZE toCharsScientific :: Bool -> Word64 -> Int32 -> BoundedPrim () #-}
toCharsScientific :: (Mantissa a) => Bool -> a -> Int32 -> BoundedPrim ()
!Bool
sign !a
mantissa !Int32
expo = Int -> (() -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim ()
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boundedPrim Int
maxEncodedLength ((() -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim ())
-> (() -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim ()
forall a b. (a -> b) -> a -> b
$ \()
_ !(Ptr Addr#
p0)-> do
let !olength :: Int
olength@(I# Int#
ol) = a -> Int
forall a. Mantissa a => a -> Int
decimalLength a
mantissa
!expo' :: Int32
expo' = Int32
expo Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int -> Int32
intToInt32 Int
olength Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1
(State# RealWorld -> (# State# RealWorld, Ptr Word8 #))
-> IO (Ptr Word8)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Ptr Word8 #))
-> IO (Ptr Word8))
-> (State# RealWorld -> (# State# RealWorld, Ptr Word8 #))
-> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 ->
let !(# Addr#
p1, State# RealWorld
s2 #) = Addr# -> Bool -> State# RealWorld -> (# Addr#, State# RealWorld #)
forall d. Addr# -> Bool -> State# d -> (# Addr#, State# d #)
writeSign Addr#
p0 Bool
sign State# RealWorld
s1
!(# Addr#
p2, State# RealWorld
s3 #) = Addr#
-> Int# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
forall a.
Mantissa a =>
Addr#
-> Int# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #)
writeMantissa Addr#
p1 Int#
ol a
mantissa State# RealWorld
s2
s4 :: State# RealWorld
s4 = Addr# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
p2 (Int -> Word#
asciiRaw Int
ascii_e) State# RealWorld
s3
!(# Addr#
p3, State# RealWorld
s5 #) = Addr# -> Bool -> State# RealWorld -> (# Addr#, State# RealWorld #)
forall d. Addr# -> Bool -> State# d -> (# Addr#, State# d #)
writeSign (Addr#
p2 Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) (Int32
expo' Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0) State# RealWorld
s4
!(# Addr#
p4, State# RealWorld
s6 #) = Addr# -> Int32 -> State# RealWorld -> (# Addr#, State# RealWorld #)
writeExponent Addr#
p3 (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
expo') State# RealWorld
s5
in (# State# RealWorld
s6, (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
p4) #)