{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
#ifdef aarch64_HOST_ARCH
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds #-}
#endif

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

#include "MachDeps.h"

import Data.Bits (Bits (..), FiniteBits (..))
import Data.Int (Int16, Int32, Int8)
import Data.Text.Array qualified as A
import Data.Word (Word16, Word32, Word8)
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
    (forall a. FiniteBits a => a -> Int
maxDecLen a
n)
    (\MArray s
dst Int
dstOff → forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendDec MArray s
dst Int
dstOff a
n)
    Buffer
buffer
{-# INLINEABLE (|>$) #-}

-- | 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
    (forall a. FiniteBits a => a -> Int
maxDecLen a
n)
    (\MArray s
dst Int
dstOff → forall s a.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafePrependDec MArray s
dst Int
dstOff a
n)
    (\MArray s
dst Int
dstOff → forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendDec MArray s
dst Int
dstOff a
n)
    Buffer
buffer
{-# INLINEABLE ($<|) #-}

-- | 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
  | forall a. Bits a => a -> Bool
isSigned a
a = Int
2 forall a. Num a => a -> a -> a
+ (forall a. FiniteBits a => a -> Int
finiteBitSize a
a forall a. Num a => a -> a -> a
* Int
5) forall a. Bits a => a -> Int -> a
`shiftR` Int
4
  | Bool
otherwise = Int
1 forall a. Num a => a -> a -> a
+ (forall a. FiniteBits a => a -> Int
finiteBitSize a
a forall a. Num a => a -> a -> a
* Int
5) forall a. Bits a => a -> Int -> a
`shiftR` Int
4
{-# INLINEABLE maxDecLen #-}

exactDecLen ∷ (Integral a, FiniteBits a) ⇒ a → Int
exactDecLen :: forall a. (Integral a, FiniteBits a) => a -> Int
exactDecLen a
n
  | a
n forall a. Ord a => a -> a -> Bool
< a
0 =
      forall a. (Integral a, FiniteBits a) => Int -> a -> Int
go Int
2 (forall a. Bits a => a -> a
complement a
n forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (forall a. a -> Int#
dataToTag# (a
n forall a. Ord a => a -> a -> Bool
> forall a. Bits a => Int -> a
bit (forall a. FiniteBits a => a -> Int
finiteBitSize a
n forall a. Num a => a -> a -> a
- Int
1)))))
  | Bool
otherwise =
      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
      | forall a. FiniteBits a => a -> Int
finiteBitSize a
k forall a. Ord a => a -> a -> Bool
>= if forall a. Bits a => a -> Bool
isSigned a
k then Int
31 else Int
30, a
k forall a. Ord a => a -> a -> Bool
>= a
1e9 = forall a. (Integral a, FiniteBits a) => Int -> a -> Int
go (Int
acc forall a. Num a => a -> a -> a
+ Int
9) (forall a. (Integral a, FiniteBits a) => a -> a
quotBillion a
k)
      | Bool
otherwise = Int
acc forall a. Num a => a -> a -> a
+ Int -> Int
goInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k)

    goInt :: Int -> Int
goInt l :: Int
l@(I# Int#
l#)
      | Int
l forall a. Ord a => a -> a -> Bool
>= Int
1e5 = Int
5 forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
100_000_000#) forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
10_000_000#) forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
1_000_000#)
      | Bool
otherwise = Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
10_000#) forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
1_000#) forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
100#) forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
l# Int# -> Int# -> Int#
>=# Int#
10#)
{-# INLINEABLE 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 = forall s a.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafePrependDec MArray s
marr (Int
off forall a. Num a => a -> a -> a
+ forall a. (Integral a, FiniteBits a) => a -> Int
exactDecLen a
n) a
n
{-# INLINEABLE unsafeAppendDec #-}

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

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

    digits ∷ Addr#
    digits :: Addr#
digits = Addr#
"00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899"#
{-# INLINEABLE unsafePrependDec #-}

-- Compute rem minBound 10 efficiently. Given that:
-- • minBound = 1 `shiftL` (finiteBitSize a - 1) = -2^(finiteBitSize a - 1)
-- • the last digit of 2^k forms a cycle for k≥1: 2,4,8,6
-- Then it is enough to pattern-match rem (finiteBitSize a) 4,
-- i.e. finiteBitSize a .&. 3
minBoundLastDigit ∷ FiniteBits a ⇒ a → Int
minBoundLastDigit :: forall a. FiniteBits a => a -> Int
minBoundLastDigit a
a = case forall a. FiniteBits a => a -> Int
finiteBitSize a
a forall a. Bits a => a -> a -> a
.&. Int
3 of
  Int
0 → Int
8
  Int
1 → Int
6
  Int
2 → Int
2
  Int
_ → Int
4
{-# INLINEABLE minBoundLastDigit #-}

quotRem100 ∷ (Integral a, FiniteBits a) ⇒ a → (a, a)

-- https://gitlab.haskell.org/ghc/ghc/-/issues/22933
#ifdef aarch64_HOST_ARCH
quotRem100 a = a `quotRem` 100
#else
quotRem100 :: forall a. (Integral a, FiniteBits a) => a -> (a, a)
quotRem100 a
a = let q :: a
q = forall a. (Integral a, FiniteBits a) => a -> a
quot100 a
a in (a
q, a
a forall a. Num a => a -> a -> a
- a
100 forall a. Num a => a -> a -> a
* a
q)
#endif
{-# INLINEABLE quotRem100 #-}

quot100 ∷ (Integral a, FiniteBits a) ⇒ a → a
quot100 :: forall a. (Integral a, FiniteBits a) => a -> a
quot100 a
a = case (forall a. FiniteBits a => a -> Int
finiteBitSize a
a, forall a. Bits a => a -> Bool
isSigned a
a) of
  (Int
64, Bool
True)
    | forall a. FiniteBits a => a -> Int
finiteBitSize (Int
0 ∷ Int) forall a. Eq a => a -> a -> Bool
== Int
64 →
        forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int))
  (Int
64, Bool
False)
    | forall a. FiniteBits a => a -> Int
finiteBitSize (Word
0 ∷ Word) forall a. Eq a => a -> a -> Bool
== Int
64 →
        forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 ∷ Word))
  (Int
32, Bool
True) → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int32))
  (Int
32, Bool
False) → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 ∷ Word32))
  (Int
16, Bool
True) → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int16))
  (Int
16, Bool
False) → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 ∷ Word16))
  (Int
8, Bool
True) → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (100 ∷ Int8))
  (Int
8, Bool
False) → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (100 ∷ Word8))
  (Int, Bool)
