-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
-- HasCallStack is redundant only if -O is passed.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- | Miscellaneous functions on numbers.  Things that could have gone in
-- Numeric.
module Util.Num where
import           Prelude hiding (sum)
import qualified Control.Exception as Exception
import           Data.Bifunctor (second)
import qualified Data.Bits as Bits
import qualified Data.Fixed as Fixed
import qualified Data.List as List
import qualified Data.Text as Text
import           Data.Text (Text)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Text.Lazy.Builder
import qualified Data.Text.Lazy.Builder.RealFloat as Lazy.Builder.RealFloat

import qualified GHC.Prim as Prim
import qualified GHC.Types as Types
import qualified Numeric

import qualified GHC.Stack as Stack


-- * show

-- | Show a word as binary.
--
-- Warning: for some reason, Integer is an instance of Bits, but bitSize will
-- crash.
binary :: Bits.Bits a => a -> String
binary :: forall a. Bits a => a -> String
binary a
b = case a -> Maybe Int
forall a. Bits a => a -> Maybe Int
Bits.bitSizeMaybe a
b of
    Maybe Int
Nothing -> String
""
    Just Int
bits -> (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
extract [Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2 .. Int
0]
    where
    extract :: Int -> Char
extract Int
i = if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit a
b Int
i then Char
'1' else Char
'0'

hex :: (Integral a, Show a) => Int -> a -> Text
hex :: forall a. (Integral a, Show a) => Int -> a -> Text
hex Int
pad a
n = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then Text
"-" else Text
""
    , Int -> Text -> Text
Text.replicate (Int
pad Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
s) Text
"0"
    , Text
s
    ]
    where s :: Text
s = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
Numeric.showHex (a -> a
forall a. Num a => a -> a
abs a
n) String
""

showHigit :: Int -> Maybe Char
showHigit :: Int -> Maybe Char
showHigit Int
c = case Int
c of
    Int
0 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'0'; Int
1 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'1'; Int
2 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'2'; Int
3 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'3'
    Int
4 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'4'; Int
5 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'5'; Int
6 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'6'; Int
7 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'7'
    Int
8 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'8'; Int
9 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'9'; Int
10 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'a'; Int
11 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'b'
    Int
12 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'c'; Int
13 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'd'; Int
14 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'e'; Int
15 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'f'
    Int
_ -> Maybe Char
forall a. Maybe a
Nothing

zeroPad :: Show a => Int -> a -> Text
zeroPad :: forall a. Show a => Int -> a -> Text
zeroPad Int
digits a
n = Int -> Text -> Text
Text.replicate (Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
s) Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
    where s :: Text
s = String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
n)

-- | Display a float with the given precision, dropping trailing and leading
-- zeros.  Haskell requires a 0 before the decimal point, so this produces
-- non-Haskell numbers.
showFloat :: RealFloat a => Int -> a -> Text
showFloat :: forall a. RealFloat a => Int -> a -> Text
showFloat Int
precision = Text -> Text
drop0 (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> a -> Text
forall a. RealFloat a => Maybe Int -> a -> Text
showFloat0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
precision)
    where
    drop0 :: Text -> Text
drop0 Text
t
        | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0" = Text
"0"
        | Just Text
rest <- Text -> Text -> Maybe Text
Text.stripPrefix Text
"-0." Text
t = Text
"-." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest
        | Just Text
rest <- Text -> Text -> Maybe Text
Text.stripPrefix Text
"0." Text
t = Char -> Text -> Text
Text.cons Char
'.' Text
rest
        | Bool
otherwise = Text
t

-- | Fancy decimal float formatting.  Show up to the given precision, like
-- 'showFloat', unless it would be all 0s.  In that case, show the minimum
-- necessary to get to a non-zero.
showFloatP :: RealFloat a => Bool -> Int -> a -> Text
showFloatP :: forall a. RealFloat a => Bool -> Int -> a -> Text
showFloatP Bool
leadingZero Int
precision a
num
    | a
