{-# LANGUAGE BangPatterns, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.PseudoBoolean.Internal.TextUtil
-- Copyright   :  (c) Masahiro Sakai 2012-2014
-- License     :  BSD-style
-- 
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (BangPatterns)
--
-----------------------------------------------------------------------------
module Data.PseudoBoolean.Internal.TextUtil
  ( readUnsignedInteger
  ) where

#include "MachDeps.h"

import Control.Exception
import Data.Word

-- | 'read' allocate too many intermediate 'Integer'.
-- Therefore we use this optimized implementation instead.
-- Many intermediate values in this implementation will be optimized
-- away by worker-wrapper transformation and unboxing.
{-# INLINABLE readUnsignedInteger #-}
readUnsignedInteger :: String -> Integer 
readUnsignedInteger :: String -> Integer
readUnsignedInteger String
str = Bool -> Integer -> Integer
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Integer
result Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Integer
forall a. Read a => String -> a
read String
str) (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
result
  where
    result :: Integer
    result :: Integer
result = Integer -> String -> Integer
go Integer
0 String
str

    lim :: Word
#if !MIN_VERSION_base(4,6,1) && WORD_SIZE_IN_BITS == 32
    {- To avoid a bug of maxBound <https://ghc.haskell.org/trac/ghc/ticket/8072> -}
    lim = 0xFFFFFFFF `div` 10
#else
    lim :: Word
lim = Word
forall a. Bounded a => a
maxBound Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
10
#endif
  
    go :: Integer -> [Char] -> Integer 
    go :: Integer -> String -> Integer
go !Integer
r [] = Integer
r
    go !Integer
r String
ds =
      case Word -> Word -> String -> (Word, Word, String)
go2 Word
0 Word
1 String
ds of
        (Word
r2,Word
b,String
ds2) -> Integer -> String -> Integer
go (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r2) String
ds2

    go2 :: Word -> Word -> [Char] -> (Word, Word, [Char])
    go2 :: Word -> Word -> String -> (Word, Word, String)
go2 !Word
r !Word
b String
dds | Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Word
b Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
r) (Word
b Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
lim) = (Word
r,Word
b,String
dds)
    go2 !Word
r !Word
b []     = (Word
r, Word
b, [])
    go2 !Word
r !Word
b (Char
d:String
ds) = Word -> Word -> String -> (Word, Word, String)
go2 (Word
rWord -> Word -> Word
forall a. Num a => a -> a -> a
*Word
10 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Char -> Word
charToWord Char
d) (Word
bWord -> Word -> Word
forall a. Num a => a -> a -> a
*Word
10) String
ds

    charToWord :: Char -> Word
    charToWord :: Char -> Word
charToWord Char
'0' = Word
0
    charToWord Char
'1' = Word
1
    charToWord Char
'2' = Word
2
    charToWord Char
'3' = Word
3
    charToWord Char
'4' = Word
4
    charToWord Char
'5' = Word
5
    charToWord Char
'6' = Word
6
    charToWord Char
'7' = Word
7
    charToWord Char
'8' = Word
8
    charToWord Char
'9' = Word
9