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

-- ---------------------------------------------------------------------------
-- |
-- Module      : Text.Show.ByteString.Int
-- Copyright   : (c) 2008 Dan Doel
-- Maintainer  : Dan Doel
-- Stability   : Experimental
-- Portability : Non-portable (magic hash)
--
-- Putting integers and words.
--
-- The code in this module is based on the printing in the GHC modules.

#include "MachDeps.h"

module Text.Show.ByteString.Int where

import GHC.Base
import GHC.Int
import GHC.Word

import Data.Binary

import Text.Show.ByteString.Util

putI :: Int# -> Put
putI :: Int# -> Put
putI Int#
i#
#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708
  = case Int#
i# Int# -> Int# -> Int#
<# Int#
0# of
      Int#
1#       -> let !(I# Int#
minInt#) = Int
minInt
#elif __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 611
  | i# <# 0#  = let !(I# minInt#) = minInt
#else
  | i# <# 0#  = let I# minInt# = minInt
#endif
                in case Int#
i# Int# -> Int# -> Int#
==# Int#
minInt# of
#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708
                     Int#
1# ->
#else
                     True ->
#endif
                        Word8 -> Put
putWord8 Word8
45 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word# -> Put
putW (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# (Int#
i# Int# -> Int# -> Int#
`quotInt#` Int#
10#)))
                                    Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word# -> Put
putW (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# (Int#
i# Int# -> Int# -> Int#
`remInt#` Int#
10#)))
                     Int#
_ ->
                        Word8 -> Put
putWord8 Word8
45 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word# -> Put
putW (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
i#))
#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708
      Int#
_        -> Word# -> Put
putW (Int# -> Word#
int2Word# Int#
i#)
#else
  | otherwise = putW (int2Word# i#)
#endif

putW :: Word# -> Put
putW :: Word# -> Put
putW Word#
w#
#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708
  = case Word#
w# Word# -> Word# -> Int#
`ltWord#` Int# -> Word#
int2Word# Int#
10# of
      Int#
1# ->
#else
  | w# `ltWord#` int2Word# 10# =
#endif
        Word# -> Put
unsafePutDigit# Word#
w#
#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708
      Int#
_  ->
#else
  | otherwise =
#endif
        Word# -> Put
putW (Word#
w# Word# -> Word# -> Word#
`quotWord#` Int# -> Word#
int2Word# Int#
10#)
        Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word# -> Put
unsafePutDigit# (Word#
w# Word# -> Word# -> Word#
`remWord#` Int# -> Word#
int2Word# Int#
10#)

showpInt :: Int -> Put
showpInt :: Int -> Put
showpInt (I# Int#
i#) = Int# -> Put
putI Int#
i#

showpInt8 :: Int8 -> Put
showpInt8 :: Int8 -> Put
showpInt8 (I8# Int#
i#) = Int# -> Put
putI Int#
i#

showpInt16 :: Int16 -> Put
showpInt16 :: Int16 -> Put
showpInt16 (I16# Int#
i#) = Int# -> Put
putI Int#
i#

showpInt32 :: Int32 -> Put
showpInt32 :: Int32 -> Put
showpInt32 (I32# Int#
i#) = Int# -> Put
putI Int#
i#

showpInt64 :: Int64 -> Put
#if WORD_SIZE_IN_BITS >= 64
showpInt64 (I64# i#) = putI i#
#else /* WORD_SIZE_IN_BITS < 64 */
showpInt64 :: Int64 -> Put
showpInt64 = Int64 -> Put
putI64

-- Unboxed 64-bit-specific operations aren't exported

putI64 :: Int64 -> Put
putI64 :: Int64 -> Put
putI64 Int64
i | Int64
i Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
minBound = Word8 -> Put
putWord8 Word8
45
                           Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putW64 (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Num a => a -> a
negate (Int64
i Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
10))
                           Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putW64 (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Num a => a -> a
negate (Int64
i Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`rem` Int64
10))
         | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0         = Word8 -> Put
putWord8 Word8
45 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putW64 (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Num a => a -> a
negate Int64
i)
         | Bool
otherwise     = Word64 -> Put
putW64 (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
#endif

showpWord :: Word -> Put
showpWord :: Word -> Put
showpWord (W# Word#
w#) = Word# -> Put
putW Word#
w#

showpWord8 :: Word8 -> Put
showpWord8 :: Word8 -> Put
showpWord8 (W8# Word#
w#) = Word# -> Put
putW Word#
w#

showpWord16 :: Word16 -> Put
showpWord16 :: Word16 -> Put
showpWord16 (W16# Word#
w#) = Word# -> Put
putW Word#
w#

showpWord32 :: Word32 -> Put
showpWord32 :: Word32 -> Put
showpWord32 (W32# Word#
w#) = Word# -> Put
putW Word#
w#

showpWord64 :: Word64 -> Put
#if WORD_SIZE_IN_BITS >= 64
showpWord64 (W64# w#) = putW w#
#else /* WORD_SIZE_IN_BITS < 64 */
showpWord64 :: Word64 -> Put
showpWord64 = Word64 -> Put
putW64

putW64 :: Word64 -> Put
putW64 :: Word64 -> Put
putW64 Word64
w | Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
10    = Word64 -> Put
forall a. Integral a => a -> Put
unsafePutDigit64 Word64
w
         | Bool
otherwise = Word64 -> Put
putW64 (Word64
w Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
10)
                       Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
forall a. Integral a => a -> Put
unsafePutDigit64 (Word64
w Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`rem` Word64
10)
    where unsafePutDigit64 :: a -> Put
unsafePutDigit64 a
w = Word# -> Put
unsafePutDigit# (case a -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w of (W# Word#
w#) -> Word#
w#)

#endif