{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

module Utils
    ( roundTo
    , i2d
    ) where

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

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, [])   -- 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 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

-- | Unsafe conversion for decimal digits.
{-# 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# ))