{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Utils
    ( roundTo
    , i2d
    , maxExpt
    , magnitude
    ) where

import GHC.Base (Int(I#), Char(C#), chr#, ord#, (+#))

import qualified Data.Primitive.Array as Primitive
import           Control.Monad.ST             (runST)

#if MIN_VERSION_base(4,5,0)
import           Data.Bits                    (unsafeShiftR)
#else
import           Data.Bits                    (shiftR)
#endif

roundTo :: Int -> [Int] -> (Int, [Int])
roundTo :: Int -> [Int] -> (Int, [Int])
roundTo Int
d [Int]
is =
  case Int -> Bool -> [Int] -> (Int, [Int])
f Int
d Bool
True [Int]
is of
    x :: (Int, [Int])
x@(Int
0,[Int]
_) -> (Int, [Int])
x
    (Int
1,[Int]
xs)  -> (Int
1, Int
1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
    (Int, [Int])
_       -> [Char] -> (Int, [Int])
forall a. HasCallStack => [Char] -> a
error [Char]
"roundTo: bad Value"
 where
  base :: Int
base = Int
10

  b2 :: Int
b2 = Int
base Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2

  f :: Int -> Bool -> [Int] -> (Int, [Int])
f Int
n Bool
_ []     = (Int
0, Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n Int
0)
  f Int
0 Bool
e (Int
x:[Int]
xs) | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b2 Bool -> Bool -> Bool
&& Bool
e Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [Int]
xs = (Int
0, [])   -- Round to even when at exactly half the base
               | Bool
otherwise = (if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b2 then Int
1 else Int
0, [])
  f Int
n Bool
_ (Int
i:[Int]
xs)
     | Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
base = (Int
1,Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
     | Bool
otherwise  = (Int
0,Int
i'Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
      where
       (Int
c,[Int]
ds) = Int -> Bool -> [Int] -> (Int, [Int])
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> Bool
forall a. Integral a => a -> Bool
even Int
i) [Int]
xs
       i' :: Int
i'     = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i

-- | Unsafe conversion for decimal digits.
{-# INLINE i2d #-}
i2d :: Int -> Char
i2d :: Int -> Char
i2d (I# Int#
i#) = Char# -> Char
C# (Int# -> Char#
chr# (Char# -> Int#
ord# Char#
'0'# Int# -> Int# -> Int#
+# Int#
i# ))

----------------------------------------------------------------------
-- Exponentiation with a cache for the most common numbers.
----------------------------------------------------------------------

-- | The same limit as in GHC.Float.
maxExpt :: Int
maxExpt :: Int
maxExpt = Int
324

expts10 :: Primitive.Array Integer
expts10 :: Array Integer
expts10 = (forall s. ST s (Array Integer)) -> Array Integer
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array Integer)) -> Array Integer)
-> (forall s. ST s (Array Integer)) -> Array Integer
forall a b. (a -> b) -> a -> b
$ do
    MutableArray s Integer
ma <- Int -> Integer -> ST s (MutableArray (PrimState (ST s)) Integer)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
Primitive.newArray Int
maxExpt Integer
forall error. error
uninitialised
    MutableArray (PrimState (ST s)) Integer
-> Int -> Integer -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
Primitive.writeArray MutableArray s Integer
MutableArray (PrimState (ST s)) Integer
ma Int
0  Integer
1
    MutableArray (PrimState (ST s)) Integer
-> Int -> Integer -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
Primitive.writeArray MutableArray s Integer
MutableArray (PrimState (ST s)) Integer
ma Int
1 Integer
10
    let go :: Int -> ST s (Array Integer)
go !Int
ix
          | Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxExpt = MutableArray (PrimState (ST s)) Integer -> ST s (Array Integer)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
Primitive.unsafeFreezeArray MutableArray s Integer
MutableArray (PrimState (ST s)) Integer
ma
          | Bool
otherwise = do
              MutableArray (PrimState (ST s)) Integer
-> Int -> Integer -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
Primitive.writeArray MutableArray s Integer
MutableArray (PrimState (ST s)) Integer
ma  Int
ix        Integer
xx
              MutableArray (PrimState (ST s)) Integer
-> Int -> Integer -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
Primitive.writeArray MutableArray s Integer
MutableArray (PrimState (ST s)) Integer
ma (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Integer
10Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
xx)
              Int -> ST s (Array Integer)
go (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
          where
            xx :: Integer
xx = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x
            x :: Integer
x  = Array Integer -> Int -> Integer
forall a. Array a -> Int -> a
Primitive.indexArray Array Integer
expts10 Int
half
#if MIN_VERSION_base(4,5,0)
            !half :: Int
half = Int
ix Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
#else
            !half = ix `shiftR` 1
#endif
    Int -> ST s (Array Integer)
go Int
2

uninitialised :: error
uninitialised :: error
uninitialised = [Char] -> error
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Scientific: uninitialised element"

-- | @magnitude e == 10 ^ e@
magnitude :: Num a => Int -> a
magnitude :: Int -> a
magnitude Int
e | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxExpt = Int -> a
cachedPow10 Int
e
            | Bool
otherwise   = Int -> a
cachedPow10 Int
hi a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hi)
    where
      cachedPow10 :: Int -> a
cachedPow10 = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> (Int -> Integer) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Integer -> Int -> Integer
forall a. Array a -> Int -> a
Primitive.indexArray Array Integer
expts10

      hi :: Int
hi = Int
maxExpt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1