{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
module Data.Text.Format.Int
(
decimal
, integer
, hexadecimal
, minus
) where
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Monoid (mempty)
import Data.Text.Format.Functions (i2d)
import qualified Data.Text.Format.Functions as F ((<>))
import Data.Text.Lazy.Builder
import Data.Word (Word, Word8, Word16, Word32, Word64)
import GHC.Base (quotInt, remInt)
import GHC.Num (quotRemInteger)
import GHC.Types (Int(..))
#ifdef __GLASGOW_HASKELL__
# if __GLASGOW_HASKELL__ < 611
import GHC.Integer.Internals
# else
import GHC.Integer.GMP.Internals
# endif
#endif
#ifdef INTEGER_GMP
# define PAIR(a,b) (# a,b #)
#else
# define PAIR(a,b) (a,b)
#endif
decimal :: (Integral a, Bounded a) => a -> Builder
{-# SPECIALIZE decimal :: Int -> Builder #-}
{-# SPECIALIZE decimal :: Int8 -> Builder #-}
{-# SPECIALIZE decimal :: Int16 -> Builder #-}
{-# SPECIALIZE decimal :: Int32 -> Builder #-}
{-# SPECIALIZE decimal :: Int64 -> Builder #-}
{-# SPECIALIZE decimal :: Word -> Builder #-}
{-# SPECIALIZE decimal :: Word8 -> Builder #-}
{-# SPECIALIZE decimal :: Word16 -> Builder #-}
{-# SPECIALIZE decimal :: Word32 -> Builder #-}
{-# SPECIALIZE decimal :: Word64 -> Builder #-}
{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
decimal :: a -> Builder
decimal a
i
| a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound =
Builder
minus Builder -> Builder -> Builder
F.<> Int -> Integer -> Builder
integer Int
10 (Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
| a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Builder
minus Builder -> Builder -> Builder
F.<> a -> Builder
forall a. Integral a => a -> Builder
go (-a
i)
| Bool
otherwise = a -> Builder
forall a. Integral a => a -> Builder
go a
i
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
F.<> a -> Builder
forall a. Integral a => a -> Builder
digit (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
10)
{-# NOINLINE[0] decimal #-}
hexadecimal :: Integral a => a -> Builder
{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}
hexadecimal :: a -> Builder
hexadecimal a
i
| a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Builder
minus Builder -> Builder -> Builder
F.<> a -> Builder
forall a. Integral a => a -> Builder
go (-a
i)
| Bool
otherwise = a -> Builder
forall a. Integral a => a -> Builder
go a
i
where
go :: a -> Builder
go a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
16 = a -> Builder
forall a. Integral a => a -> Builder
hexDigit a
n
| Bool
otherwise = a -> Builder
go (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
16) Builder -> Builder -> Builder
F.<> a -> Builder
forall a. Integral a => a -> Builder
hexDigit (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
16)
{-# NOINLINE[0] hexadecimal #-}
digit :: Integral a => a -> Builder
digit :: a -> Builder
digit a
n = Char -> Builder
singleton (Char -> Builder) -> Char -> Builder
forall a b. (a -> b) -> a -> b
$! Int -> Char
i2d (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
{-# INLINE digit #-}
hexDigit :: Integral a => a -> Builder
hexDigit :: a -> Builder
hexDigit a
n
| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9 = Char -> Builder
singleton (Char -> Builder) -> Char -> Builder
forall a b. (a -> b) -> a -> b
$! Int -> Char
i2d (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
| Bool
otherwise = Char -> Builder
singleton (Char -> Builder) -> Char -> Builder
forall a b. (a -> b) -> a -> b
$! Int -> Char
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
87)
{-# INLINE hexDigit #-}
minus :: Builder
minus :: Builder
minus = Char -> Builder
singleton Char
'-'
int :: Int -> Builder
int :: Int -> Builder
int = Int -> Builder
forall a. (Integral a, Bounded a) => a -> Builder
decimal
{-# INLINE int #-}
data T = T !Integer !Int
integer :: Int -> Integer -> Builder
integer :: Int -> Integer -> Builder
integer Int
10 (S# Int#
i#) = Int -> Builder
forall a. (Integral a, Bounded a) => a -> Builder
decimal (Int# -> Int
I# Int#
i#)
integer Int
16 (S# Int#
i#) = Int -> Builder
forall a. Integral a => a -> Builder
hexadecimal (Int# -> Int
I# Int#
i#)
integer Int
base Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Builder
minus Builder -> Builder -> Builder
F.<> 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]
_ = []
T Integer
maxInt10 Int
maxDigits10 =
(T -> Bool) -> (T -> T) -> T -> T
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
mi) (Integer -> Bool) -> (T -> Integer) -> T -> 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) -> (T -> Integer) -> T -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Integer
fstT) (\(T Integer
n Int
d) -> Integer -> Int -> T
T (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 -> T
T 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)
T Integer
maxInt16 Int
maxDigits16 =
(T -> Bool) -> (T -> T) -> T -> T
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
mi) (Integer -> Bool) -> (T -> Integer) -> T -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
16) (Integer -> Integer) -> (T -> Integer) -> T -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Integer
fstT) (\(T Integer
n Int
d) -> Integer -> Int -> T
T (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
16) (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) (Integer -> Int -> T
T Integer
16 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)
fstT :: T -> Integer
fstT (T Integer
a Int
_) = Integer
a
maxInt :: Integer
maxInt | Int
base Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
10 = Integer
maxInt10
| Bool
otherwise = Integer
maxInt16
maxDigits :: Int
maxDigits | Int
base Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
10 = Int
maxDigits10
| Bool
otherwise = Int
maxDigits16
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
F.<> Int -> Builder
pblock Int
r Builder -> Builder -> Builder
F.<> [Integer] -> Builder
putB [Integer]
ns
| Bool
otherwise -> Int -> Builder
int Int
r Builder -> Builder -> Builder
F.<> [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"
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
F.<> Int -> Builder
pblock Int
r Builder -> Builder -> Builder
F.<> [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
pblock :: Int -> Builder
pblock = Int -> Int -> Builder
forall t. (Eq t, Num t) => t -> Int -> Builder
loop Int
maxDigits
where
loop :: t -> Int -> Builder
loop !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
loop (t
dt -> t -> t
forall a. Num a => a -> a -> a
-t
1) Int
q Builder -> Builder -> Builder
F.<> Int -> Builder
forall a. Integral a => a -> Builder
digit Int
r
where q :: Int
q = Int
n Int -> Int -> Int
`quotInt` Int
base
r :: Int
r = Int
n Int -> Int -> Int
`remInt` Int
base