    {-# LANGUAGE BangPatterns        #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# OPTIONS_GHC -ddump-simpl -dsuppress-all -ddump-to-file #-}
    -- | The naive left fold to convert digits to integer is quadratic
    -- as multiplying (big) 'Integer's is not a constant time operation.
    --
    -- This module provides sub-quadratic algorithm for conversion of 'Text'
    -- or 'ByteString' into 'Integer'.
    --
    -- For example for a text of 262144 9 digits, fold implementation
    -- takes 1.5 seconds, and 'textToInteger' just 26 milliseconds on my machine.
    -- Difference is already noticeable around 100-200 digits.
    --
    -- In particular 'read' is correct (i.e. faster) than @List.foldl'@ (better complexity),
    -- 'stringToInteger' is a bit faster than 'read' (same complexity, lower coeffcient).
    --
    module Data.Integer.Conversion (
        textToInteger,
        byteStringToInteger,
        stringToInteger,
        stringToIntegerWithLen,
    ) where

    import Control.Monad.ST     (ST, runST)
    import Data.ByteString      (ByteString)
    import Data.Char            (ord)
    import Data.Primitive.Array (MutableArray, newArray, readArray, writeArray)
    import Data.Text.Internal   (Text (..))
    import Data.Word            (Word8)

    import qualified Data.ByteString as BS
    import qualified Data.List       as L
    import qualified Data.Text       as T

    -- $setup
    -- >>> :set -XOverloadedStrings

    -------------------------------------------------------------------------------
    -- Text
    -------------------------------------------------------------------------------

    -- | Convert 'Text' to 'Integer'.
    --
    -- Semantically same as @T.foldl' (\acc c -> acc * 10 + toInteger (ord c - 48)) 0@,
    -- but this is more efficient.
    --
    -- >>> textToInteger "123456789"
    -- 123456789
    --
    -- For non-decimal inputs some nonsense is calculated
    --
    -- >>> textToInteger "foobar"
    -- 6098556
    --
    textToInteger :: Text -> Integer
    textToInteger :: Text -> Integer
    textToInteger t :: Text
    t@(Text Array
    _arr Int
    _off Int
    len)
        -- len >= 20000 = algorithmL 10 (T.length t) [ toInteger (ord c - 48) | c <- T.unpack t ]
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    40    = Text -> Integer
    complexTextToInteger Text
    t
        | Bool
    otherwise    = Text -> Integer
    simpleTextToInteger Text
    t

    simpleTextToInteger :: Text -> Integer
    simpleTextToInteger :: Text -> Integer
    simpleTextToInteger = (Integer -> Char -> Integer) -> Integer -> Text -> Integer
    forall a. (a -> Char -> a) -> a -> Text -> a
    T.foldl' (\Integer
    acc Char
    c -> Integer
    acc Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Char -> Integer
    fromChar Char
    c) Integer
    0

    -- Text doesn't have cheap length:
    --
    -- * We can (over)estimate the size of the needed buffer by the length of text's underlying bytearray.
    -- * As we don't know whether the length is even or odd, we cannot do the first pass,
    --   so we just copy the contents of given Text as is first.
    --
    complexTextToInteger :: Text -> Integer
    complexTextToInteger :: Text -> Integer
    complexTextToInteger t0 :: Text
    t0@(Text Array
    _ Int
    _ Int
    len) = (forall s. ST s Integer) -> Integer
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s Integer) -> Integer)
    -> (forall s. ST s Integer) -> Integer
    forall a b. (a -> b) -> a -> b
    $ do
        arr <- Int -> Integer -> ST s (MutableArray (PrimState (ST s)) Integer)
    forall (m :: * -> *) a.
    PrimMonad m =>
    Int -> a -> m (MutableArray (PrimState m) a)
    newArray Int
    len Integer
    integer0 -- we overestimate the size here
        loop arr t0 0
      where
        loop :: MutableArray s Integer -> Text -> Int -> ST s Integer
        loop :: forall s. MutableArray s Integer -> Text -> Int -> ST s Integer
    loop !MutableArray s Integer
    arr !Text
    t !Int
    o = case Text -> Maybe (Char, Text)
    T.uncons Text
    t of
            Just (Char
    c, Text
    t') -> do
                MutableArray (PrimState (ST s)) Integer
    -> Int -> Integer -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MutableArray (PrimState m) a -> Int -> a -> m ()
    writeArray MutableArray s Integer
    MutableArray (PrimState (ST s)) Integer
    arr Int
    o (Integer -> ST s ()) -> Integer -> ST s ()
    forall a b. (a -> b) -> a -> b
    $! Char -> Integer
    fromChar Char
    c
                MutableArray s Integer -> Text -> Int -> ST s Integer
    forall s. MutableArray s Integer -> Text -> Int -> ST s Integer
    loop MutableArray s Integer
    arr Text
    t' (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            Maybe (Char, Text)
    Nothing -> MutableArray s Integer -> Int -> Integer -> ST s Integer
    forall s. MutableArray s Integer -> Int -> Integer -> ST s Integer
    algorithm MutableArray s Integer
    arr Int
    o Integer
    10

    fromChar :: Char -> Integer
    fromChar :: Char -> Integer
    fromChar Char
    c = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    48 :: Int)
    {-# INLINE fromChar #-}

    -------------------------------------------------------------------------------
    -- ByteString
    -------------------------------------------------------------------------------

    -- | Convert 'ByteString' to 'Integer'.
    --
    -- Semantically same as @BS.foldl' (\acc c -> acc * 10 + toInteger c - 48) 0@,
    -- but this is more efficient.
    --
    -- >>> byteStringToInteger "123456789"
    -- 123456789
    --
    -- For non-decimal inputs some nonsense is calculated
    --
    -- >>> byteStringToInteger "foobar"
    -- 6098556
    --
    byteStringToInteger :: ByteString -> Integer
    byteStringToInteger :: ByteString -> Integer
    byteStringToInteger ByteString
    bs
        -- len >= 20000 = algorithmL 10 len [ toInteger w - 48 | w <- BS.unpack bs ]
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    40    = Int -> ByteString -> Integer
    complexByteStringToInteger Int
    len ByteString
    bs
        | Bool
    otherwise    = ByteString -> Integer
    simpleByteStringToInteger ByteString
    bs
      where
        !len :: Int
    len = ByteString -> Int
    BS.length ByteString
    bs

    simpleByteStringToInteger :: BS.ByteString -> Integer
    simpleByteStringToInteger :: ByteString -> Integer
    simpleByteStringToInteger = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
    forall a. (a -> Word8 -> a) -> a -> ByteString -> a
    BS.foldl' (\Integer
    acc Word8
    w -> Integer
    acc Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Word8 -> Integer
    fromWord8 Word8
    w) Integer
    0

    complexByteStringToInteger :: Int -> BS.ByteString -> Integer
    complexByteStringToInteger :: Int -> ByteString -> Integer
    complexByteStringToInteger Int
    len ByteString
    bs = (forall s. ST s Integer) -> Integer
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s Integer) -> Integer)
    -> (forall s. ST s Integer) -> Integer
    forall a b. (a -> b) -> a -> b
    $ do
        arr <- Int -> Integer -> ST s (MutableArray (PrimState (ST s)) Integer)
    forall (m :: * -> *) a.
    PrimMonad m =>
    Int -> a -> m (MutableArray (PrimState m) a)
    newArray Int
    len' Integer
    0

        if even len
        then do
            loop arr 0 0
        else do
            writeArray arr 0 $! indexBS bs 0
            loop arr 1 1
      where
        len' :: Int
    len' = (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2

        loop :: MutableArray s Integer -> Int -> Int -> ST s Integer
        loop :: forall s. MutableArray s Integer -> Int -> Int -> ST s Integer
    loop !MutableArray s Integer
    arr !Int
    i !Int
    o | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len = do
            MutableArray (PrimState (ST s)) Integer
    -> Int -> Integer -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MutableArray (PrimState m) a -> Int -> a -> m ()
    writeArray MutableArray s Integer
    MutableArray (PrimState (ST s)) Integer
    arr Int
    o (Integer -> ST s ()) -> Integer -> ST s ()
    forall a b. (a -> b) -> a -> b
    $! ByteString -> Int -> Integer
    indexBS ByteString
    bs Int
    i Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + ByteString -> Int -> Integer
    indexBS ByteString
    bs (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            MutableArray s Integer -> Int -> Int -> ST s Integer
    forall s. MutableArray s Integer -> Int -> Int -> ST s Integer
    loop MutableArray s Integer
    arr (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
        loop MutableArray s Integer
    arr Int
    _ Int
    _ = MutableArray s Integer -> Int -> Integer -> ST s Integer
    forall s. MutableArray s Integer -> Int -> Integer -> ST s Integer
    algorithm MutableArray s Integer
    arr Int
    len' Integer
    100

    indexBS :: BS.ByteString -> Int -> Integer
    indexBS :: ByteString -> Int -> Integer
    indexBS ByteString
    bs Int
    i = Word8 -> Integer
    fromWord8 (HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    BS.index ByteString
    bs Int
    i)
    {-# INLINE indexBS #-}

    fromWord8 :: Word8 -> Integer
    fromWord8 :: Word8 -> Integer
    fromWord8 Word8
    w = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    48 :: Int)
    {-# INLINE fromWord8 #-}

    -------------------------------------------------------------------------------
    -- String
    -------------------------------------------------------------------------------

    -- | Convert 'String' to 'Integer'.
    --
    -- Semantically same as @List.foldl' (\acc c -> acc * 10 + toInteger c - 48) 0@,
    -- but this is more efficient.
    --
    -- >>> stringToInteger "123456789"
    -- 123456789
    --
    -- For non-decimal inputs some nonsense is calculated
    --
    -- >>> stringToInteger "foobar"
    -- 6098556
    --
    stringToInteger :: String -> Integer
    stringToInteger :: String -> Integer
    stringToInteger String
    str = String -> Int -> Integer
    stringToIntegerWithLen String
    str (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str)

    -- | Convert 'String' to 'Integer' when you know the length beforehand.
    --
    -- >>> stringToIntegerWithLen "123" 3
    -- 123
    --
    -- If the length is wrong, you may get wrong results.
    -- (Simple algorithm is used for short strings).
    --
    -- >>> stringToIntegerWithLen (replicate 40 '0' ++ "123") 45
    -- 12300
    --
    -- >>> stringToIntegerWithLen (replicate 40 '0' ++ "123") 44
    -- 1200
    --
    -- >>> stringToIntegerWithLen (replicate 40 '0' ++ "123") 42
    -- 12
    --
    stringToIntegerWithLen :: String -> Int -> Integer
    stringToIntegerWithLen :: String -> Int -> Integer
    stringToIntegerWithLen String
    str Int
    len
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    40    = Int -> String -> Integer
    complexStringToInteger Int
    len String
    str
        | Bool
    otherwise    = String -> Integer
    simpleStringToInteger String
    str

    simpleStringToInteger :: String -> Integer
    simpleStringToInteger :: String -> Integer
    simpleStringToInteger = (Integer -> Char -> Integer) -> Integer -> String -> Integer
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' Integer -> Char -> Integer
    step Integer
    0 where
      step :: Integer -> Char -> Integer
    step Integer
    a Char
    b = Integer
    a Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Char -> Integer
    fromChar Char
    b

    complexStringToInteger :: Int -> String -> Integer
    complexStringToInteger :: Int -> String -> Integer
    complexStringToInteger Int
    len String
    str = (forall s. ST s Integer) -> Integer
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s Integer) -> Integer)
    -> (forall s. ST s Integer) -> Integer
    forall a b. (a -> b) -> a -> b
    $ do
        arr <- Int -> Integer -> ST s (MutableArray (PrimState (ST s)) Integer)
    forall (m :: * -> *) a.
    PrimMonad m =>
    Int -> a -> m (MutableArray (PrimState m) a)
    newArray Int
    len' Integer
    integer0
        if even len
        then loop arr str     0
        else case str of
            []   -> Integer -> ST s Integer
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    integer0 -- cannot happen, length is odd! but could, via stringToIntegerWithLen.
            Char
    a:String
    bs -> do
                MutableArray (PrimState (ST s)) Integer
    -> Int -> Integer -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MutableArray (PrimState m) a -> Int -> a -> m ()
    writeArray MutableArray s Integer
    MutableArray (PrimState (ST s)) Integer
    arr Int
    0 (Integer -> ST s ()) -> Integer -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Char -> Integer
    fromChar Char
    a
                MutableArray s Integer -> String -> Int -> ST s Integer
    forall s. MutableArray s Integer -> String -> Int -> ST s Integer
    loop MutableArray s Integer
    arr String
    bs Int
    1
      where
        len' :: Int
    len' = (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2

        loop :: MutableArray s Integer -> String -> Int -> ST s Integer
        loop :: forall s. MutableArray s Integer -> String -> Int -> ST s Integer
    loop !MutableArray s Integer
    arr (Char
    a:Char
    b:String
    cs) !Int
    o | Int
    o Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len' = do
            MutableArray (PrimState (ST s)) Integer
    -> Int -> Integer -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MutableArray (PrimState m) a -> Int -> a -> m ()
    writeArray MutableArray s Integer
    MutableArray (PrimState (ST s)) Integer
    arr Int
    o (Integer -> ST s ()) -> Integer -> ST s ()
    forall a b. (a -> b) -> a -> b
    $! Char -> Integer
    fromChar Char
    a Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Char -> Integer
    fromChar Char
    b
            MutableArray s Integer -> String -> Int -> ST s Integer
    forall s. MutableArray s Integer -> String -> Int -> ST s Integer
    loop MutableArray s Integer
    arr String
    cs (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
        loop MutableArray s Integer
    arr String
    _ Int
    _ = MutableArray s Integer -> Int -> Integer -> ST s Integer
    forall s. MutableArray s Integer -> Int -> Integer -> ST s Integer
    algorithm MutableArray s Integer
    arr Int
    len' Integer
    100

    -------------------------------------------------------------------------------
    -- Algorithm
    -------------------------------------------------------------------------------

    -- The core of algorithm uses mutable arrays.
    -- An alternative (found in e.g. @base@) uses lists.
    -- For very big integers (thousands of decimal digits) the difference
    -- is small (runtime is dominated by integer multiplication),
    -- but for medium sized integers this is slightly faster, as we avoid cons cell allocation.
    --
    algorithm
        :: forall s. MutableArray s Integer  -- ^ working buffer
        -> Int                               -- ^ buffer size
        -> Integer                           -- ^ base
        -> ST s Integer
    algorithm :: forall s. MutableArray s Integer -> Int -> Integer -> ST s Integer
    algorithm !MutableArray s Integer
    arr !Int
    len !Integer
    base
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    40 = Integer -> Int -> ST s Integer
    finish Integer
    0 Int
    0
        | Int -> Bool
    forall a. Integral a => a -> Bool
    even Int
    len  = Int -> Int -> ST s Integer
    loop Int
    0 Int
    0
        | Bool
    otherwise = Int -> Int -> ST s Integer
    loop Int
    1 Int
    1
      where
        loop :: Int -> Int -> ST s Integer
        loop :: Int -> Int -> ST s Integer
    loop !Int
    i !Int
    o | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len = do
            -- read at i, i +1
            a <- MutableArray (PrimState (ST s)) Integer -> Int -> ST s Integer
    forall (m :: * -> *) a.
    PrimMonad m =>
    MutableArray (PrimState m) a -> Int -> m a
    readArray MutableArray s Integer
    MutableArray (PrimState (ST s)) Integer
    arr Int
    i
            b <- readArray arr (i + 1)

            -- rewrite with constant to release memory
            writeArray arr i       integer0
            writeArray arr (i + 1) integer0

            -- write at o
            writeArray arr o $! a * base + b

            -- continue
            loop (i + 2) (o + 1)

        loop Int
    _ Int
    _ = MutableArray s Integer -> Int -> Integer -> ST s Integer
    forall s. MutableArray s Integer -> Int -> Integer -> ST s Integer
    algorithm MutableArray s Integer
    arr Int
    len' Integer
    base'
          where
            !base' :: Integer
    base' = Integer
    base Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    base
            !len' :: Int
    len'  = (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2

        finish :: Integer -> Int -> ST s Integer
        finish :: Integer -> Int -> ST s Integer
    finish !Integer
    acc !Int
    i | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len = do
            a <- MutableArray (PrimState (ST s)) Integer -> Int -> ST s Integer
    forall (m :: * -> *) a.
    PrimMonad m =>
    MutableArray (PrimState m) a -> Int -> m a
    readArray MutableArray s Integer
    MutableArray (PrimState (ST s)) Integer
    arr Int
    i
            finish (acc * base + a) (i + 1)
        finish !Integer
    acc !Int
    _ =
            Integer -> ST s Integer
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    acc

    -------------------------------------------------------------------------------
    -- List variant
    -------------------------------------------------------------------------------

    {-

    -- | A sub-quadratic algorithm implementation using lists.
    --
    -- Sometimes this is faster, but I fail to quantify when exactly.
    --
    algorithmL
        :: Integer    -- ^ base
        -> Int        -- ^ length of digits
        -> [Integer]  -- ^ digits
        -> Integer
    algorithmL = go
      where
        go :: Integer -> Int -> [Integer] -> Integer
        go _ _ []  = 0
        go _ _ [d] = d
        go b l ds
            | l > 40 = b' `seq` go b' l' (combine b ds')
            | otherwise = finishAlgorithmL b ds
          where
            -- ensure that we have an even number of digits
            -- before we call combine:
            ds' = if even l then ds else 0 : ds
            b' = b * b
            l' = (l + 1) `quot` 2

        combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
          where
            d = d1 * b + d2
        combine _ []  = []
        combine _ [_] = errorWithoutStackTrace "this should not happen"

    -- | The following algorithm is only linear for types whose Num operations
    -- are in constant time.
    --
    -- We export this (mostly) for testing purposes.
    --
    finishAlgorithmL :: Integer -> [Integer] -> Integer
    finishAlgorithmL base = go 0
      where
        go r [] = r
        go r (d : ds) = r' `seq` go r' ds
          where
            r' = r * base + fromIntegral d
    -}

    -------------------------------------------------------------------------------
    -- Misc
    -------------------------------------------------------------------------------

    integer0 :: Integer
    integer0 :: Integer
    integer0 = Integer
    0