{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}

-- | This module is designed to provide a shim for @blaze-textual@.
-- @blaze-textual@ does not support GHC 9. A PR has been opened to add that
-- support for GHC 9 here: https://github.com/bos/blaze-textual/pull/14
--
-- When GHC 9 support is merged in, we can delete the CPP in this and
-- re-export the blaze functions directly, which is what we do for older
-- versions of base.
module Database.MySQL.Internal.Blaze
    ( integral
    , double
    , float
    ) where

#if MIN_VERSION_base(4,15,0)

#define PAIR(a,b) (# a,b #)

import Blaze.ByteString.Builder (Builder, fromByteString)
import Blaze.ByteString.Builder.Char8 (fromChar)
import Data.ByteString.Char8 ()
import Data.Monoid (mappend, mconcat, mempty)
import qualified Data.Vector as V

import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char8
import Data.ByteString.Char8 ()
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Monoid (mappend, mempty)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import GHC.Base (quotInt, remInt)
import GHC.Num (quotRemInteger)
-- import GHC.Types (Int(..))

#if defined(INTEGER_GMP)
import GHC.Integer.GMP.Internals
#elif defined(INTEGER_SIMPLE)
import GHC.Integer.Simple.Internals
#endif

minus :: Builder
minus :: Builder
minus = Word8 -> Builder
fromWord8 Word8
45
data TInt = TInt !Integer !Int
putH :: [Integer] -> Builder
putH :: [Integer] -> Builder
putH (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
maxInt of
                PAIR(Integer
x,y)
                    | Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     -> Int -> Builder
int Int
q Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
pblock Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Integer] -> Builder
putB [Integer]
ns
                    | Bool
otherwise -> Int -> Builder
int Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Integer] -> Builder
putB [Integer]
ns
                    where q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x
                          r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y