_ → 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> b
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a))
{-# INLINEABLE quot100 #-}

quotBillion ∷ (Integral a, FiniteBits a) ⇒ a → a
#ifdef aarch64_HOST_ARCH
quotBillion a = a `quot` 1e9
#else
quotBillion :: forall a. (Integral a, FiniteBits a) => a -> a
quotBillion a
a = case (forall a. FiniteBits a => a -> Int
finiteBitSize a
a, forall a. Bits a => a -> Bool
isSigned a
a) of
  (Int
64, Bool
True)
    | forall a. FiniteBits a => a -> Int
finiteBitSize (Int
0 :: Int) forall a. Eq a => a -> a -> Bool
== Int
64
    → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int))
  (Int
64, Bool
False)
    | forall a. FiniteBits a => a -> Int
finiteBitSize (Word
0 :: Word) forall a. Eq a => a -> a -> Bool
== Int
64
    → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (1e9 :: Word))
  (Int
32, Bool
True)  → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteAST $ assumeNonNegArg $ astQuot (1e9 :: Int32))
  (Int
32, Bool
False) → forall a b. (Integral a, Integral b) => (b -> b) -> a
cast $$(quoteQuot (1e9 :: Word32))
  (Int, Bool)
_ → 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> b
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a))
#endif
{-# INLINEABLE quotBillion #-}