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

    -- Module:      Blaze.Text.Int
    -- Copyright:   (c) 2011 MailRank, Inc.
    -- License:     BSD3
    -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
    -- Stability:   experimental
    -- Portability: portable
    --
    -- Efficiently serialize an integral value as a lazy 'L.ByteString'.

    module Blaze.Text.Int
        (
          digit
        , integral
        , minus
        ) where

    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

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

    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 i
        | i >= 0                 = nonNegative i
        | toByteString b == "-0" = fromString (show i)
        | otherwise              = b
      where b = minus `mappend` nonNegative (-i)
    {-# NOINLINE integral #-}

    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 i
        | i >= 0        = nonNegative i
        | i > minBound  = minus `mappend` nonNegative (-i)
        | otherwise     = minus `mappend`
                          nonNegative (negate (k `quot` 10)) `mappend`
                          digit (negate (k `rem` 10))
      where k = minBound `asTypeOf` 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 = go
      where
        go n | n < 10    = digit n
             | otherwise = go (n `quot` 10) `mappend` digit (n `rem` 10)

    digit :: Integral a => a -> Builder
    digit n = fromWord8 $! fromIntegral n + 48
    {-# INLINE digit #-}

    minus :: Builder
    minus = fromWord8 45

    int :: Int -> Builder
    int = integral
    {-# INLINE int #-}

    integer :: Integer -> Builder
    #if defined(INTEGER_GMP)
    integer (S# i#) = int (I# i#)
    #endif
    integer i
        | i < 0     = minus `mappend` go (-i)
        | otherwise = go i
      where
        go n | n < maxInt = int (fromInteger n)
             | otherwise  = putH (splitf (maxInt * maxInt) n)

        splitf p n
          | p > n       = [n]
          | otherwise   = splith p (splitf (p*p) n)

        splith p (n:ns) = case n `quotRemInteger` p of
                            PAIR(q,r) | q > 0     -> q : r : splitb p ns
                                      | otherwise -> r : splitb p ns
        splith _ _      = error "splith: the impossible happened."

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

    data T = T !Integer !Int

    fstT :: T -> Integer
    fstT (T a _) = a

    maxInt :: Integer
    maxDigits :: Int
    T maxInt maxDigits =
        until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
      where mi = fromIntegral (maxBound :: Int)

    putH :: [Integer] -> Builder
    putH (n:ns) = case n `quotRemInteger` maxInt of
                    PAIR(x,y)
                        | q > 0     -> int q `mappend` pblock r `mappend` putB ns
                        | otherwise -> int r `mappend` putB ns
                        where q = fromInteger x
                              r = fromInteger y
    putH _ = error "putH: the impossible happened"

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

    pblock :: Int -> Builder
    pblock = go maxDigits
      where
        go !d !n
            | d == 1    = digit n
            | otherwise = go (d-1) q `mappend` digit r
            where q = n `quotInt` 10
                  r = n `remInt` 10