{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Numeric.Floating.IEEE.Internal.Conversion
  ( realFloatToFrac
  , canonicalize
  , canonicalizeFloat
  , canonicalizeDouble
  ) where
import           GHC.Float.Compat (double2Float, float2Double)
import           MyPrelude

default ()

-- |
-- Converts a floating-point value into another type.
--
-- Similar to 'realToFrac', but treats NaN, infinities, negative zero even if the rewrite rule is off.
--
-- IEEE 754 @convertFormat@ operation.
realFloatToFrac :: (RealFloat a, Fractional b) => a -> b
realFloatToFrac :: a -> b
realFloatToFrac a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = b
0b -> b -> b
forall a. Fractional a => a -> a -> a
/b
0
                  | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then b
1b -> b -> b
forall a. Fractional a => a -> a -> a
/b
0 else -b
1b -> b -> b
forall a. Fractional a => a -> a -> a
/b
0
                  | a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = -b
0
                  | Bool
otherwise = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
x
{-# NOINLINE [1] realFloatToFrac #-}
{-# RULES
"realFloatToFrac/a->a" realFloatToFrac = canonicalize
"realFloatToFrac/Float->Double" realFloatToFrac = float2Double
"realFloatToFrac/Double->Float" realFloatToFrac = double2Float
  #-}

-- Since GHC optimizes away '* 1.0' when the type is 'Float' or 'Double',
-- we can't canonicalize x by just 'x * 1.0'.
one :: Num a => a
one :: a
one = a
1
{-# NOINLINE one #-}

-- |
-- A specialized version of 'realFloatToFrac'.
--
-- The resulting value will be canonical and non-signaling.
canonicalize :: RealFloat a => a -> a
canonicalize :: a -> a
canonicalize a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Num a => a
one
{-# INLINE [1] canonicalize #-}

#if defined(HAS_FAST_CANONICALIZE)

foreign import ccall unsafe "hs_canonicalizeFloat"
  canonicalizeFloat :: Float -> Float
foreign import ccall unsafe "hs_canonicalizeDouble"
  canonicalizeDouble :: Double -> Double

{-# RULES
"canonicalize/Float" canonicalize = canonicalizeFloat
"canonicalize/Double" canonicalize = canonicalizeDouble
  #-}

#else

{-# SPECIALIZE canonicalize :: Float -> Float, Double -> Double #-}

canonicalizeFloat :: Float -> Float
canonicalizeFloat = canonicalize

canonicalizeDouble :: Double -> Double
canonicalizeDouble = canonicalize

#endif