{-# LANGUAGE NoImplicitPrelude #-}
module Numeric.Floating.IEEE.Internal.Base
  ( isFloatBinary32
  , isDoubleBinary64
  , minPositive
  , minPositiveNormal
  , maxFinite
  , (^!)
  , negateIntAsWord
  , absIntAsWord
  ) where
import           Data.Bits
import           MyPrelude

default ()

-- $setup
-- >>> :set -XHexFloatLiterals -XNumericUnderscores
-- >>> import Numeric.Floating.IEEE.Internal.NextFloat (nextDown)
-- >>> import Numeric.Floating.IEEE.Internal.Base

isFloatBinary32 :: Bool
isFloatBinary32 :: Bool
isFloatBinary32 = Float -> Bool
forall a. RealFloat a => a -> Bool
isIEEE Float
x
                  Bool -> Bool -> Bool
&& Float -> Integer
forall a. RealFloat a => a -> Integer
floatRadix Float
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2
                  Bool -> Bool -> Bool
&& Float -> Int
forall a. RealFloat a => a -> Int
floatDigits Float
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
24
                  Bool -> Bool -> Bool
&& Float -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange Float
x (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
125, Int
128)
  where x :: Float
        x :: Float
x = Float
forall a. HasCallStack => a
undefined

isDoubleBinary64 :: Bool
isDoubleBinary64 :: Bool
isDoubleBinary64 = Double -> Bool
forall a. RealFloat a => a -> Bool
isIEEE Double
x
                   Bool -> Bool -> Bool
&& Double -> Integer
forall a. RealFloat a => a -> Integer
floatRadix Double
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2
                   Bool -> Bool -> Bool
&& Double -> Int
forall a. RealFloat a => a -> Int
floatDigits Double
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
53
                   Bool -> Bool -> Bool
&& Double -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange Double
x (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1021, Int
1024)
  where x :: Double
        x :: Double
x = Double
forall a. HasCallStack => a
undefined

-- |
-- The smallest positive value expressible in an IEEE floating-point format.
-- This value is subnormal.
--
-- >>> (minPositive :: Float) == 0x1p-149
-- True
-- >>> (minPositive :: Double) == 0x1p-1074
-- True
-- >>> nextDown (minPositive :: Float)
-- 0.0
-- >>> nextDown (minPositive :: Double)
-- 0.0
minPositive :: RealFloat a => a
minPositive :: forall a. RealFloat a => a
minPositive = let d :: Int
d = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
                  (Int
expMin,Int
_expMax) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
                  x :: a
x = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
1 (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
              in a
x
{-# INLINABLE minPositive #-}
{-# SPECIALIZE minPositive :: Float, Double #-}

-- |
-- The smallest positive normal value expressible in an IEEE floating-point format.
--
-- >>> (minPositiveNormal :: Float) == 0x1p-126
-- True
-- >>> (minPositiveNormal :: Double) == 0x1p-1022
-- True
-- >>> isDenormalized (minPositiveNormal :: Float)
-- False
-- >>> isDenormalized (minPositiveNormal :: Double)
-- False
-- >>> isDenormalized (nextDown (minPositiveNormal :: Float))
-- True
-- >>> isDenormalized (nextDown (minPositiveNormal :: Double))
-- True
minPositiveNormal :: RealFloat a => a
minPositiveNormal :: forall a. RealFloat a => a
minPositiveNormal = let (Int
expMin,Int
_expMax) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
                        x :: a
x = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
1 (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    in a
x
{-# INLINABLE minPositiveNormal #-}
{-# SPECIALIZE minPositiveNormal :: Float, Double #-}

-- |
-- The largest finite value expressible in an IEEE floating-point format.
--
-- >>> (maxFinite :: Float) == 0x1.fffffep+127
-- True
-- >>> (maxFinite :: Double) == 0x1.ffff_ffff_ffff_fp+1023
-- True
maxFinite :: RealFloat a => a
maxFinite :: forall a. RealFloat a => a
maxFinite = let d :: Int
d = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
                (Int
_expMin,Int
expMax) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
                r :: Integer
r = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x
                x :: a
x = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
r Integer -> Int -> Integer
^! Int
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (Int
expMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
            in a
x
{-# INLINABLE maxFinite #-}
{-# SPECIALIZE maxFinite :: Float, Double #-}

-- A variant of (^) that allows constant folding
infixr 8 ^!
(^!) :: Integer -> Int -> Integer
^! :: Integer -> Int -> Integer
(^!) = Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
(^)
{-# INLINE [0] (^!) #-}

pow_helper :: Bool -> Integer -> Int -> Integer
pow_helper :: Bool -> Integer -> Int -> Integer
pow_helper Bool
_ Integer
x Int
y = Integer
x Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
y
{-# INLINE [0] pow_helper #-}
{-# RULES
"x^!" forall x y. x ^! y = pow_helper (y > 0) x y
"pow_helper/2" forall y.
  pow_helper True 2 y = bit y
"pow_helper" forall x y.
  pow_helper True x y = if y `rem` 2 == 0 then
                          (x * x) ^! (y `quot` 2)
                        else
                          x * (x * x) ^! (y `quot` 2)
  #-}

-- |
-- >>> negateIntAsWord minBound == fromInteger (negate (fromIntegral (minBound :: Int)))
-- True
negateIntAsWord :: Int -> Word
negateIntAsWord :: Int -> Word
negateIntAsWord Int
x = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
negate Int
x)

-- |
-- >>> absIntAsWord minBound == fromInteger (abs (fromIntegral (minBound :: Int)))
-- True
absIntAsWord :: Int -> Word
absIntAsWord :: Int -> Word
absIntAsWord Int
x = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
abs Int
x)

{- More careful definitions:

negateIntAsWord :: Int -> Word
negateIntAsWord x | x == minBound = fromInteger (negate (fromIntegral (minBound :: Int)))
                  | otherwise = fromIntegral (negate x)

absIntAsWord :: Int -> Word
absIntAsWord x | x == minBound = fromInteger (abs (fromIntegral (minBound :: Int)))
               | otherwise = fromIntegral (abs x)
-}