{-# 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 d :: Int
d is :: [Int]
is =
case Int -> Bool -> [Int] -> (Int, [Int])
f Int
d Bool
True [Int]
is of
x :: (Int, [Int])
x@(0,_) -> (Int, [Int])
x
(1,xs :: [Int]
xs) -> (1, 1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
_ -> [Char] -> (Int, [Int])
forall a. HasCallStack => [Char] -> a
error "roundTo: bad Value"
where
base :: Int
base = 10
b2 :: Int
b2 = Int
base Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 2
f :: Int -> Bool -> [Int] -> (Int, [Int])
f n :: Int
n _ [] = (0, Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n 0)
f 0 e :: Bool
e (x :: Int
x:xs :: [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
== 0) [Int]
xs = (0, [])
| Bool
otherwise = (if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b2 then 1 else 0, [])
f n :: Int
n _ (i :: Int
i:xs :: [Int]
xs)
| Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
base = (1,0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
| Bool
otherwise = (0,Int
i'Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
where
(c :: Int
c,ds :: [Int]
ds) = Int -> Bool -> [Int] -> (Int, [Int])
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-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
{-# INLINE i2d #-}
i2d :: Int -> Char
i2d :: Int -> Char
i2d (I# i# :: Int#
i#) = Char# -> Char
C# (Int# -> Char#
chr# (Char# -> Int#
ord# '0'# Int# -> Int# -> Int#
+# Int#
i# ))
maxExpt :: Int
maxExpt :: Int
maxExpt = 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 0 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 1 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
+1) (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
+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` 1
#else
!half = ix `shiftR` 1
#endif
Int -> ST s (Array Integer)
go 2
uninitialised :: error
uninitialised :: error
uninitialised = [Char] -> error
forall a. HasCallStack => [Char] -> a
error "Data.Scientific: uninitialised element"
magnitude :: Num a => Int -> a
magnitude :: Int -> a
magnitude e :: 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
* 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
- 1