{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE BangPatterns #-}
module Numeric.Floating.IEEE.Internal.NextFloat where
import           Data.Bits
import           GHC.Float.Compat (castDoubleToWord64, castFloatToWord32,
                                   castWord32ToFloat, castWord64ToDouble)
import           MyPrelude
import           Numeric.Floating.IEEE.Internal.Base

default ()

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

-- |
-- Returns the smallest value that is larger than the argument.
--
-- IEEE 754 @nextUp@ operation.
--
-- >>> nextUp 1 == (0x1.000002p0 :: Float)
-- True
-- >>> nextUp 1 == (0x1.0000_0000_0000_1p0 :: Double)
-- True
-- >>> nextUp (1/0) == (1/0 :: Double)
-- True
-- >>> nextUp (-1/0) == (- maxFinite :: Double)
-- True
-- >>> nextUp 0 == (0x1p-1074 :: Double)
-- True
-- >>> nextUp (-0) == (0x1p-1074 :: Double)
-- True
-- >>> nextUp (-0x1p-1074) :: Double -- returns negative zero
-- -0.0
nextUp :: RealFloat a => a -> a
nextUp :: forall a. RealFloat a => a -> a
nextUp a
x | Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isIEEE a
x) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"non-IEEE numbers are not supported"
         | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| (a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x -- NaN or positive infinity
         | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = a -> a
forall a. RealFloat a => a -> a
nextUp_positive a
x
         | Bool
otherwise = - a -> a
forall a. RealFloat a => a -> a
nextDown_positive (- a
x)
{-# INLINE [1] nextUp #-}

-- |
-- Returns the largest value that is smaller than the argument.
--
-- IEEE 754 @nextDown@ operation.
--
-- >>> nextDown 1 == (0x1.ffff_ffff_ffff_fp-1 :: Double)
-- True
-- >>> nextDown 1 == (0x1.fffffep-1 :: Float)
-- True
-- >>> nextDown (1/0) == (maxFinite :: Double)
-- True
-- >>> nextDown (-1/0) == (-1/0 :: Double)
-- True
-- >>> nextDown 0 == (-0x1p-1074 :: Double)
-- True
-- >>> nextDown (-0) == (-0x1p-1074 :: Double)
-- True
-- >>> nextDown 0x1p-1074 -- returns positive zero
-- 0.0
-- >>> nextDown 0x1p-1022 == (0x0.ffff_ffff_ffff_fp-1022 :: Double)
-- True
nextDown :: RealFloat a => a -> a
nextDown :: forall a. RealFloat a => a -> a
nextDown a
x | Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isIEEE a
x) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"non-IEEE numbers are not supported"
           | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| (a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x -- NaN or negative infinity
           | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = a -> a
forall a. RealFloat a => a -> a
nextDown_positive a
x
           | Bool
otherwise = - a -> a
forall a. RealFloat a => a -> a
nextUp_positive (- a
x)
{-# INLINE [1] nextDown #-}

-- |
-- Returns the value whose magnitude is smaller than that of the argument, and is closest to the argument.
--
-- This operation is not in IEEE, but may be useful to some.
--
-- >>> nextTowardZero 1 == (0x1.ffff_ffff_ffff_fp-1 :: Double)
-- True
-- >>> nextTowardZero 1 == (0x1.fffffep-1 :: Float)
-- True
-- >>> nextTowardZero (1/0) == (maxFinite :: Double)
-- True
-- >>> nextTowardZero (-1/0) == (-maxFinite :: Double)
-- True
-- >>> nextTowardZero 0 :: Double -- returns positive zero
-- 0.0
-- >>> nextTowardZero (-0 :: Double) -- returns negative zero
-- -0.0
-- >>> nextTowardZero 0x1p-1074 :: Double
-- 0.0
nextTowardZero :: RealFloat a => a -> a
nextTowardZero :: forall a. RealFloat a => a -> a
nextTowardZero a
x | Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isIEEE a
x) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"non-IEEE numbers are not supported"
                 | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x -- NaN or zero
                 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = a -> a
forall a. RealFloat a => a -> a
nextDown_positive a
x
                 | Bool
otherwise = - a -> a
forall a. RealFloat a => a -> a
nextDown_positive (- a
x)
{-# INLINE [1] nextTowardZero #-}

nextUp_positive :: RealFloat a => a -> a
nextUp_positive :: forall a. RealFloat a => a -> a
nextUp_positive a
x
  | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"nextUp_positive"
  | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = a
x
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = 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) -- min positive
  | Bool
otherwise = let m :: Integer
                    e :: Int
                    (Integer
m,Int
e) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
                    -- x = m * 2^e, 2^(d-1) <= m < 2^d
                    -- 2^expMin < x < 2^expMax
                    -- 2^(expMin-d): min positive
                    -- 2^(expMin - 1): min normal 0x1p-1022
                    -- expMin - d <= e <= expMax - d (-1074 .. 971)
                in if Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e then
                     -- normal
                     if Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
base Integer -> Int -> Integer
^! Int
d Bool -> Bool -> Bool
&& Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d then
                       a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 -- max finite -> infinity
                     else
                       Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Int
e
                   else
                     -- subnormal
                     let m' :: Integer
m' = if Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 then
                                Integer
m Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e)
                              else
                                Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Integer
base Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))
                     in Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
m' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
  where
    d, expMin :: Int
    base :: Integer
base = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x
    d :: Int
d = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x -- 53 for Double
    (Int
expMin,Int
expMax) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x -- (-1021,1024) for Double
{-# INLINE nextUp_positive #-}

nextDown_positive :: RealFloat a => a -> a
nextDown_positive :: forall a. RealFloat a => a -> a
nextDown_positive a
x
  | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"nextDown_positive"
  | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = a
forall a. RealFloat a => a
maxFinite
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = 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) -- max negative
  | Bool
otherwise = let m :: Integer
                    e :: Int
                    (Integer
m,Int
e) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
                    -- x = m * 2^e, 2^(d-1) <= m < 2^d
                    -- 2^expMin < x < 2^expMax
                    -- 2^(expMin-d): min positive
                    -- 2^(expMin - 1): min normal 0x1p-1022
                    -- expMin - d <= e <= expMax - d (-1074 .. 971)
                in if Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e then
                     -- normal
                     let m1 :: Integer
m1 = Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
                     in if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
base Integer -> Int -> Integer
^! (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool -> Bool -> Bool
&& Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
e then
                          Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
base Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                        else
                          Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m1 Int
e
                   else
                     -- subnormal
                     let m' :: Integer
m' = if Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 then
                                Integer
m Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e)
                              else
                                Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Integer
base Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e))
                     in Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
m' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (Int
expMin Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
  where
    d, expMin :: Int
    base :: Integer
base = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x
    d :: Int
d = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x -- 53 for Double
    (Int
expMin,Int
_expMax) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x -- (-1021,1024) for Double
{-# INLINE nextDown_positive #-}

{-# RULES
"nextUp/Float" nextUp = nextUpFloat
"nextUp/Double" nextUp = nextUpDouble
"nextDown/Float" nextDown = nextDownFloat
"nextDown/Double" nextDown = nextDownDouble
"nextTowardZero/Float" nextTowardZero = nextTowardZeroFloat
"nextTowardZero/Double" nextTowardZero = nextTowardZeroDouble
  #-}

-- |
-- prop> nextUpFloat 1 == 0x1.000002p0
-- prop> nextUpFloat (1/0) == 1/0
-- prop> nextUpFloat (-1/0) == - maxFinite
-- prop> nextUpFloat 0 == 0x1p-149
-- prop> nextUpFloat (-0) == 0x1p-149
-- prop> isNegativeZero (nextUpFloat (-0x1p-149))
nextUpFloat :: Float -> Float
nextUpFloat :: Float -> Float
nextUpFloat Float
x =
  case Float -> Word32
castFloatToWord32 Float
x of
    Word32
w | Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x7f80_0000 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x7f80_0000
      , Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0xff80_0000 -> Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x -- NaN or positive infinity -> itself
    Word32
0x8000_0000 -> Float
forall a. RealFloat a => a
minPositive -- -0 -> min positive
    Word32
w | Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
w Int
31 -> Word32 -> Float
castWord32ToFloat (Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1) -- negative
      | Bool
otherwise -> Word32 -> Float
castWord32ToFloat (Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) -- positive
  where
    !() = if Bool
isFloatBinary32 then () else [Char] -> ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Numeric.Floating.IEEE assumes Float is IEEE binary32"

-- |
-- prop> nextUpDouble 1 == 0x1.0000_0000_0000_1p0
-- prop> nextUpDouble (1/0) == 1/0
-- prop> nextUpDouble (-1/0) == - maxFinite
-- prop> nextUpDouble 0 == 0x1p-1074
-- prop> nextUpDouble (-0) == 0x1p-1074
-- prop> isNegativeZero (nextUpDouble (-0x1p-1074))
nextUpDouble :: Double -> Double
nextUpDouble :: Double -> Double
nextUpDouble Double
x =
  case Double -> Word64
castDoubleToWord64 Double
x of
    Word64
w | Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x7ff0_0000_0000_0000 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0x7ff0_0000_0000_0000
      , Word64
w Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0xfff0_0000_0000_0000 -> Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x -- NaN or positive infinity -> itself
    Word64
0x8000_0000_0000_0000 -> Double
forall a. RealFloat a => a
minPositive -- -0 -> min positive
    Word64
w | Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
w Int
63 -> Word64 -> Double
castWord64ToDouble (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) -- negative
      | Bool
otherwise -> Word64 -> Double
castWord64ToDouble (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) -- positive
  where
     !() = if Bool
isDoubleBinary64 then () else [Char] -> ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Numeric.Floating.IEEE assumes Double is IEEE binary64"

-- |
-- prop> nextDownFloat 1 == 0x1.fffffep-1
-- prop> nextDownFloat (1/0) == maxFinite
-- prop> nextDownFloat (-1/0) == -1/0
-- prop> nextDownFloat 0 == -0x1p-149
-- prop> nextDownFloat (-0) == -0x1p-149
-- prop> nextDownFloat 0x1p-149 == 0
nextDownFloat :: Float -> Float
nextDownFloat :: Float -> Float
nextDownFloat Float
x =
  case Float -> Word32
castFloatToWord32 Float
x of
    Word32
w | Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x7f80_0000 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x7f80_0000
      , Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0x7f80_0000 -> Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x -- NaN or negative infinity -> itself
    Word32
0x0000_0000 -> - Float
forall a. RealFloat a => a
minPositive -- +0 -> max negative
    Word32
w | Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
w Int
31 -> Word32 -> Float
castWord32ToFloat (Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) -- negative
      | Bool
otherwise -> Word32 -> Float
castWord32ToFloat (Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1) -- positive
  where
    !() = if Bool
isFloatBinary32 then () else [Char] -> ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Numeric.Floating.IEEE assumes Float is IEEE binary32"

-- |
-- prop> nextDownDouble 1 == 0x1.ffff_ffff_ffff_fp-1
-- prop> nextDownDouble (1/0) == maxFinite
-- prop> nextDownDouble (-1/0) == -1/0
-- prop> nextDownDouble 0 == -0x1p-1074
-- prop> nextDownDouble (-0) == -0x1p-1074
-- prop> nextDownDouble 0x1p-1074 == 0
nextDownDouble :: Double -> Double
nextDownDouble :: Double -> Double
nextDownDouble Double
x =
  case Double -> Word64
castDoubleToWord64 Double
x of
    Word64
w | Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x7ff0_0000_0000_0000 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0x7ff0_0000_0000_0000
      , Word64
w Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0x7ff0_0000_0000_0000 -> Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x -- NaN or negative infinity -> itself
    Word64
0x0000_0000_0000_0000 -> - Double
forall a. RealFloat a => a
minPositive -- +0 -> max negative
    Word64
w | Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
w Int
63 -> Word64 -> Double
castWord64ToDouble (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) -- negative
      | Bool
otherwise -> Word64 -> Double
castWord64ToDouble (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) -- positive
  where
     !() = if Bool
isDoubleBinary64 then () else [Char] -> ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Numeric.Floating.IEEE assumes Double is IEEE binary64"

-- |
-- prop> nextTowardZeroFloat 1 == 0x1.fffffep-1
-- prop> nextTowardZeroFloat (-1) == -0x1.fffffep-1
-- prop> nextTowardZeroFloat (1/0) == maxFinite
-- prop> nextTowardZeroFloat (-1/0) == -maxFinite
-- prop> nextTowardZeroFloat 0 == 0
-- prop> isNegativeZero (nextTowardZeroFloat (-0))
-- prop> nextTowardZeroFloat 0x1p-149 == 0
nextTowardZeroFloat :: Float -> Float
nextTowardZeroFloat :: Float -> Float
nextTowardZeroFloat Float
x =
  case Float -> Word32
castFloatToWord32 Float
x of
    Word32
w | Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x7f80_0000 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x7f80_0000
      , Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x007f_ffff Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 -> Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x -- NaN -> itself
    Word32
0x8000_0000 -> Float
x -- -0 -> itself
    Word32
0x0000_0000 -> Float
x -- +0 -> itself
    Word32
w -> Word32 -> Float
castWord32ToFloat (Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1) -- positive / negative
  where
    !() = if Bool
isFloatBinary32 then () else [Char] -> ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Numeric.Floating.IEEE assumes Float is IEEE binary32"

-- |
-- prop> nextTowardZeroDouble 1 == 0x1.ffff_ffff_ffff_fp-1
-- prop> nextTowardZeroDouble (-1) == -0x1.ffff_ffff_ffff_fp-1
-- prop> nextTowardZeroDouble (1/0) == maxFinite
-- prop> nextTowardZeroDouble (-1/0) == -maxFinite
-- prop> nextTowardZeroDouble 0 == 0
-- prop> isNegativeZero (nextTowardZeroDouble (-0))
-- prop> nextTowardZeroDouble 0x1p-1074 == 0
nextTowardZeroDouble :: Double -> Double
nextTowardZeroDouble :: Double -> Double
nextTowardZeroDouble Double
x =
  case Double -> Word64
castDoubleToWord64 Double
x of
    Word64
w | Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x7ff0_0000_0000_0000 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0x7ff0_0000_0000_0000
      , Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x000f_ffff_ffff_ffff Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 -> Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x -- NaN -> itself
    Word64
0x8000_0000_0000_0000 -> Double
x -- -0 -> itself
    Word64
0x0000_0000_0000_0000 -> Double
x -- +0 -> itself
    Word64
w -> Word64 -> Double
castWord64ToDouble (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) -- positive / negative
  where
    !() = if Bool
isDoubleBinary64 then () else [Char] -> ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Numeric.Floating.IEEE assumes Double is IEEE binary64"