{-# LANGUAGE ScopedTypeVariables, ExplicitForAll #-}
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
-- |
-- Module      : Data.ByteString.Builder.RealFloat.Internal
-- Copyright   : (c) Lawrence Wu 2021
-- License     : BSD-style
-- Maintainer  : lawrencejwu@gmail.com
--
-- Various floating-to-string conversion helpers that are somewhat
-- floating-size agnostic
--
-- This module includes
--
-- - Efficient formatting for scientific floating-to-string
-- - Trailing zero handling when converting to decimal power base
-- - Approximations for logarithms of powers
-- - Fast-division by reciprocal multiplication
-- - Prim-op bit-wise peek

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
    -- hand-rolled division and remainder for f2s and d2s
    , fquot10
    , frem10
    , fquot5
    , frem5
    , dquot10
    , dquotRem10
    , dquot5
    , drem5
    , dquot100
    -- prim-op helpers
    , timesWord2
    , Addr(..)
    , ByteArray(..)
    , castDoubleToWord64
    , castFloatToWord32
    , getWord64At
    , getWord128At
    -- monomorphic conversions
    , 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.Char (ord)
import GHC.Int (Int(..), Int32(..))
import GHC.Prim
import GHC.Ptr (Ptr(..), plusPtr)
import GHC.ST (ST(..), runST)
import GHC.Types (isTrue#)
import GHC.Word (Word8, 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

#if __GLASGOW_HASKELL__ >= 804
import GHC.Float (castFloatToWord32, castDoubleToWord64)
#else
import System.IO.Unsafe (unsafePerformIO)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (castPtr)
import Foreign.Storable (peek)

-- | Interpret a 'Float' as a 'Word32' as if through a bit-for-bit copy.
-- (fallback if not available through GHC.Float)
--
-- e.g
--
-- > showHex (castFloatToWord32 1.0) [] = "3f800000"
{-# NOINLINE castFloatToWord32 #-}
castFloatToWord32 :: Float -> Word32
castFloatToWord32 x = unsafePerformIO (with x (peek . castPtr))

-- | Interpret a 'Double' as a 'Word64' as if through a bit-for-bit copy.
-- (fallback if not available through GHC.Float)
--
-- e.g
--
-- > showHex (castDoubleToWord64 1.0) [] = "3ff0000000000000"
{-# NOINLINE castDoubleToWord64 #-}
castDoubleToWord64 :: Double -> Word64
castDoubleToWord64 x = unsafePerformIO (with x (peek . castPtr))
#endif

-- | Build a full bit-mask of specified length.
--
-- e.g
--
-- > showHex (mask 12) [] = "fff"
{-# 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

-- | Convert boolean false to 0 and true to 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

-- | Convert boolean false to 0 and true to 1
{-# 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

-- | Monomorphic conversion for @Int32 -> Int@
{-# INLINABLE int32ToInt #-}
int32ToInt :: Int32 -> Int
int32ToInt :: Int32 -> Int
int32ToInt = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Monomorphic conversion for @Int -> Int32@
{-# INLINABLE intToInt32 #-}
intToInt32 :: Int -> Int32
intToInt32 :: Int -> Int32
intToInt32 = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Monomorphic conversion for @Word32 -> Int@
{-# INLINABLE word32ToInt #-}
word32ToInt :: Word32 -> Int
word32ToInt :: Word32 -> Int
word32ToInt = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Monomorphic conversion for @Word64 -> Int@
{-# INLINABLE word64ToInt #-}
word64ToInt :: Word64 -> Int
word64ToInt :: Word64 -> Int
word64ToInt = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Monomorphic conversion for @Word32 -> Word64@
{-# INLINABLE word32ToWord64 #-}
word32ToWord64 :: Word32 -> Word64
word32ToWord64 :: Word32 -> Word64
word32ToWord64 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Monomorphic conversion for @Word64 -> Word32@
{-# INLINABLE word64ToWord32 #-}
word64ToWord32 :: Word64 -> Word32
word64ToWord32 :: Word64 -> Word32
word64ToWord32 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- | Returns the number of decimal digits in v, which must not contain more than 9 digits.
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

-- | Returns the number of decimal digits in v, which must not contain more than 17 digits.
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

-- From 'In-and-Out Conversions' https://dl.acm.org/citation.cfm?id=362887, we
-- have that a conversion from a base-b n-digit number to a base-v m-digit
-- number such that the round-trip conversion is identity requires
--
--    v^(m-1) > b^n
--
-- Specifically for binary floating point to decimal conversion, we must have
--
--    10^(m-1) > 2^n
-- => log(10^(m-1)) > log(2^n)
-- => (m-1) * log(10) > n * log(2)
-- => m-1 > n * log(2) / log(10)
-- => m-1 >= ceil(n * log(2) / log(10))
-- => m >= ceil(n * log(2) / log(10)) + 1
--
-- And since 32 and 64-bit floats have 23 and 52 bits of mantissa (and then an
-- implicit leading-bit), we need
--
--    ceil(24 * log(2) / log(10)) + 1 => 9
--    ceil(53 * log(2) / log(10)) + 1 => 17
--
-- In addition, the exponent range from floats is [-45,38] and doubles is
-- [-324,308] (including subnormals) which are 3 and 4 digits respectively
--
-- Thus we have,
--
--    floats: 1 (sign) + 9 (mantissa) + 1 (.) + 1 (e) + 3 (exponent) = 15
--    doubles: 1 (sign) + 17 (mantissa) + 1 (.) + 1 (e) + 4 (exponent) = 24
--
maxEncodedLength :: Int
maxEncodedLength :: Int
maxEncodedLength = Int
32

-- | Storable.poke a String into a Ptr Word8, converting through c2w
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)

-- | Unsafe creation of a bounded primitive of String at most length
-- `maxEncodedLength`
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)

-- | Special rendering for NaN, positive\/negative 0, and positive\/negative
-- infinity. These are based on the IEEE representation of non-numbers.
--
-- Infinity
--
--   * sign = 0 for positive infinity, 1 for negative infinity.
--   * biased exponent = all 1 bits.
--   * fraction = all 0 bits.
--
-- NaN
--
--   * sign = either 0 or 1 (ignored)
--   * biased exponent = all 1 bits.
--   * fraction = anything except all 0 bits.
--
-- We also handle 0 specially here so that the exponent rendering is more
-- correct.
--
--   * sign = either 0 or 1.
--   * biased exponent = all 0 bits.
--   * fraction = all 0 bits.
data NonNumbersAndZero = NonNumbersAndZero
  { NonNumbersAndZero -> Bool
negative :: Bool
  , NonNumbersAndZero -> Bool
exponent_all_one :: Bool
  , NonNumbersAndZero -> Bool
mantissa_non_zero :: Bool
  }

-- | Renders NonNumbersAndZero into bounded primitive
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
""

-- | Part of the calculation on whether to round up the decimal representation.
-- This is currently a constant function to match behavior in Base `show` and
-- is implemented as
--
-- @
-- acceptBounds _ = False
-- @
--
-- For round-to-even and correct shortest, use
--
-- @
-- acceptBounds v = ((v \`quot\` 4) .&. 1) == 0
-- @
acceptBounds :: Mantissa a => a -> Bool
acceptBounds :: forall a. Mantissa a => a -> Bool
acceptBounds a
_ = Bool
False

-------------------------------------------------------------------------------
-- Logarithm Approximations
--
-- These are based on the same transformations.
--
-- e.g
--
--      log_2(5^e)                              goal function
--    = e * log_2(5)                            log exponenation
--   ~= e * floor(10^7 * log_2(5)) / 10^7       integer operations
--   ~= e * 1217359 / 2^19                      approximation into n / 2^m
--
-- These are verified in the unit tests for the given input ranges
-------------------------------------------------------------------------------

-- | Returns e == 0 ? 1 : ceil(log_2(5^e)); requires 0 <= e <= 3528.
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#

-- | Returns floor(log_10(2^e)); requires 0 <= e <= 1650.
log10pow2Unboxed :: Int# -> Int#
log10pow2Unboxed :: Int# -> Int#
log10pow2Unboxed Int#
e = (Int#
e Int# -> Int# -> Int#
*# Int#
78913#) Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
18#

-- | Returns floor(log_10(5^e)); requires 0 <= e <= 2620.
log10pow5Unboxed :: Int# -> Int#
log10pow5Unboxed :: Int# -> Int#
log10pow5Unboxed Int#
e = (Int#
e Int# -> Int# -> Int#
*# Int#
732923#) Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
20#

-- | Boxed versions of the functions above
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

-------------------------------------------------------------------------------
-- Fast Division
--
-- Division is slow. We leverage fixed-point arithmetic to calculate division
-- by a constant as multiplication by the inverse. This could potentially be
-- handled by an aggressive compiler, but to ensure that the optimization
-- happens, we hard-code the expected divisions / remainders by 5, 10, 100, etc
--
-- e.g
--
--     x / 5                                      goal function
--   = x * (1 / 5)                                reciprocal
--   = x * (4 / 5) / 4
--   = x * 0b0.110011001100.. / 4                 recurring binary representation
--  ~= x * (0xCCCCCCCD / 2^32) / 4                approximation with integers
--   = (x * 0xCCCCCCCD) >> 34
--
-- Look for `Reciprocal Multiplication, a tutorial` by Douglas W. Jones for a
-- more detailed explanation.
-------------------------------------------------------------------------------

-- | Returns @w / 10@
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)

-- | Returns @w % 10@
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

-- | Returns @(w / 10, w % 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)

-- | Returns @w / 100@
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)

-- | Returns @(w / 10000, w % 10000)@
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)

-- | Returns @w / 5@
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)

-- | Returns @w % 5@
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

-- | Returns @w / 10@
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

-- | Returns @w / 100@
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

-- | Returns @(w / 10000, w % 10000)@
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)

-- | Returns @(w / 10, w % 10)@
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)

-- | Returns @w / 5@
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

-- | Returns @w % 5@
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

-- | Returns @(w / 5, w % 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)

-- | Wrap a unboxed function on Int# into the boxed equivalent
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
-- | Packs 2 32-bit system words (hi, lo) into a Word64
packWord64 :: Word# -> Word# -> Word64#
packWord64 hi lo =
#if defined(WORDS_BIGENDIAN)
    ((wordToWord64# lo) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# hi)
#else
    ((wordToWord64# hi) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# lo)
#endif

-- | Unpacks a Word64 into 2 32-bit words (hi, lo)
unpackWord64 :: Word64# -> (# Word#, Word# #)
unpackWord64 w =
#if defined(WORDS_BIGENDIAN)
    (# word64ToWord# w
     , word64ToWord# (w `uncheckedShiftRL64#` 32#)
     #)
#else
    (# word64ToWord# (w `uncheckedShiftRL64#` 32#)
     , word64ToWord# w
     #)
#endif

-- | Adds 2 Word64's with 32-bit addition and manual carrying
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

-- | Boxed version of `timesWord2#` for 64 bits
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

      --          x1 x0
      --  X       y1 y0
      --  -------------
      --             00  LOW PART
      --  -------------
      --          00
      --       10 10     MIDDLE PART
      --  +       01
      --  -------------
      --       01
      --  + 11 11        HIGH PART
      --  -------------

      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)

-- | #ifdef for 64-bit word that seems to work on both 32- and 64-bit platforms
type WORD64 =
#if WORD_SIZE_IN_BITS < 64 || __GLASGOW_HASKELL__ >= 903
  Word64#
#else
  Word#
#endif

-- | Returns the number of times @w@ is divisible by @5@
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#)

-- | Returns @True@ if value is divisible by @5^p@
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)

-- | Returns @True@ if value is divisible by @2^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

-- | Wrapper for polymorphic handling of 32- and 64-bit floats
class (FiniteBits a, Integral a) => Mantissa a where
  -- NB: might truncate!
  -- Use this when we know the value fits in 32-bits
  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

-- | Bookkeeping state for finding the shortest, correctly-rounded
-- representation. The same trimming algorithm is similar enough for 32- and
-- 64-bit floats
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
    }

-- | Trim digits and update bookkeeping state when the table-computed
-- step results in trailing zeros (the general case, happens rarely)
--
-- NB: This function isn't actually necessary so long as acceptBounds is always
-- @False@ since we don't do anything different with the trailing-zero
-- information directly:
-- - vuIsTrailingZeros is always False.  We can see this by noting that in all
--   places where vuTrailing can possible be True, we must have acceptBounds be
--   True (accept_smaller)
-- - The final result doesn't change the lastRemovedDigit for rounding anyway
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
             -- set `{ lastRemovedDigit = 4 }` to round-even
             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 :: a
vu = a
vu'
            , vv :: a
vv = a
vv'
            , vw :: a
vw = a
vw'
            , lastRemovedDigit :: a
lastRemovedDigit = a
vvRem
            , vuIsTrailingZeros :: Bool
vuIsTrailingZeros = BoundsState a -> Bool
forall a. BoundsState a -> Bool
vuIsTrailingZeros BoundsState a
d Bool -> Bool -> Bool
&& a
vuRem a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
            , vvIsTrailingZeros :: Bool
vvIsTrailingZeros = 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
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 :: a
vu = a
vu'
            , vv :: a
vv = a
vv'
            , vw :: a
vw = a
vw'
            , lastRemovedDigit :: a
lastRemovedDigit = a
vvRem
            , vvIsTrailingZeros :: Bool
vvIsTrailingZeros = 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
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


-- | Trim digits and update bookkeeping state when the table-computed
-- step results has no trailing zeros (common case)
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
      -- Loop iterations below (approximately), without div 100 optimization:
      -- 0: 0.03%, 1: 13.8%, 2: 70.6%, 3: 14.0%, 4: 1.40%, 5: 0.14%, 6+: 0.02%
      -- Loop iterations below (approximately), with div 100 optimization:
      -- 0: 70.6%, 1: 27.8%, 2: 1.40%, 3: 0.14%, 4+: 0.02%
      | 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'

-- | Returns the correctly rounded decimal representation mantissa based on if
-- we need to round up (next decimal place >= 5) or if we are outside the
-- bounds
{-# 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

-- Wrappe around int2Word#
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'

-- | Convert a single-digit number to the ascii ordinal e.g '1' -> 0x31
toAscii :: Word# -> Word#
toAscii :: Word# -> Word#
toAscii Word#
a = Word#
a Word# -> Word# -> Word#
`plusWord#` Int -> Word#
asciiRaw Int
asciiZero

data Addr = Addr Addr#

-- | Index into the 64-bit word lookup table provided
{-# INLINE getWord64At #-}
getWord64At :: Addr# -> Int -> Word64
getWord64At :: Addr# -> Int -> Word64
getWord64At Addr#
arr (I# Int#
i) =
#if defined(WORDS_BIGENDIAN)
   W64# (byteSwap64# (indexWord64OffAddr# arr i))
#else
   WORD64 -> Word64
W64# (Addr# -> Int# -> WORD64
indexWord64OffAddr# Addr#
arr Int#
i)
#endif

-- | Index into the 128-bit word lookup table provided
-- Return (# high-64-bits , low-64-bits #)
-- NB: really just swaps the bytes and doesn't reorder the words
{-# INLINE getWord128At #-}
getWord128At :: Addr# -> Int -> (Word64, Word64)
getWord128At :: Addr# -> Int -> (Word64, Word64)
getWord128At Addr#
arr (I# Int#
i) =
#if defined(WORDS_BIGENDIAN)
   ( W64# (byteSwap64# (indexWord64OffAddr# arr (i *# 2# +# 1#)))
   , W64# (byteSwap64# (indexWord64OffAddr# arr (i *# 2#)))
   )
#else
   ( WORD64 -> Word64
W64# (Addr# -> Int# -> WORD64
indexWord64OffAddr# Addr#
arr (Int#
i Int# -> Int# -> Int#
*# Int#
2# Int# -> Int# -> Int#
+# Int#
1#))
   , WORD64 -> Word64
W64# (Addr# -> Int# -> WORD64
indexWord64OffAddr# Addr#
arr (Int#
i Int# -> Int# -> Int#
*# Int#
2#))
   )
#endif


data ByteArray = ByteArray ByteArray#

-- | Packs 2 bytes [lsb, msb] into 16-bit word
packWord16 :: Word# -> Word# -> Word#
packWord16 :: Word# -> Word# -> Word#
packWord16 Word#
l Word#
h =
#if defined(WORDS_BIGENDIAN)
    (h `uncheckedShiftL#` 8#) `or#` l
#else
    (Word#
l Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
8#) Word# -> Word# -> Word#
`or#` Word#
h
#endif

-- | Unpacks a 16-bit word into 2 bytes [lsb, msb]
unpackWord16 :: Word# -> (# Word#, Word# #)
unpackWord16 :: Word# -> (# Word#, Word# #)
unpackWord16 Word#
w =
#if defined(WORDS_BIGENDIAN)
    (# w `and#` 0xff##, w `uncheckedShiftRL#` 8# #)
#else
    (# Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
8#, Word#
w Word# -> Word# -> Word#
`and#` Word#
0xff## #)
#endif


-- | ByteArray of 2-digit pairs 00..99 for faster ascii rendering
digit_table :: ByteArray
digit_table :: ByteArray
digit_table = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST (STRep s ByteArray -> ST s ByteArray
forall s a. STRep s a -> ST s a
ST (STRep s ByteArray -> ST s ByteArray)
-> STRep s ByteArray -> ST s ByteArray
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
  let !(# State# s
s2, MutableByteArray# s
marr #) = Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
200# State# s
s1
      go :: Word32
-> (Int# -> State# s -> State# s) -> Int# -> State# s -> State# s
go Word32
y Int# -> State# s -> State# s
r = \Int#
i State# s
s ->
        let !(Word32
h, Word32
l) = Word32 -> (Word32, Word32)
fquotRem10 Word32
y
            e' :: Word#
e' = Word# -> Word# -> Word#
packWord16 (Word# -> Word#
toAscii (Word32 -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw Word32
l)) (Word# -> Word#
toAscii (Word32 -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw Word32
h))
#if __GLASGOW_HASKELL__ >= 902
            s' :: State# s
s' = MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word16# -> State# d -> State# d
writeWord16Array# MutableByteArray# s
marr Int#
i (Word# -> Word16#
wordToWord16# Word#
e') State# s
s
#else
            s' = writeWord16Array# marr i e' s
#endif
         in if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
99#) then State# s
s' else Int# -> State# s -> State# s
r (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# s
s'
      !(# State# s
s3, ByteArray#
bs #) = MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
marr ((Word32
 -> (Int# -> State# s -> State# s) -> Int# -> State# s -> State# s)
-> (Int# -> State# s -> State# s)
-> [Word32]
-> Int#
-> State# s
-> State# s
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word32
-> (Int# -> State# s -> State# s) -> Int# -> State# s -> State# s
go (\Int#
_ State# s
s -> State# s
s) [Word32
0..Word32
99] Int#
0# State# s
s2)
   in (# State# s
s3, ByteArray# -> ByteArray
ByteArray ByteArray#
bs #))

-- | Unsafe index a ByteArray for the 16-bit word at the index
unsafeAt :: ByteArray -> Int# -> Word#
unsafeAt :: ByteArray -> Int# -> Word#
unsafeAt (ByteArray ByteArray#
bs) Int#
i =
#if __GLASGOW_HASKELL__ >= 902
    Word16# -> Word#
word16ToWord# (ByteArray# -> Int# -> Word16#
indexWord16Array# ByteArray#
bs Int#
i)
#else
    indexWord16Array# bs i
#endif

-- | Write a 16-bit word into the given address
copyWord16 :: Word# -> Addr# -> State# d -> State# d
copyWord16 :: forall d. Word# -> Addr# -> State# d -> State# d
copyWord16 Word#
w Addr#
a State# d
s =
#if __GLASGOW_HASKELL__ >= 902
    Addr# -> Int# -> Word16# -> State# d -> State# d
forall d. Addr# -> Int# -> Word16# -> State# d -> State# d
writeWord16OffAddr# Addr#
a Int#
0# (Word# -> Word16#
wordToWord16# Word#
w) State# d
s
#else
    writeWord16OffAddr# a 0# w s
#endif

-- | Write an 8-bit word into the given address
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

-- | Write the mantissa into the given address. This function attempts to
-- optimize this by writing pairs of digits simultaneously when the mantissa is
-- large enough
{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word32 -> State# d -> (# Addr#, State# d #) #-}
{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word64 -> State# d -> (# Addr#, State# d #) #-}
writeMantissa :: forall a d. (Mantissa a) => Addr# -> Int# -> a -> State# d -> (# Addr#, State# d #)
writeMantissa :: forall a d.
Mantissa a =>
Addr# -> Int# -> a -> State# d -> (# Addr#, State# d #)
writeMantissa Addr#
ptr Int#
olength = Addr# -> a -> State# d -> (# Addr#, State# d #)
forall {a} {d}.
Mantissa a =>
Addr# -> a -> State# d -> (# Addr#, State# d #)
go (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
olength)
  where
    go :: Addr# -> a -> State# d -> (# Addr#, State# d #)
go Addr#
p a
mantissa State# d
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# d
s2 = Word# -> Addr# -> State# d -> State# d
forall d. Word# -> Addr# -> State# d -> State# d
copyWord16 (ByteArray
digit_table ByteArray -> 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# d
s1
              s3 :: State# d
s3 = Word# -> Addr# -> State# d -> State# d
forall d. Word# -> Addr# -> State# d -> State# d
copyWord16 (ByteArray
digit_table ByteArray -> 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# d
s2
           in Addr# -> a -> State# d -> (# Addr#, State# d #)
go (Addr#
p Addr# -> Int# -> Addr#
`plusAddr#` (Int#
-4#)) a
m' State# d
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# d
s2 = Word# -> Addr# -> State# d -> State# d
forall d. Word# -> Addr# -> State# d -> State# d
copyWord16 (ByteArray
digit_table ByteArray -> 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# d
s1
           in a -> State# d -> (# Addr#, State# d #)
forall {a} {d}.
Mantissa a =>
a -> State# d -> (# Addr#, State# d #)
finalize a
m' State# d
s2
      | Bool
otherwise = a -> State# d -> (# Addr#, State# d #)
forall {a} {d}.
Mantissa a =>
a -> State# d -> (# Addr#, State# d #)
finalize a
mantissa State# d
s1
    finalize :: a -> State# d -> (# Addr#, State# d #)
finalize a
mantissa State# d
s1
      | a
mantissa a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10 =
        let !bs :: Word#
bs = ByteArray
digit_table ByteArray -> 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# d
s2 = Addr# -> Word# -> State# d -> State# d
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#) Word#
lsb State# d
s1
            s3 :: State# d
s3 = Addr# -> Word# -> State# d -> State# d
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) (Int -> Word#
asciiRaw Int
asciiDot) State# d
s2
            s4 :: State# d
s4 = Addr# -> Word# -> State# d -> State# d
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
ptr Word#
msb State# d
s3
           in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` (Int#
olength Int# -> Int# -> Int#
+# Int#
1#), State# d
s4 #)
      | (Int# -> Int
I# Int#
olength) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 =
          let s2 :: State# d
s2 = Word# -> Addr# -> State# d -> State# d
forall d. Word# -> Addr# -> State# d -> State# d
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# d
s1
           in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` (Int#
olength Int# -> Int# -> Int#
+# Int#
1#), State# d
s2 #)
      | Bool
otherwise =
          let s2 :: State# d
s2 = Addr# -> Word# -> State# d -> State# d
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#) (Int -> Word#
asciiRaw Int
asciiZero) State# d
s1
              s3 :: State# d
s3 = Addr# -> Word# -> State# d -> State# d
forall d. Addr# -> Word# -> State# d -> State# d
poke (Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) (Int -> Word#
asciiRaw Int
asciiDot) State# d
s2
              s4 :: State# d
s4 = Addr# -> Word# -> State# d -> State# d
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# d
s3
           in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
3#, State# d
s4 #)

-- | Write the exponent into the given address.
writeExponent :: Addr# -> Int32 -> State# d -> (# Addr#, State# d #)
writeExponent :: forall d. Addr# -> Int32 -> State# d -> (# Addr#, State# d #)
writeExponent Addr#
ptr !Int32
expo State# d
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) -- TODO
          s2 :: State# d
s2 = Word# -> Addr# -> State# d -> State# d
forall d. Word# -> Addr# -> State# d -> State# d
copyWord16 (ByteArray
digit_table ByteArray -> Int# -> Word#
`unsafeAt` Word# -> Int#
word2Int# (Word32 -> Word#
forall a. Mantissa a => a -> Word#
unsafeRaw Word32
e1)) Addr#
ptr State# d
s1
          s3 :: State# d
s3 = Addr# -> Word# -> State# d -> State# d
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# d
s2
       in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
3#, State# d
s3 #)
  | Int32
expo Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
10 =
      let s2 :: State# d
s2 = Word# -> Addr# -> State# d -> State# d
forall d. Word# -> Addr# -> State# d -> State# d
copyWord16 (ByteArray
digit_table ByteArray -> Int# -> Word#
`unsafeAt` Int#
e) Addr#
ptr State# d
s1
       in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#, State# d
s2 #)
  | Bool
otherwise =
      let s2 :: State# d
s2 = Addr# -> Word# -> State# d -> State# d
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
ptr (Word# -> Word#
toAscii (Int# -> Word#
int2Word# Int#
e)) State# d
s1
       in (# Addr#
ptr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#, State# d
s2 #)
  where !(I# Int#
e) = Int32 -> Int
int32ToInt Int32
expo

-- | Write the sign into the given address.
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 #)

-- | Returns the decimal representation of a floating point number in
-- scientific (exponential) notation
{-# INLINABLE toCharsScientific #-}
{-# SPECIALIZE toCharsScientific :: Bool -> Word32 -> Int32 -> BoundedPrim () #-}
{-# SPECIALIZE toCharsScientific :: Bool -> Word64 -> Int32 -> BoundedPrim () #-}
toCharsScientific :: (Mantissa a) => Bool -> a -> Int32 -> BoundedPrim ()
toCharsScientific :: forall a. Mantissa a => Bool -> a -> Int32 -> BoundedPrim ()
toCharsScientific !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
  Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (Ptr Word8)) -> Ptr Word8
forall a. (forall s. ST s a) -> a
runST (STRep s (Ptr Word8) -> ST s (Ptr Word8)
forall s a. STRep s a -> ST s a
ST (STRep s (Ptr Word8) -> ST s (Ptr Word8))
-> STRep s (Ptr Word8) -> ST s (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    let !(# Addr#
p1, State# s
s2 #) = Addr# -> Bool -> State# s -> (# Addr#, State# s #)
forall d. Addr# -> Bool -> State# d -> (# Addr#, State# d #)
writeSign Addr#
p0 Bool
sign State# s
s1
        !(# Addr#
p2, State# s
s3 #) = Addr# -> Int# -> a -> State# s -> (# Addr#, State# s #)
forall a d.
Mantissa a =>
Addr# -> Int# -> a -> State# d -> (# Addr#, State# d #)
writeMantissa Addr#
p1 Int#
ol a
mantissa State# s
s2
        s4 :: State# s
s4 = Addr# -> Word# -> State# s -> State# s
forall d. Addr# -> Word# -> State# d -> State# d
poke Addr#
p2 (Int -> Word#
asciiRaw Int
ascii_e) State# s
s3
        !(# Addr#
p3, State# s
s5 #) = Addr# -> Bool -> State# s -> (# Addr#, State# s #)
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# s
s4
        !(# Addr#
p4, State# s
s6 #) = Addr# -> Int32 -> State# s -> (# Addr#, State# s #)
forall d. Addr# -> Int32 -> State# d -> (# Addr#, State# d #)
writeExponent Addr#
p3 (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
expo') State# s
s5
     in (# State# s
s6, (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
p4) #))