-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>

{-# LANGUAGE TemplateHaskell #-}

module Data.Text.Builder.Linear.Dec
  ( (|>$)
  , ($<|)
  ) where

import Data.Bits (FiniteBits(..), Bits(..))
import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.Text.Array as A
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Exts (Addr#, Int(..), Ptr(..), (>=#), dataToTag#)
import GHC.Ptr (plusPtr)
import GHC.ST (ST)
import Numeric.QuoteQuot (assumeNonNegArg, astQuot, quoteAST, quoteQuot)

import Data.Text.Builder.Linear.Core

-- | Append decimal number.
(|>$) :: (Integral a, FiniteBits a) => Buffer ⊸ a → Buffer
infixl 6 |>$
Buffer
buffer |>$ :: forall a. (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer
|>$ a
n = Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded
  (a -> Int
forall a. FiniteBits a => a -> Int
maxDecLen a
n)
  (\MArray s
dst Int
dstOff → MArray s -> Int -> a -> ST s Int
forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendDec MArray s
dst Int
dstOff a
n)
  Buffer
buffer
{-# INLINABLE (|>$) #-}

-- | Prepend decimal number.
($<|) :: (Integral a, FiniteBits a) => a → Buffer ⊸ Buffer
infixr 6 $<|
a
n $<| :: forall a. (Integral a, FiniteBits a) => a -> Buffer %1 -> Buffer
$<| Buffer
buffer = Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded
  (a -> Int
forall a. FiniteBits a => a -> Int
maxDecLen a
n)
  (\MArray s
dst Int
dstOff → MArray s -> Int -> a -> ST s Int
forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafePrependDec MArray s
dst Int
dstOff a
n)
  (\MArray s
dst Int
dstOff → MArray s -> Int -> a -> ST s Int
forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendDec MArray s
dst Int
dstOff a
n)
  Buffer
buffer
{-# INLINABLE ($<|) #-}

-- | ceiling (fbs a * logBase 10 2) < ceiling (fbs a * 5 / 16) < 1 + floor (fbs a * 5 / 16)
maxDecLen :: FiniteBits a => a → Int
maxDecLen :: forall a. FiniteBits a => a -> Int
maxDecLen a
a
  | a -> Bool
forall a. Bits a => a -> Bool
isSigned a
a = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
  | Bool
otherwise  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
{-# INLINABLE maxDecLen #-}

exactDecLen :: (Integral a, FiniteBits a) => a → Int
exactDecLen :: forall a. (Integral a, FiniteBits a) => a -> Int
exactDecLen a
n
  | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
  = Int -> a -> Int
forall a. (Integral a, FiniteBits a) => Int -> a -> Int
go Int
2 (a -> a
forall a. Bits a => a -> a
complement a
n a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (Bool -> Int#
forall a. a -> Int#
dataToTag# (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> a
forall a. Bits a => Int -> a
bit (a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))))
  | Bool
otherwise
  = Int -> a -> Int
forall a. (Integral a, FiniteBits a) => Int -> a -> Int
go Int
1 a
n
  where
    go :: (Integral a, FiniteBits a) => Int → a → Int
    go :: forall a. (Integral a, FiniteBits a) => Int -> a -> Int
go Int
acc a
k
      | a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32, a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1000000000 = Int -> a -> Int
forall a. (Integral a, FiniteBits a) => Int -> a -> Int
go (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
9) (a -> a
forall a. (Integral a, FiniteBits a) => a -> a
quotBillion a
k)
      | Bool
otherwise = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
goInt (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k)

    goInt :: Int -> Int
goInt l :: Int
l@(I# Int#
l#)
      | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1e5  = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
100000000#) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
10000000#) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
1000000#)
      | Bool
otherwise = Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
10000#) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
1000#) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
100#) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
10#)
{-# INLINABLE exactDecLen #-}

unsafeAppendDec :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int
unsafeAppendDec :: forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendDec MArray s
marr Int
off a
n = MArray s -> Int -> a -> ST s Int
forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafePrependDec MArray s
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. (Integral a, FiniteBits a) => a -> Int
exactDecLen a
n) a
n
{-# INLINABLE unsafeAppendDec #-}

unsafePrependDec :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int
unsafePrependDec :: forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafePrependDec MArray s
marr Int
off a
n
  | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0, a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> a
forall a. Bits a => Int -> a
bit (a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) = do
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. FiniteBits a => a -> Int
minBoundLastDigit a
n))
    Int -> a -> ST s Int
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (a -> a
forall a. Num a => a -> a
abs (Int -> a
forall a. Bits a => Int -> a
bit (a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
10)) ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ST s Int
sign
  | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = do
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
0x30 ST s () -> ST s Int -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
  | Bool
otherwise = Int -> a -> ST s Int
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (a -> a
forall a. Num a => a -> a
abs a
n) ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ST s Int
sign
  where
    sign :: Int -> ST s Int
sign Int
o
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o)
      | Bool
otherwise = do
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
0x2d -- '-'
        Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    go :: Int -> a -> ST s Int
go Int
o a
k
      | a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10 = do
        let q :: a
q = a -> a
forall a. (Integral a, FiniteBits a) => a -> a
quot100 a
k
            r :: a
r = a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
100 a -> a -> a
forall a. Num a => a -> a -> a
* a
q
        MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
marr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
digits Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1)) Int
2
        if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
100 then Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else Int -> a -> ST s Int
go (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) a
q
      | Bool
otherwise = do
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
o (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
48 a -> a -> a
forall a. Num a => a -> a -> a
+ a
k))
        Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
o

    digits :: Addr#
    digits :: Addr#
digits = Addr#
"00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899"#
{-# INLINABLE unsafePrependDec #-}

minBoundLastDigit :: FiniteBits a => a → Int
minBoundLastDigit :: forall a. FiniteBits a => a -> Int
minBoundLastDigit a
a = case a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
4 of
  Int
0 → Int
8
  Int
1 → Int
6
  Int
2 → Int
2
  Int
_ → Int
4
{-# INLINABLE minBoundLastDigit #-}

quot100 :: (Integral a, FiniteBits a) => a → a
quot100 :: forall a. (Integral a, FiniteBits a) => a -> a
quot100 a
a = case (a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
a, a -> Bool
forall a. Bits a => a -> Bool
isSigned a
a) of
  (Int
64, Bool
True)  → (Int64 -> Int64) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int64))
  (Int
64, Bool
False) → (Word64 -> Word64) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 :: Word64))
  (Int
32, Bool
True)  → (Int32 -> Int32) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int32))
  (Int
32, Bool
False) → (Word32 -> Word32) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 :: Word32))
  (Int
16, Bool
True)  → (Int16 -> Int16) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int16))
  (Int
16, Bool
False) → (Word16 -> Word16) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 :: Word16))
  ( Int
8, Bool
True)  → (Int8 -> Int8) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 :: Int8))
  ( Int
8, Bool
False) → (Word8 -> Word8) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 :: Word8))
  (Int, Bool)
_ → a
a a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
100
  where
    cast :: (Integral a, Integral b) => (b → b) → a
    cast :: forall a b. (Integral a, Integral b) => (b -> b) -> a
cast b -> b
f = b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> b
f (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a))
{-# INLINABLE quot100 #-}

quotBillion :: (Integral a, FiniteBits a) => a → a
quotBillion :: forall a. (Integral a, FiniteBits a) => a -> a
quotBillion a
a = case (a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
a, a -> Bool
forall a. Bits a => a -> Bool
isSigned a
a) of
  (Int
64, Bool
True)  → (Int64 -> Int64) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int64))
  (Int
64, Bool
False) → (Word64 -> Word64) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (1e9 :: Word64))
  (Int
32, Bool
True)  → (Int32 -> Int32) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int32))
  (Int
32, Bool
False) → (Word32 -> Word32) -> a
forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (1e9 :: Word32))
  (Int, Bool)
_ → a
a a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
1e9
  where
    cast :: (Integral a, Integral b) => (b → b) → a
    cast :: forall a b. (Integral a, Integral b) => (b -> b) -> a
cast b -> b
f = b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> b
f (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a))
{-# INLINABLE quotBillion #-}