{-# LANGUAGE UnboxedTuples, MagicHash, BangPatterns, CPP #-}
module Text.Show.ByteString.Integer where
import GHC.Base
#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 611 && INTEGER_GMP
import GHC.Integer.Internals
#elif __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 611 && INTEGER_GMP
import GHC.Integer.GMP.Internals
#elif __GLASGOW_HASKELL__ && INTEGER_SIMPLE
import GHC.Integer.Simple.Internals
#endif
import GHC.Num
import Data.Binary.Put
import Text.Show.ByteString.Util
import Text.Show.ByteString.Int
mx :: Integer
ds :: Int
(Integer
mx, Int
ds) = ((Integer, Int) -> Bool)
-> ((Integer, Int) -> (Integer, Int))
-> (Integer, Int)
-> (Integer, Int)
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
mi) (Integer -> Bool)
-> ((Integer, Int) -> Integer) -> (Integer, Int) -> 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)
-> ((Integer, Int) -> Integer) -> (Integer, Int) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Int) -> Integer
forall a b. (a, b) -> a
fst) (\(Integer
n,Int
d) -> (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
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)
showpInteger :: Integer -> Put
#ifdef INTEGER_SIMPLE
#elif INTEGER_GMP
showpInteger :: Integer -> Put
showpInteger (S# Int#
i#) = Int# -> Put
putI Int#
i#
#else
showpInteger (I# i#) = putI i#
#endif
showpInteger Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Char -> Put
putAscii Char
'-' Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Put
posIntegerPut (-Integer
n)
| Bool
otherwise = Integer -> Put
posIntegerPut Integer
n
posIntegerPut :: Integer -> Put
posIntegerPut :: Integer -> Put
posIntegerPut Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mx = case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n of
I# Int#
i# -> Int# -> Put
putI Int#
i#
| Bool
otherwise = [Integer] -> Put
printh (Integer -> Integer -> [Integer]
splitf (Integer
mxInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
mx) Integer
n)
splitf :: Integer -> Integer -> [Integer]
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 -> [Integer] -> [Integer]
splith Integer
_ [ ] = [Char] -> [Integer]
forall a. HasCallStack => [Char] -> a
error [Char]
"splith: the impossible happened."
splith Integer
p (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
(# Integer
q, Integer
r #) ->
#else
(q, r) ->
#endif
if Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
then 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
else Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
splitb Integer
p [Integer]
ns
splitb :: Integer -> [Integer] -> [Integer]
splitb :: Integer -> [Integer] -> [Integer]
splitb Integer
_ [ ] = []
splitb Integer
p (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
(# Integer
q, Integer
r #) ->
#else
(q, r) ->
#endif
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
printh :: [Integer] -> Put
printh :: [Integer] -> Put
printh [ ] = [Char] -> Put
forall a. HasCallStack => [Char] -> a
error [Char]
"printh: the impossible happened."
printh (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
mx of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
(# Integer
q', Integer
r' #) ->
#else
(q', r') ->
#endif
let q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
q'
r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r'
in if Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Put
phead Int
q Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
pblock Int
r Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Put
printb [Integer]
ns
else Int -> Put
phead Int
r Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Put
printb [Integer]
ns
printb :: [Integer] -> Put
printb :: [Integer] -> Put
printb [ ] = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printb (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
mx of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
(# Integer
q', Integer
r' #) ->
#else
(q', r') ->
#endif
let q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
q'
r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r'
in Int -> Put
pblock Int
q Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
pblock Int
r Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Put
printb [Integer]
ns
phead :: Int -> Put
phead :: Int -> Put
phead (I# Int#
i#) = Int# -> Put
putI Int#
i#
pblock :: Int -> Put
pblock :: Int -> Put
pblock = Int -> Int -> Put
pblock' Int
ds
pblock' :: Int -> Int -> Put
pblock' :: Int -> Int -> Put
pblock' Int
d !Int
n
| Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> Put
unsafePutDigit Int
n
| Bool
otherwise = Int -> Int -> Put
pblock' (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
q Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
unsafePutDigit Int
r
where (Int
q, Int
r) = Int
n Int -> Int -> (Int, Int)
`quotRemInt` Int
10
showpIntAtBase :: Integral a => a -> (Int -> Char) -> a -> Put
showpIntAtBase :: a -> (Int -> Char) -> a -> Put
showpIntAtBase a
b Int -> Char
f a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Char -> Put
putAscii Char
'-' Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> (Int -> Char) -> a -> Put
forall a. Integral a => a -> (Int -> Char) -> a -> Put
showpIntAtBase a
b Int -> Char
f (-a
n)
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = Char -> Put
putAscii (Int -> Char
f Int
0)
| Bool
otherwise = let
go :: a -> Put
go a
k | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = a -> Put
go a
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Put
putAscii (Int -> Char
f (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
m)
where
(a
d, a
m) = a
k a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
b
in a -> Put
go a
n