num a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = if a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
num then Text
"-0" else Text
"0"
    | (Char -> Bool) -> Text -> Bool
Text.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') Text
inPrecision =
        Text -> Text
prependInt (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') (Text -> Text
strip0 Text
frac)
    | Bool
otherwise = Text -> Text
prependInt (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
strip0 Text
inPrecision
    where
    numS :: Text
numS = Maybe Int -> a -> Text
forall a. RealFloat a => Maybe Int -> a -> Text
showFloat0 Maybe Int
forall a. Maybe a
Nothing a
num
    (Text
int, Text
frac) = (Text -> Text) -> (Text, Text) -> (Text, Text)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> Text -> Text
Text.drop Int
1) ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') Text
numS
    intS :: Text
intS = (if Bool
leadingZero then Text -> Text
forall a. a -> a
id else Text -> Text
drop0) Text
int Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    inPrecision :: Text
inPrecision = Int -> Text -> Text
Text.take Int
precision Text
frac
    takeWhile1 :: (Char -> Bool) -> Text -> Text
takeWhile1 Char -> Bool
f Text
t = Int -> Text -> Text
Text.take (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
Text.length ((Char -> Bool) -> Text -> Text
Text.takeWhile Char -> Bool
f Text
t)) Text
t
    prependInt :: Text -> Text
prependInt = (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
intS<>)

    drop0 :: Text -> Text
drop0 Text
t
        | Text
"-0" Text -> Text -> Bool
`Text.isPrefixOf` Text
t = Text
"-"
        | Text
"0" Text -> Text -> Bool
`Text.isPrefixOf` Text
t = Text
""
        | Bool
otherwise = Text
t
    strip0 :: Text -> Text
