{-# LANGUAGE CPP #-}

-- |
-- Module:    Data.Text.Internal.Builder.RealFloat.Functions
-- Copyright: (c) The University of Glasgow 1994-2002
-- License:   see libraries/base/LICENSE
--
-- /Warning/: this is an internal module, and does not have a stable
-- API or name. Functions in this module may not check or enforce
-- preconditions expected by public modules. Use at your own risk!

module Data.Text.Internal.Builder.RealFloat.Functions
    (
      roundTo
    ) where

roundTo :: Int -> [Int] -> (Int,[Int])

#if MIN_VERSION_base(4,6,0)

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
  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
  base :: Int
base = Int
10

#else

roundTo d is =
  case f d is of
    x@(0,_) -> x
    (1,xs)  -> (1, 1:xs)
    _       -> error "roundTo: bad Value"
 where
  f n []     = (0, replicate n 0)
  f 0 (x:_)  = (if x >= 5 then 1 else 0, [])
  f n (i:xs)
     | i' == 10  = (1,0:ds)
     | otherwise = (0,i':ds)
      where
       (c,ds) = f (n-1) xs
       i'     = c + i

#endif