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

-- ---------------------------------------------------------------------------
-- |
-- Module      : Text.Show.ByteString.Integer
-- Copyright   : (c) 2008 Dan Doel
-- Maintainer  : Dan Doel
-- Stability   : Experimental
-- Portability : Non-portable (magic hash, bang patterns)
--
-- Putting unbounded integers.
--
-- This code is based off the integer showing code in GHC.

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
(mx :: Integer
mx, ds :: 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
*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) (\(n :: Integer
n,d :: Int
d) -> (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*10,Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)) (10,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# i# :: Int#
i#) = Int# -> Put
putI Int#
i#
#else
showpInteger (I# i#) = putI i#
#endif
showpInteger n :: Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Char -> Put
putAscii '-' 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 n :: 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# 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 p :: Integer
p n :: 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 _ [    ] = [Char] -> [Integer]
forall a. HasCallStack => [Char] -> a
error "splith: the impossible happened."
splith p :: Integer
p (n :: Integer
n:ns :: [Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
  (# q :: Integer
q, r :: Integer
r #) ->
#else
  (q, r) ->
#endif
          if Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 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 _ [    ] = []
splitb p :: Integer
p (n :: Integer
n:ns :: [Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
  (# q :: Integer
q, r :: 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 "printh: the impossible happened."
printh (n :: Integer
n:ns :: [Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
mx of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
  (# q' :: Integer
q', r' :: 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
> 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 (n :: Integer
n:ns :: [Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
mx of
#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
  (# q' :: Integer
q', r' :: 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# 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' d :: Int
d !Int
n
  | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1    = Int -> Put
unsafePutDigit Int
n
  | Bool
otherwise = Int -> Int -> Put
pblock' (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Int
q Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
unsafePutDigit Int
r
 where (q :: Int
q, r :: Int
r) = Int
n Int -> Int -> (Int, Int)
`quotRemInt` 10

-- | Shows an Integral number using the base specified by the first
-- argument and the chracter representation specified by the second.
showpIntAtBase :: Integral a => a -> (Int -> Char) -> a -> Put
showpIntAtBase :: a -> (Int -> Char) -> a -> Put
showpIntAtBase b :: a
b f :: Int -> Char
f n :: a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Char -> Put
putAscii '-' 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
== 0    = Char -> Put
putAscii (Int -> Char
f 0)
                     | Bool
otherwise = let
  go :: a -> Put
go k :: a
k | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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
   (d :: a
d, m :: 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