putH [Integer]
_ = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"putH: the impossible happened"
int :: Int -> Builder
int :: Int -> Builder
int = Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE int #-}
fstT :: TInt -> Integer
fstT :: TInt -> Integer
fstT (TInt Integer
a Int
_) = Integer
a
maxInt :: Integer
maxDigits :: Int
TInt Integer
maxInt Int
maxDigits =
    (TInt -> Bool) -> (TInt -> TInt) -> TInt -> TInt
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
mi) (Integer -> Bool) -> (TInt -> Integer) -> TInt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
10) (Integer -> Integer) -> (TInt -> Integer) -> TInt -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TInt -> Integer
fstT) (\(TInt Integer
n Int
d) -> Integer -> Int -> TInt
TInt (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
10) (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) (Integer -> Int -> TInt
TInt Integer
10 Int
1)
  where mi :: Integer
mi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
integral :: (Integral a, Show a) => a -> Builder
{-# RULES "integral/Int" integral = bounded :: Int -> Builder #-}
{-# RULES "integral/Int8" integral = bounded :: Int8 -> Builder #-}
{-# RULES "integral/Int16" integral = bounded :: Int16 -> Builder #-}
{-# RULES "integral/Int32" integral = bounded :: Int32 -> Builder #-}
{-# RULES "integral/Int64" integral = bounded :: Int64 -> Builder #-}
{-# RULES "integral/Word" integral = nonNegative :: Word -> Builder #-}
{-# RULES "integral/Word8" integral = nonNegative :: Word8 -> Builder #-}
{-# RULES "integral/Word16" integral = nonNegative :: Word16 -> Builder #-}
{-# RULES "integral/Word32" integral = nonNegative :: Word32 -> Builder #-}
{-# RULES "integral/Word64" integral = nonNegative :: Word64 -> Builder #-}
{-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-}

-- This definition of the function is here PURELY to be used by ghci
-- and those rare cases where GHC is being invoked without
-- optimization, as otherwise the rewrite rules above should fire. The
-- test for "-0" catches an overflow if we render minBound.
integral :: forall a. (Integral a, Show a) => a -> Builder
integral a
i
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0                 = a -> Builder
forall a. Integral a => a -> Builder
nonNegative a
i
    | Builder -> ByteString
toByteString Builder
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"-0" = [Char] -> Builder
fromString (a -> [Char]
forall a. Show a => a -> [Char]
show a
i)
    | Bool
otherwise              = Builder
b
  where b :: Builder
b = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> Builder
forall a. Integral a => a -> Builder
nonNegative (-a
i)

{-# NOINLINE integral #-}

pblock :: Int -> Builder
pblock :: Int -> Builder
pblock = Int -> Int -> Builder
forall {t}. (Eq t, Num t) => t -> Int -> Builder
go Int
maxDigits
  where
    go :: t -> Int -> Builder
go !t
d !Int
n
        | t
d t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1    = Int -> Builder
forall a. Integral a => a -> Builder
digit Int
n
        | Bool
otherwise = t -> Int -> Builder
go (t
dt -> t -> t
forall a. Num a => a -> a -> a
-t
1) Int
q Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
forall a. Integral a => a -> Builder
digit Int
r
        where q :: Int
q = Int
n Int -> Int -> Int
`quotInt` Int
10
              r :: Int
r = Int
n Int -> Int -> Int
`remInt` Int
10

putB :: [Integer] -> Builder
putB :: [Integer] -> Builder
putB (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
maxInt of
                PAIR(Integer
x,y) -> Int -> Builder
pblock Int
q Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
pblock Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Integer] -> Builder
putB [Integer]
ns
                    where q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x
                          r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y
putB [Integer]
_ = Builder
forall a. Monoid a => a
mempty

bounded :: (Bounded a, Integral a) => a -> Builder
{-# SPECIALIZE bounded :: Int -> Builder #-}
{-# SPECIALIZE bounded :: Int8 -> Builder #-}
{-# SPECIALIZE bounded :: Int16 -> Builder #-}
{-# SPECIALIZE bounded :: Int32 -> Builder #-}
{-# SPECIALIZE bounded :: Int64 -> Builder #-}
bounded :: forall a. (Bounded a, Integral a) => a -> Builder
bounded a
i
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0        = a -> Builder
forall a. Integral a => a -> Builder
nonNegative a
i
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall a. Bounded a => a
minBound  = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> Builder
forall a. Integral a => a -> Builder
nonNegative (-a
i)
    | Bool
otherwise     = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                      a -> Builder
forall a. Integral a => a -> Builder
nonNegative (a -> a
forall a. Num a => a -> a
negate (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
10)) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                      a -> Builder
forall a. Integral a => a -> Builder
digit (a -> a
forall a. Num a => a -> a
negate (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
10))
  where k :: a
k = a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
i

nonNegative :: Integral a => a -> Builder
{-# SPECIALIZE nonNegative :: Int -> Builder #-}
{-# SPECIALIZE nonNegative :: Int8 -> Builder #-}
{-# SPECIALIZE nonNegative :: Int16 -> Builder #-}
{-# SPECIALIZE nonNegative :: Int32 -> Builder #-}
{-# SPECIALIZE nonNegative :: Int64 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word -> Builder #-}
{-# SPECIALIZE nonNegative :: Word8 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word16 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word32 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word64 -> Builder #-}
nonNegative :: forall a. Integral a => a -> Builder
nonNegative = a -> Builder
forall a. Integral a => a -> Builder
go
  where
    go :: a -> Builder
go a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = a -> Builder
forall a. Integral a => a -> Builder
digit a
n
         | Bool
otherwise = a -> Builder
go (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
10) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> Builder
forall a. Integral a => a -> Builder
digit (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
10)

digit :: Integral a => a -> Builder
digit :: forall a. Integral a => a -> Builder
digit a
n = Word8 -> Builder
fromWord8 (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$! a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
48
{-# INLINE digit #-}

integer :: Integer -> Builder
#if defined(INTEGER_GMP)
integer (S# i#) = int (I# i#)
#endif
integer :: Integer -> Builder
integer Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Integer -> Builder
go (-Integer
i)
    | Bool
otherwise = Integer -> Builder
go Integer
i
  where
    go :: Integer -> Builder
go Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
maxInt = Int -> Builder
int (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
         | Bool
otherwise  = [Integer] -> Builder
putH (Integer -> Integer -> [Integer]
splitf (Integer
maxInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maxInt) Integer
n)

    splitf :: Integer -> Integer -> [Integer]
splitf Integer
p Integer
n
      | Integer
p Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n       = [Integer
n]
      | Bool
otherwise   = Integer -> [Integer] -> [Integer]
splith Integer
p (Integer -> Integer -> [Integer]
splitf (Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
p) Integer
n)

    splith :: Integer -> [Integer] -> [Integer]
splith Integer
p (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
                        PAIR(Integer
q,r) | Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     -> Integer
q Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
splitb Integer
p [Integer]
ns
                                  | Bool
otherwise -> Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
splitb Integer
p [Integer]
ns
    splith Integer
_ [Integer]
_      = [Char] -> [Integer]
forall a. HasCallStack => [Char] -> a
error [Char]
"splith: the impossible happened."

    splitb :: Integer -> [Integer] -> [Integer]
splitb Integer
p (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
                        PAIR(Integer
q,r) -> Integer
q Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
splitb Integer
p [Integer]
ns
    splitb Integer
_ [Integer]
_      = []


-- The code below is originally from GHC.Float, but has been optimised
-- in quite a few ways.

data T = T [Int] {-# UNPACK #-} !Int

float :: Float -> Builder
float :: Float -> Builder
float = Double -> Builder
double (Double -> Builder) -> (Float -> Double) -> Float -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

double :: Double -> Builder
double :: Double -> Builder
double Double
f
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
f              = ByteString -> Builder
fromByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$
                                  if Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then ByteString
"Infinity" else ByteString
"-Infinity"
    | Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero Double
f = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` T -> Builder
goGeneric (Double -> T
floatToDigits (-Double
f))
    | Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0                    = T -> Builder
goGeneric (Double -> T
floatToDigits Double
f)
    | Bool
otherwise                 = ByteString -> Builder
fromByteString ByteString
"NaN"
  where
   goGeneric :: T -> Builder
goGeneric p :: T
p@(T [Int]
_ Int
e)
     | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 = T -> Builder
goExponent T
p
     | Bool
otherwise      = T -> Builder
goFixed    T
p
   goExponent :: T -> Builder
goExponent (T [Int]
is Int
e) =
       case [Int]
is of
         []     -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"putFormattedFloat"
         [Int
0]    -> ByteString -> Builder
fromByteString ByteString
"0.0e0"
         [Int
d]    -> Int -> Builder
forall a. Integral a => a -> Builder
digit Int
d Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
fromByteString ByteString
".0e" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
         (Int
d:[Int]
ds) -> Int -> Builder
forall a. Integral a => a -> Builder
digit Int
d Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
fromChar Char
'.' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Int] -> Builder
digits [Int]
ds Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                   Char -> Builder
fromChar Char
'e' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
   goFixed :: T -> Builder
goFixed (T [Int]
is Int
e)
       | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Char -> Builder
fromChar Char
'0' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
fromChar Char
'.' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                     [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate (-Int
e) (Char -> Builder
fromChar Char
'0')) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                     [Int] -> Builder
digits [Int]
is
       | Bool
otherwise = let g :: a -> [Int] -> Builder
g a
0 [Int]
rs     = Char -> Builder
fromChar Char
'.' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Int] -> Builder
mk0 [Int]
rs
                         g a
n []     = Char -> Builder
fromChar Char
'0' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> [Int] -> Builder
g (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) []
                         g a
n (Int
r:[Int]
rs) = Int -> Builder
forall a. Integral a => a -> Builder
digit Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> [Int] -> Builder
g (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) [Int]
rs
                     in Int -> [Int] -> Builder
forall {a}. (Eq a, Num a) => a -> [Int] -> Builder
g Int
e [Int]
is
   mk0 :: [Int] -> Builder
mk0 [] = Char -> Builder
fromChar Char
'0'
   mk0 [Int]
rs = [Int] -> Builder
digits [Int]
rs

digits :: [Int] -> Builder
digits :: [Int] -> Builder
digits (Int
d:[Int]
ds) = Int -> Builder
forall a. Integral a => a -> Builder
digit Int
d Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Int] -> Builder
digits [Int]
ds
digits [Int]
_      = Builder
forall a. Monoid a => a
mempty
{-# INLINE digits #-}

floatToDigits :: Double -> T
floatToDigits :: Double -> T
floatToDigits Double
0 = [Int] -> Int -> T
T [Int
0] Int
0
floatToDigits Double
x = [Int] -> Int -> T
T ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
rds) Int
k
 where
  (Integer
f0, Int
e0)     = Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x
  (Int
minExp0, Int
_) = Double -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange (Double
forall a. HasCallStack => a
undefined::Double)
  p :: Int
p = Double -> Int
forall a. RealFloat a => a -> Int
floatDigits Double
x
  b :: Integer
b = Double -> Integer
forall a. RealFloat a => a -> Integer
floatRadix Double
x
  minExp :: Int
minExp = Int
minExp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p -- the real minimum exponent
  -- Haskell requires that f be adjusted so denormalized numbers
  -- will have an impossibly low exponent.  Adjust for this.
  (# Integer
f, Int
e #) =
   let n :: Int
n = Int
minExp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e0 in
   if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (# Integer
f0 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n), Int
e0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n #) else (# Integer
f0, Int
e0 #)
  (# Integer
r, Integer
s, Integer
mUp, Integer
mDn #) =
   if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
   then let be :: Integer
be = Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e
        in if Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
           then (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
b #)
           else (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
2, Integer
be, Integer
be #)
   else if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
minExp Bool -> Bool -> Bool
&& Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        then (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
b, Integer
1 #)
        else (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
e)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
1, Integer
1 #)
  k :: Int
k = Int -> Int
fixup Int
k0
   where
    k0 :: Int
k0 | Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 = (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10
        -- logBase 10 2 is slightly bigger than 3/10 so the following
        -- will err on the low side.  Ignoring the fraction will make
        -- it err even more.  Haskell promises that p-1 <= logBase b f
        -- < p.
       | Bool
otherwise = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Double -> Double
forall a. Floating a => a -> a
log (Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
+
                               Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
b)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
log Double
10)
    fixup :: Int -> Int
fixup Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = if Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
exp10 Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      | Bool
otherwise = if Int -> Integer
exp10 (-Int
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

  gen :: [a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen [a]
ds !Integer
rn !Integer
sN !Integer
mUpN !Integer
mDnN =
   let (Integer
dn0, Integer
rn') = (Integer
rn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10) Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
sN
       mUpN' :: Integer
mUpN' = Integer
mUpN Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10
       mDnN' :: Integer
mDnN' = Integer
mDnN Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10
       !dn :: a
dn   = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
dn0
       !dn' :: a
dn'  = a
dn a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
   in case (# Integer
rn' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mDnN', Integer
rn' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUpN' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
sN #) of
        (# Bool
True,  Bool
False #) -> a
dn a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds
        (# Bool
False, Bool
True #)  -> a
dn' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds
        (# Bool
True,  Bool
True #)  -> if Integer
rn' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
sN then a
dn a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds else a
dn' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds
        (# Bool
False, Bool
False #) -> [a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen (a
dna -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ds) Integer
rn' Integer
sN Integer
mUpN' Integer
mDnN'

  rds :: [Int]
rds | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = [Int] -> Integer -> Integer -> Integer -> Integer -> [Int]
forall {a}.
Num a =>
[a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen [] Integer
r (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
exp10 Int
k) Integer
mUp Integer
mDn
      | Bool
otherwise = [Int] -> Integer -> Integer -> Integer -> Integer -> [Int]
forall {a}.
Num a =>
[a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen [] (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) Integer
s (Integer
mUp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) (Integer
mDn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk)
      where bk :: Integer
bk = Int -> Integer
exp10 (-Int
k)

exp10 :: Int -> Integer
exp10 :: Int -> Integer
exp10 Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxExpt = Vector Integer -> Int -> Integer
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Integer
expts Int
n
    | Bool
otherwise             = Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n
  where expts :: Vector Integer
expts = Int -> (Int -> Integer) -> Vector Integer
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
maxExpt (Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^)
        {-# NOINLINE expts #-}
        maxExpt :: Int
maxExpt = Int
17
{-# INLINE exp10 #-}




#else

import Blaze.Text (integral, double, float)

#endif