strip0 = (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0')

-- | Like 'showFloat', but use a leading 0, so haskell can parse it.
showFloat0 :: RealFloat a => Maybe Int -> a -> Text
showFloat0 :: forall a. RealFloat a => Maybe Int -> a -> Text
showFloat0 Maybe Int
precision =
    Text -> Text
dropTrailing0 (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Text.Lazy.Builder.toLazyText
    (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> a -> Builder
forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
Lazy.Builder.RealFloat.formatRealFloat FPFormat
Lazy.Builder.RealFloat.Fixed
        Maybe Int
precision
    where
    dropTrailing0 :: Text -> Text
dropTrailing0
        | Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) Maybe Int
precision =
            (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0')
        | Bool
otherwise = Text -> Text
forall a. a -> a
id

-- * assert

-- | Like @div@, but assert that it divides evenly.
assertDiv :: Stack.HasCallStack => Integral a => a -> a -> a
assertDiv :: forall a. (HasCallStack, Integral a) => a -> a -> a
assertDiv a
a a
b = Bool -> a -> a
forall a. HasCallStack => Bool -> a -> a
Exception.assert (a
a a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
b

assertIntegral :: (Stack.HasCallStack, RealFrac f, Integral i) => f -> i
assertIntegral :: forall f i. (HasCallStack, RealFrac f, Integral i) => f -> i
assertIntegral f
frac = Bool -> i -> i
forall a. HasCallStack => Bool -> a -> a
Exception.assert (f
f f -> f -> Bool
forall a. Eq a => a -> a -> Bool
== f
0) i
i
    where (i
i, f
f) = f -> (i, f)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction f
frac

-- * read

readDigit :: Char -> Maybe Int
readDigit :: Char -> Maybe Int
readDigit Char
c = case Char
c of
    Char
'0' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0; Char
'1' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1; Char
'2' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2; Char
'3' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3; Char
'4' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
    Char
'5' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5; Char
'6' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6; Char
'7' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
7; Char
'8' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8; Char
'9' -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
9
    Char
_ -> Maybe Int
forall a. Maybe a
Nothing

-- * transform

-- | Prelude sum is lazy, for silly reasons.
sum :: (Foldable t, Num a) => t a -> a
sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum = (a -> a -> a) -> a -> t a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

roundDigits :: (RealFrac a, Fractional b) => Int -> a -> b
roundDigits :: forall a b. (RealFrac a, Fractional b) => Int -> a -> b
roundDigits Int
digits = (b -> b -> b
forall a. Fractional a => a -> a -> a
/ (b
10b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^Int
digits)) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> b) -> (a -> Integer) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Integer) -> (a -> a) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
* (a
10a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
digits))

-- | Round up to the nearest factor above the given number.
roundUp :: (Integral factor, Real a) => factor -> a -> factor
roundUp :: forall factor a. (Integral factor, Real a) => factor -> a -> factor
roundUp factor
factor a
n =
    Double -> factor
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ factor -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (factor -> factor
forall a. Num a => a -> a
abs factor
factor)) factor -> factor -> factor
forall a. Num a => a -> a -> a
* factor -> factor
forall a. Num a => a -> a
abs factor
factor
{-# INLINEABLE roundUp #-}

roundDown :: (Integral factor, Real a) => factor -> a -> factor
roundDown :: forall factor a. (Integral factor, Real a) => factor -> a -> factor
roundDown factor
factor a
n =
    Double -> factor
forall a b. (RealFrac a, Integral b) => a -> b
floor (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ factor -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (factor -> factor
forall a. Num a => a -> a
abs factor
factor)) factor -> factor -> factor
forall a. Num a => a -> a -> a
* factor -> factor
forall a. Num a => a -> a
abs factor
factor
{-# INLINEABLE roundDown #-}

roundDownD :: Double -> Double -> Double
roundDownD :: Double -> Double -> Double
roundDownD Double
factor Double
n = Double -> Double
floorD (Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Num a => a -> a
abs Double
factor) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Num a => a -> a
abs Double
factor

roundToD :: Double -> Double -> Double
roundToD :: Double -> Double -> Double
roundToD Double
factor Double
n = Double -> Double
roundD (Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Num a => a -> a
abs Double
factor) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Num a => a -> a
abs Double
factor

-- | Clamp a value to be between @low@ and @high@.
clamp :: Ord a => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
low a
high = a -> a -> a
forall a. Ord a => a -> a -> a
min a
high (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
max a
low

-- | Confine the given value lie between the first two arguments, but using
-- modulus, not clamping.
restrict :: Real a => a -> a -> a -> a
restrict :: forall a. Real a => a -> a -> a -> a
restrict a
low a
high
    | a
high a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
low = a -> a -> a
forall a b. a -> b -> a
const a
low -- avoid dividing by 0 in fmod
    | Bool
otherwise = (a -> a -> a
forall a. Num a => a -> a -> a
+a
low) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Real a => a -> a -> a
`fmod` (a
higha -> a -> a
forall a. Num a => a -> a -> a
-a
low)) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Num a => a -> a -> a
subtract a
low

inRange :: Ord a => a -> a -> a -> Bool
inRange :: forall a. Ord a => a -> a -> a -> Bool
inRange a
low a
high a
x = a
low a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
high

-- | Scale @v@, which is between 0 and 1 inclusive, to be between @low@ and
-- @high@.  If @v@ is not in the 0--1 range, the result will be out of the
-- low--high range.
--
-- This is linear interpolate, or lerp.
{-# INLINEABLE scale #-}
{-# SPECIALIZE scale :: Double -> Double -> Double -> Double #-}
{-# SPECIALIZE scale :: Float -> Float -> Float -> Float #-}
scale :: (Eq a, Num a) => a -> a -> a -> a
scale :: forall a. (Eq a, Num a) => a -> a -> a -> a
scale a
low a
high a
v
    -- Some calls to scale are likely to have 0 or 1.  If low and high are
    -- complicated expressions its nice to avoid evaluating them.
    | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
low
    | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = a
high
    | Bool
otherwise = a
v a -> a -> a
forall a. Num a => a -> a -> a
* (a
higha -> a -> a
forall a. Num a => a -> a -> a
-a
low) a -> a -> a
forall a. Num a => a -> a -> a
+ a
low

-- | Normalize @v@, which is between @low@ and @high@ inclusive, to be between
-- 0 and 1.  As with 'scale', if @v@ is not in range, the result will not be
-- in range either.
{-# INLINEABLE normalize #-}
{-# SPECIALIZE normalize :: Double -> Double -> Double -> Double #-}
{-# SPECIALIZE normalize :: Float -> Float -> Float -> Float #-}
normalize :: (Eq a, Fractional a) => a -> a -> a -> a
normalize :: forall a. (Eq a, Fractional a) => a -> a -> a -> a
normalize a
low a
high a
v
    | a
low a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
high Bool -> Bool -> Bool
&& a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
low = a
0 -- avoid a divide by zero
    | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
high = a
1
    | Bool
otherwise = (a
va -> a -> a
forall a. Num a => a -> a -> a
-a
low) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
higha -> a -> a
forall a. Num a => a -> a -> a
-a
low)

infixl 7 `fmod` -- match `mod`

-- | fmod is in a bizarre place.
{-# SPECIALIZE fmod :: Double -> Double -> Double #-}
fmod :: Real a => a -> a -> a
fmod :: forall a. Real a => a -> a -> a
fmod = a -> a -> a
forall a. Real a => a -> a -> a
Fixed.mod'

{-# SPECIALIZE fDivMod :: Double -> Double -> (Int, Double) #-}
fDivMod :: (Integral div, RealFrac mod) => mod -> mod -> (div, mod)
fDivMod :: forall div mod.
(Integral div, RealFrac mod) =>
mod -> mod -> (div, mod)
fDivMod mod
a mod
b = (mod -> div
forall a b. (RealFrac a, Integral b) => a -> b
floor (mod
a mod -> mod -> mod
forall a. Fractional a => a -> a -> a
/ mod
b), mod -> mod -> mod
forall a. Real a => a -> a -> a
fmod mod
a mod
b)

integral :: RealFrac a => a -> Bool
integral :: forall a. RealFrac a => a -> Bool
integral = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
0) (a -> Bool) -> (a -> a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, a) -> a
forall a b. (a, b) -> b
snd ((Integer, a) -> a) -> (a -> (Integer, a)) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Integer, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction

asIntegral :: (RealFrac frac, Integral int) => frac -> Maybe int
asIntegral :: forall frac int. (RealFrac frac, Integral int) => frac -> Maybe int
asIntegral frac
n
    | frac
f frac -> frac -> Bool
forall a. Eq a => a -> a -> Bool
== frac
0 = int -> Maybe int
forall a. a -> Maybe a
Just int
i
    | Bool
otherwise = Maybe int
forall a. Maybe a
Nothing
    where (int
i, frac
f) = frac -> (int, frac)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction frac
n

-- | realToFrac doesn't preserve the special float values and is inefficient.
--
-- There are some RULEs for this, but they aren't reliable.
d2f :: Double -> Float
d2f :: Double -> Float
d2f (Types.D# Double#
d) = Float# -> Float
Types.F# (Double# -> Float#
Prim.double2Float# Double#
d)

f2d :: Float -> Double
f2d :: Float -> Double
f2d (Types.F# Float#
f) = Double# -> Double
Types.D# (Float# -> Double#
Prim.float2Double# Float#
f)

-- | Conversion that clamps at INT_MIN / INT_MAX.
d2i :: Double -> Int
d2i :: Double -> Int
d2i Double
d = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
clamp Double
minInt Double
maxInt Double
d)
    where
    maxInt :: Double
maxInt = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
    minInt :: Double
minInt = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int)

i2d :: Int -> Double
i2d :: Int -> Double
i2d = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Versions of floor and round that don't go through an int conversion.
foreign import ccall unsafe "floor" floorD :: Double -> Double
foreign import ccall unsafe "floorf" floorF :: Float -> Float
foreign import ccall unsafe "round" roundD :: Double -> Double
foreign import ccall unsafe "roundf" roundF :: Float -> Float