{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.Classes.RealFloat
-- Copyright   : [2016..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Classes.RealFloat (

  RealFloat(..),

) where

import Data.Array.Accelerate.Error
import Data.Array.Accelerate.Language                               ( cond, while )
import Data.Array.Accelerate.Pattern
import Data.Array.Accelerate.Smart
import Data.Array.Accelerate.Type

import Data.Array.Accelerate.Data.Bits

import Data.Array.Accelerate.Classes.Eq
import Data.Array.Accelerate.Classes.Floating
import Data.Array.Accelerate.Classes.FromIntegral
import Data.Array.Accelerate.Classes.Num
import Data.Array.Accelerate.Classes.Ord
import Data.Array.Accelerate.Classes.RealFrac

import Text.Printf
import Prelude                                                      ( (.), ($), String, error, undefined, unlines, otherwise )
import qualified Prelude                                            as P


-- | Efficient, machine-independent access to the components of a floating-point
-- number
--
class (RealFrac a, Floating a) => RealFloat a where
  -- | The radix of the representation (often 2) (constant)
  floatRadix     :: Exp a -> Exp Int64  -- Integer
  default floatRadix :: P.RealFloat a => Exp a -> Exp Int64
  floatRadix Exp a
_    = Integer -> Exp Int64
forall a. Num a => Integer -> a
P.fromInteger (a -> Integer
forall a. RealFloat a => a -> Integer
P.floatRadix (a
forall a. HasCallStack => a
undefined::a))

  -- | The number of digits of 'floatRadix' in the significand (constant)
  floatDigits    :: Exp a -> Exp Int
  default floatDigits :: P.RealFloat a => Exp a -> Exp Int
  floatDigits Exp a
_   = Int -> Exp Int
forall e. (HasCallStack, Elt e) => e -> Exp e
constant (a -> Int
forall a. RealFloat a => a -> Int
P.floatDigits (a
forall a. HasCallStack => a
undefined::a))

  -- | The lowest and highest values the exponent may assume (constant)
  floatRange     :: Exp a -> (Exp Int, Exp Int)
  default floatRange :: P.RealFloat a => Exp a -> (Exp Int, Exp Int)
  floatRange Exp a
_    = let (Int
m,Int
n) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
P.floatRange (a
forall a. HasCallStack => a
undefined::a)
                     in (Int -> Exp Int
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Int
m, Int -> Exp Int
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Int
n)

  -- | Return the significand and an appropriately scaled exponent. If
  -- @(m,n) = 'decodeFloat' x@ then @x = m*b^^n@, where @b@ is the
  -- floating-point radix ('floatRadix'). Furthermore, either @m@ and @n@ are
  -- both zero, or @b^(d-1) <= 'abs' m < b^d@, where @d = 'floatDigits' x@.
  decodeFloat    :: Exp a -> (Exp Int64, Exp Int)    -- Integer

  -- | Inverse of 'decodeFloat'
  encodeFloat    :: Exp Int64 -> Exp Int -> Exp a    -- Integer
  default encodeFloat :: (FromIntegral Int a, FromIntegral Int64 a) => Exp Int64 -> Exp Int -> Exp a
  encodeFloat Exp Int64
x Exp Int
e = Exp Int64 -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int64
x Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* (Exp Int64 -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp a -> Exp Int64
forall a. RealFloat a => Exp a -> Exp Int64
floatRadix (Exp a
forall a. HasCallStack => a
undefined :: Exp a)) Exp a -> Exp a -> Exp a
forall a. Floating a => a -> a -> a
** Exp Int -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
e)

  -- | Corresponds to the second component of 'decodeFloat'
  exponent       :: Exp a -> Exp Int
  exponent Exp a
x      = let (Exp Int64
m,Exp Int
n) = Exp a -> (Exp Int64, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int64, Exp Int)
decodeFloat Exp a
x
                     in Exp Bool -> Exp Int -> Exp Int -> Exp Int
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int64
m Exp Int64 -> Exp Int64 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int64
0)
                             Exp Int
0
                             (Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp a -> Exp Int
forall a. RealFloat a => Exp a -> Exp Int
floatDigits Exp a
x)

  -- | Corresponds to the first component of 'decodeFloat'
  significand    :: Exp a -> Exp a
  significand Exp a
x   = let (Exp Int64
m,Exp Int
_) = Exp a -> (Exp Int64, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int64, Exp Int)
decodeFloat Exp a
x
                     in Exp Int64 -> Exp Int -> Exp a
forall a. RealFloat a => Exp Int64 -> Exp Int -> Exp a
encodeFloat Exp Int64
m (Exp Int -> Exp Int
forall a. Num a => a -> a
negate (Exp a -> Exp Int
forall a. RealFloat a => Exp a -> Exp Int
floatDigits Exp a
x))

  -- | Multiply a floating point number by an integer power of the radix
  scaleFloat     :: Exp Int -> Exp a -> Exp a
  scaleFloat Exp Int
k Exp a
x  =
    Exp Bool -> Exp a -> Exp a -> Exp a
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
0 Exp Bool -> Exp Bool -> Exp Bool
|| Exp Bool
isFix) Exp a
x
         (Exp a -> Exp a) -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ Exp Int64 -> Exp Int -> Exp a
forall a. RealFloat a => Exp Int64 -> Exp Int -> Exp a
encodeFloat Exp Int64
m (Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int -> Exp Int
clamp Exp Int
b)
    where
      isFix :: Exp Bool
isFix = Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0 Exp Bool -> Exp Bool -> Exp Bool
|| Exp a -> Exp Bool
forall a. RealFloat a => Exp a -> Exp Bool
isNaN Exp a
x Exp Bool -> Exp Bool -> Exp Bool
|| Exp a -> Exp Bool
forall a. RealFloat a => Exp a -> Exp Bool
isInfinite Exp a
x
      (Exp Int64
m,Exp Int
n) = Exp a -> (Exp Int64, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int64, Exp Int)
decodeFloat Exp a
x
      (Exp Int
l,Exp Int
h) = Exp a -> (Exp Int, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int, Exp Int)
floatRange Exp a
x
      d :: Exp Int
d     = Exp a -> Exp Int
forall a. RealFloat a => Exp a -> Exp Int
floatDigits Exp a
x
      b :: Exp Int
b     = Exp Int
h Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
l Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
4Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
d
      -- n+k may overflow, which would lead to incorrect results, hence we clamp
      -- the scaling parameter. If (n+k) would be larger than h, (n + clamp b k)
      -- must be too, similar for smaller than (l-d).
      clamp :: Exp Int -> Exp Int
clamp Exp Int
bd  = Exp Int -> Exp Int -> Exp Int
forall a. Ord a => Exp a -> Exp a -> Exp a
max (-Exp Int
bd) (Exp Int -> Exp Int -> Exp Int
forall a. Ord a => Exp a -> Exp a -> Exp a
min Exp Int
bd Exp Int
k)

  -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value
  isNaN          :: Exp a -> Exp Bool

  -- | 'True' if the argument is an IEEE infinity or negative-infinity
  isInfinite     :: Exp a -> Exp Bool

  -- | 'True' if the argument is too small to be represented in normalized
  -- format
  isDenormalized :: Exp a -> Exp Bool

  -- | 'True' if the argument is an IEEE negative zero
  isNegativeZero :: Exp a -> Exp Bool

  -- | 'True' if the argument is an IEEE floating point number
  isIEEE         :: Exp a -> Exp Bool
  default isIEEE :: P.RealFloat a => Exp a -> Exp Bool
  isIEEE Exp a
_        = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant (a -> Bool
forall a. RealFloat a => a -> Bool
P.isIEEE (a
forall a. HasCallStack => a
undefined::a))

  -- | A version of arctangent taking two real floating-point arguments.
  -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle (from the
  -- positive x-axis) of the vector from the origin to the point @(x,y)@.
  -- @'atan2' y x@ returns a value in the range [@-pi@, @pi@].
  atan2          :: Exp a -> Exp a -> Exp a


instance RealFloat Half where
  atan2 :: Exp Half -> Exp Half -> Exp Half
atan2           = Exp Half -> Exp Half -> Exp Half
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp t -> Exp t
mkAtan2
  isNaN :: Exp Half -> Exp Bool
isNaN           = Exp Half -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsNaN
  isInfinite :: Exp Half -> Exp Bool
isInfinite      = Exp Half -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsInfinite
  isDenormalized :: Exp Half -> Exp Bool
isDenormalized  = String -> (Exp Half -> Exp Bool) -> Exp Half -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isDenormalized" (Exp Word16 -> Exp Bool
ieee754_f16_is_denormalized (Exp Word16 -> Exp Bool)
-> (Exp Half -> Exp Word16) -> Exp Half -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp Half -> Exp Word16
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  isNegativeZero :: Exp Half -> Exp Bool
isNegativeZero  = String -> (Exp Half -> Exp Bool) -> Exp Half -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isNegativeZero" (Exp Word16 -> Exp Bool
ieee754_f16_is_negative_zero (Exp Word16 -> Exp Bool)
-> (Exp Half -> Exp Word16) -> Exp Half -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp Half -> Exp Word16
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  decodeFloat :: Exp Half -> (Exp Int64, Exp Int)
decodeFloat     = String
-> (Exp Half -> (Exp Int64, Exp Int))
-> Exp Half
-> (Exp Int64, Exp Int)
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"decodeFloat"    (\Exp Half
x -> let T2 Exp Int16
m Exp Int
n = Exp Word16 -> Exp (Int16, Int)
ieee754_f16_decode (Exp Half -> Exp Word16
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast Exp Half
x)
                                                     in (Exp Int16 -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int16
m, Exp Int
n))

instance RealFloat Float where
  atan2 :: Exp Float -> Exp Float -> Exp Float
atan2           = Exp Float -> Exp Float -> Exp Float
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp t -> Exp t
mkAtan2
  isNaN :: Exp Float -> Exp Bool
isNaN           = Exp Float -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsNaN
  isInfinite :: Exp Float -> Exp Bool
isInfinite      = Exp Float -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsInfinite
  isDenormalized :: Exp Float -> Exp Bool
isDenormalized  = String -> (Exp Float -> Exp Bool) -> Exp Float -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isDenormalized" (Exp Word32 -> Exp Bool
ieee754_f32_is_denormalized (Exp Word32 -> Exp Bool)
-> (Exp Float -> Exp Word32) -> Exp Float -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp Float -> Exp Word32
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  isNegativeZero :: Exp Float -> Exp Bool
isNegativeZero  = String -> (Exp Float -> Exp Bool) -> Exp Float -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isNegativeZero" (Exp Word32 -> Exp Bool
ieee754_f32_is_negative_zero (Exp Word32 -> Exp Bool)
-> (Exp Float -> Exp Word32) -> Exp Float -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp Float -> Exp Word32
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  decodeFloat :: Exp Float -> (Exp Int64, Exp Int)
decodeFloat     = String
-> (Exp Float -> (Exp Int64, Exp Int))
-> Exp Float
-> (Exp Int64, Exp Int)
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"decodeFloat"    (\Exp Float
x -> let T2 Exp Int32
m Exp Int
n = Exp Word32 -> Exp (Int32, Int)
ieee754_f32_decode (Exp Float -> Exp Word32
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast Exp Float
x)
                                                     in (Exp Int32 -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int32
m, Exp Int
n))

instance RealFloat Double where
  atan2 :: Exp Double -> Exp Double -> Exp Double
atan2           = Exp Double -> Exp Double -> Exp Double
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp t -> Exp t
mkAtan2
  isNaN :: Exp Double -> Exp Bool
isNaN           = Exp Double -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsNaN
  isInfinite :: Exp Double -> Exp Bool
isInfinite      = Exp Double -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsInfinite
  isDenormalized :: Exp Double -> Exp Bool
isDenormalized  = String -> (Exp Double -> Exp Bool) -> Exp Double -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isDenormalized" (Exp Word64 -> Exp Bool
ieee754_f64_is_denormalized (Exp Word64 -> Exp Bool)
-> (Exp Double -> Exp Word64) -> Exp Double -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp Double -> Exp Word64
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  isNegativeZero :: Exp Double -> Exp Bool
isNegativeZero  = String -> (Exp Double -> Exp Bool) -> Exp Double -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isNegativeZero" (Exp Word64 -> Exp Bool
ieee754_f64_is_negative_zero (Exp Word64 -> Exp Bool)
-> (Exp Double -> Exp Word64) -> Exp Double -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp Double -> Exp Word64
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  decodeFloat :: Exp Double -> (Exp Int64, Exp Int)
decodeFloat     = String
-> (Exp Double -> (Exp Int64, Exp Int))
-> Exp Double
-> (Exp Int64, Exp Int)
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"decodeFloat"    (\Exp Double
x -> let T2 Exp Int64
m Exp Int
n = Exp Word64 -> Exp (Int64, Int)
ieee754_f64_decode (Exp Double -> Exp Word64
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast Exp Double
x)
                                                     in (Exp Int64
m, Exp Int
n))

instance RealFloat CFloat where
  atan2 :: Exp CFloat -> Exp CFloat -> Exp CFloat
atan2           = Exp CFloat -> Exp CFloat -> Exp CFloat
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp t -> Exp t
mkAtan2
  isNaN :: Exp CFloat -> Exp Bool
isNaN           = Exp Float -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsNaN (Exp Float -> Exp Bool)
-> (Exp CFloat -> Exp Float) -> Exp CFloat -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Elt a, Elt Float, IsScalar (EltR a), IsScalar (EltR Float),
 BitSizeEq (EltR a) (EltR Float)) =>
Exp a -> Exp Float
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast @Float
  isInfinite :: Exp CFloat -> Exp Bool
isInfinite      = Exp Float -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsInfinite (Exp Float -> Exp Bool)
-> (Exp CFloat -> Exp Float) -> Exp CFloat -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Elt a, Elt Float, IsScalar (EltR a), IsScalar (EltR Float),
 BitSizeEq (EltR a) (EltR Float)) =>
Exp a -> Exp Float
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast @Float
  isDenormalized :: Exp CFloat -> Exp Bool
isDenormalized  = String -> (Exp CFloat -> Exp Bool) -> Exp CFloat -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isDenormalized" (Exp Word32 -> Exp Bool
ieee754_f32_is_denormalized (Exp Word32 -> Exp Bool)
-> (Exp CFloat -> Exp Word32) -> Exp CFloat -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp CFloat -> Exp Word32
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  isNegativeZero :: Exp CFloat -> Exp Bool
isNegativeZero  = String -> (Exp CFloat -> Exp Bool) -> Exp CFloat -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isNegativeZero" (Exp Word32 -> Exp Bool
ieee754_f32_is_negative_zero (Exp Word32 -> Exp Bool)
-> (Exp CFloat -> Exp Word32) -> Exp CFloat -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp CFloat -> Exp Word32
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  decodeFloat :: Exp CFloat -> (Exp Int64, Exp Int)
decodeFloat     = String
-> (Exp CFloat -> (Exp Int64, Exp Int))
-> Exp CFloat
-> (Exp Int64, Exp Int)
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"decodeFloat"    (\Exp CFloat
x -> let T2 Exp Int32
m Exp Int
n = Exp Word32 -> Exp (Int32, Int)
ieee754_f32_decode (Exp CFloat -> Exp Word32
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast Exp CFloat
x)
                                                    in  (Exp Int32 -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int32
m, Exp Int
n))
  encodeFloat :: Exp Int64 -> Exp Int -> Exp CFloat
encodeFloat Exp Int64
x Exp Int
e = Exp Float -> Exp CFloat
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast (Exp Int64 -> Exp Int -> Exp Float
forall a. RealFloat a => Exp Int64 -> Exp Int -> Exp a
encodeFloat @Float Exp Int64
x Exp Int
e)

instance RealFloat CDouble where
  atan2 :: Exp CDouble -> Exp CDouble -> Exp CDouble
atan2           = Exp CDouble -> Exp CDouble -> Exp CDouble
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp t -> Exp t
mkAtan2
  isNaN :: Exp CDouble -> Exp Bool
isNaN           = Exp Double -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsNaN (Exp Double -> Exp Bool)
-> (Exp CDouble -> Exp Double) -> Exp CDouble -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Elt a, Elt Double, IsScalar (EltR a), IsScalar (EltR Double),
 BitSizeEq (EltR a) (EltR Double)) =>
Exp a -> Exp Double
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast @Double
  isInfinite :: Exp CDouble -> Exp Bool
isInfinite      = Exp Double -> Exp Bool
forall t. (Elt t, IsFloating (EltR t)) => Exp t -> Exp Bool
mkIsInfinite (Exp Double -> Exp Bool)
-> (Exp CDouble -> Exp Double) -> Exp CDouble -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Elt a, Elt Double, IsScalar (EltR a), IsScalar (EltR Double),
 BitSizeEq (EltR a) (EltR Double)) =>
Exp a -> Exp Double
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast @Double
  isDenormalized :: Exp CDouble -> Exp Bool
isDenormalized  = String -> (Exp CDouble -> Exp Bool) -> Exp CDouble -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isDenormalized" (Exp Word64 -> Exp Bool
ieee754_f64_is_denormalized (Exp Word64 -> Exp Bool)
-> (Exp CDouble -> Exp Word64) -> Exp CDouble -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp CDouble -> Exp Word64
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  isNegativeZero :: Exp CDouble -> Exp Bool
isNegativeZero  = String -> (Exp CDouble -> Exp Bool) -> Exp CDouble -> Exp Bool
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"isNegativeZero" (Exp Word64 -> Exp Bool
ieee754_f64_is_negative_zero (Exp Word64 -> Exp Bool)
-> (Exp CDouble -> Exp Word64) -> Exp CDouble -> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp CDouble -> Exp Word64
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast)
  decodeFloat :: Exp CDouble -> (Exp Int64, Exp Int)
decodeFloat     = String
-> (Exp CDouble -> (Exp Int64, Exp Int))
-> Exp CDouble
-> (Exp Int64, Exp Int)
forall a b.
(HasCallStack, RealFloat a) =>
String -> (Exp a -> b) -> Exp a -> b
ieee754 String
"decodeFloat"    (\Exp CDouble
x -> let T2 Exp Int64
m Exp Int
n = Exp Word64 -> Exp (Int64, Int)
ieee754_f64_decode (Exp CDouble -> Exp Word64
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast Exp CDouble
x)
                                                     in (Exp Int64
m, Exp Int
n))
  encodeFloat :: Exp Int64 -> Exp Int -> Exp CDouble
encodeFloat Exp Int64
x Exp Int
e = Exp Double -> Exp CDouble
forall b a.
(Elt a, Elt b, IsScalar (EltR a), IsScalar (EltR b),
 BitSizeEq (EltR a) (EltR b)) =>
Exp a -> Exp b
mkBitcast (Exp Int64 -> Exp Int -> Exp Double
forall a. RealFloat a => Exp Int64 -> Exp Int -> Exp a
encodeFloat @Double Exp Int64
x Exp Int
e)


-- To satisfy superclass constraints
--
instance RealFloat a => P.RealFloat (Exp a) where
  floatRadix :: Exp a -> Integer
floatRadix     = String -> Exp a -> Integer
forall a. String -> a
preludeError String
"floatRadix"
  floatDigits :: Exp a -> Int
floatDigits    = String -> Exp a -> Int
forall a. String -> a
preludeError String
"floatDigits"
  floatRange :: Exp a -> (Int, Int)
floatRange     = String -> Exp a -> (Int, Int)
forall a. String -> a
preludeError String
"floatRange"
  decodeFloat :: Exp a -> (Integer, Int)
decodeFloat    = String -> Exp a -> (Integer, Int)
forall a. String -> a
preludeError String
"decodeFloat"
  encodeFloat :: Integer -> Int -> Exp a
encodeFloat    = String -> Integer -> Int -> Exp a
forall a. String -> a
preludeError String
"encodeFloat"
  isNaN :: Exp a -> Bool
isNaN          = String -> Exp a -> Bool
forall a. String -> a
preludeError String
"isNaN"
  isInfinite :: Exp a -> Bool
isInfinite     = String -> Exp a -> Bool
forall a. String -> a
preludeError String
"isInfinite"
  isDenormalized :: Exp a -> Bool
isDenormalized = String -> Exp a -> Bool
forall a. String -> a
preludeError String
"isDenormalized"
  isNegativeZero :: Exp a -> Bool
isNegativeZero = String -> Exp a -> Bool
forall a. String -> a
preludeError String
"isNegativeZero"
  isIEEE :: Exp a -> Bool
isIEEE         = String -> Exp a -> Bool
forall a. String -> a
preludeError String
"isIEEE"

preludeError :: String -> a
preludeError :: String -> a
preludeError String
x
  = String -> a
forall a. HasCallStack => String -> a
error
  (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Prelude.%s applied to EDSL types: use Data.Array.Accelerate.%s instead" String
x String
x
            , String
""
            , String
"These Prelude.RealFloat instances are present only to fulfil superclass"
            , String
"constraints for subsequent classes in the standard Haskell numeric hierarchy."
            ]


ieee754 :: forall a b. HasCallStack => P.RealFloat a => String -> (Exp a -> b) -> Exp a -> b
ieee754 :: String -> (Exp a -> b) -> Exp a -> b
ieee754 String
name Exp a -> b
f Exp a
x
  | a -> Bool
forall a. RealFloat a => a -> Bool
P.isIEEE (a
forall a. HasCallStack => a
undefined::a) = Exp a -> b
f Exp a
x
  | Bool
otherwise               = String -> b
forall a. HasCallStack => String -> a
internalError (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s: Not implemented for non-IEEE floating point" String
name)

-- From: ghc/libraries/base/cbits/primFloat.c
-- ------------------------------------------

-- An IEEE754 number is denormalised iff:
--   * exponent is zero
--   * mantissa is non-zero.
--   * (don't care about setting of sign bit.)
--
ieee754_f64_is_denormalized :: Exp Word64 -> Exp Bool
ieee754_f64_is_denormalized :: Exp Word64 -> Exp Bool
ieee754_f64_is_denormalized Exp Word64
x =
  Exp Word64 -> Exp Word64
ieee754_f64_mantissa Exp Word64
x Exp Word64 -> Exp Word64 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word64
0 Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word64 -> Exp Word16
ieee754_f64_exponent Exp Word64
x Exp Word16 -> Exp Word16 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Word16
0

ieee754_f32_is_denormalized :: Exp Word32 -> Exp Bool
ieee754_f32_is_denormalized :: Exp Word32 -> Exp Bool
ieee754_f32_is_denormalized Exp Word32
x =
  Exp Word32 -> Exp Word32
ieee754_f32_mantissa Exp Word32
x Exp Word32 -> Exp Word32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word32
0 Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word32 -> Exp Word8
ieee754_f32_exponent Exp Word32
x Exp Word8 -> Exp Word8 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Word8
0

ieee754_f16_is_denormalized :: Exp Word16 -> Exp Bool
ieee754_f16_is_denormalized :: Exp Word16 -> Exp Bool
ieee754_f16_is_denormalized Exp Word16
x =
  Exp Word16 -> Exp Word16
ieee754_f16_mantissa Exp Word16
x Exp Word16 -> Exp Word16 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word16
0 Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word16 -> Exp Word8
ieee754_f16_exponent Exp Word16
x Exp Word8 -> Exp Word8 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Word8
0

-- Negative zero if only the sign bit is set
--
ieee754_f64_is_negative_zero :: Exp Word64 -> Exp Bool
ieee754_f64_is_negative_zero :: Exp Word64 -> Exp Bool
ieee754_f64_is_negative_zero Exp Word64
x =
  Exp Word64 -> Exp Bool
ieee754_f64_negative Exp Word64
x Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word64 -> Exp Word16
ieee754_f64_exponent Exp Word64
x Exp Word16 -> Exp Word16 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word16
0 Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word64 -> Exp Word64
ieee754_f64_mantissa Exp Word64
x Exp Word64 -> Exp Word64 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word64
0

ieee754_f32_is_negative_zero :: Exp Word32 -> Exp Bool
ieee754_f32_is_negative_zero :: Exp Word32 -> Exp Bool
ieee754_f32_is_negative_zero Exp Word32
x =
  Exp Word32 -> Exp Bool
ieee754_f32_negative Exp Word32
x Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word32 -> Exp Word8
ieee754_f32_exponent Exp Word32
x Exp Word8 -> Exp Word8 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word8
0 Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word32 -> Exp Word32
ieee754_f32_mantissa Exp Word32
x Exp Word32 -> Exp Word32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word32
0

ieee754_f16_is_negative_zero :: Exp Word16 -> Exp Bool
ieee754_f16_is_negative_zero :: Exp Word16 -> Exp Bool
ieee754_f16_is_negative_zero Exp Word16
x =
  Exp Word16 -> Exp Bool
ieee754_f16_negative Exp Word16
x Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word16 -> Exp Word8
ieee754_f16_exponent Exp Word16
x Exp Word8 -> Exp Word8 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word8
0 Exp Bool -> Exp Bool -> Exp Bool
&&
  Exp Word16 -> Exp Word16
ieee754_f16_mantissa Exp Word16
x Exp Word16 -> Exp Word16 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word16
0


-- Assume the host processor stores integers and floating point numbers in the
-- same endianness (true for modern processors).
--
-- To recap, here's the representation of a double precision
-- IEEE floating point number:
--
-- sign         63           sign bit (0==positive, 1==negative)
-- exponent     62-52        exponent (biased by 1023)
-- fraction     51-0         fraction (bits to right of binary point)
--
ieee754_f64_mantissa :: Exp Word64 -> Exp Word64
ieee754_f64_mantissa :: Exp Word64 -> Exp Word64
ieee754_f64_mantissa Exp Word64
x = Exp Word64
x Exp Word64 -> Exp Word64 -> Exp Word64
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word64
0xFFFFFFFFFFFFF

ieee754_f64_exponent :: Exp Word64 -> Exp Word16
ieee754_f64_exponent :: Exp Word64 -> Exp Word16
ieee754_f64_exponent Exp Word64
x = Exp Word64 -> Exp Word16
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp Word64
x Exp Word64 -> Exp Int -> Exp Word64
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftR` Exp Int
52) Exp Word16 -> Exp Word16 -> Exp Word16
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word16
0x7FF

ieee754_f64_negative :: Exp Word64 -> Exp Bool
ieee754_f64_negative :: Exp Word64 -> Exp Bool
ieee754_f64_negative Exp Word64
x = Exp Word64 -> Exp Int -> Exp Bool
forall a. Bits a => Exp a -> Exp Int -> Exp Bool
testBit Exp Word64
x Exp Int
63

-- Representation of single precision IEEE floating point number:
--
-- sign         31           sign bit (0==positive, 1==negative)
-- exponent     30-23        exponent (biased by 127)
-- fraction     22-0         fraction (bits to right of binary point)
--
ieee754_f32_mantissa :: Exp Word32 -> Exp Word32
ieee754_f32_mantissa :: Exp Word32 -> Exp Word32
ieee754_f32_mantissa Exp Word32
x = Exp Word32
x Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word32
0x7FFFFF

ieee754_f32_exponent :: Exp Word32 -> Exp Word8
ieee754_f32_exponent :: Exp Word32 -> Exp Word8
ieee754_f32_exponent Exp Word32
x = Exp Word32 -> Exp Word8
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp Word32
x Exp Word32 -> Exp Int -> Exp Word32
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftR` Exp Int
23)

ieee754_f32_negative :: Exp Word32 -> Exp Bool
ieee754_f32_negative :: Exp Word32 -> Exp Bool
ieee754_f32_negative Exp Word32
x = Exp Word32 -> Exp Int -> Exp Bool
forall a. Bits a => Exp a -> Exp Int -> Exp Bool
testBit Exp Word32
x Exp Int
31

-- Representation of half precision IEEE floating point number:
--
-- sign         15           sign bit (0==positive, 1==negative)
-- exponent     14-10        exponent (biased by 15)
-- fraction     9-0          fraction (bits to right of binary point)
--
ieee754_f16_mantissa :: Exp Word16 -> Exp Word16
ieee754_f16_mantissa :: Exp Word16 -> Exp Word16
ieee754_f16_mantissa Exp Word16
x = Exp Word16
x Exp Word16 -> Exp Word16 -> Exp Word16
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word16
0x3FF

ieee754_f16_exponent :: Exp Word16 -> Exp Word8
ieee754_f16_exponent :: Exp Word16 -> Exp Word8
ieee754_f16_exponent Exp Word16
x = Exp Word16 -> Exp Word8
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp Word16
x Exp Word16 -> Exp Int -> Exp Word16
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftR` Exp Int
10) Exp Word8 -> Exp Word8 -> Exp Word8
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word8
0x1F

ieee754_f16_negative :: Exp Word16 -> Exp Bool
ieee754_f16_negative :: Exp Word16 -> Exp Bool
ieee754_f16_negative Exp Word16
x = Exp Word16 -> Exp Int -> Exp Bool
forall a. Bits a => Exp a -> Exp Int -> Exp Bool
testBit Exp Word16
x Exp Int
15


-- reverse engineered following the below

ieee754_f16_decode :: Exp Word16 -> Exp (Int16, Int)
ieee754_f16_decode :: Exp Word16 -> Exp (Int16, Int)
ieee754_f16_decode Exp Word16
i =
  let
      _HHIGHBIT :: Exp Int16
_HHIGHBIT                       = Exp Int16
0x0400
      _HMSBIT :: Exp Int16
_HMSBIT                         = Exp Int16
0x8000
      _HMINEXP :: Exp Int
_HMINEXP                        = ((Exp Int
_HALF_MIN_EXP) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- (Exp Int
_HALF_MANT_DIG) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
1)
      _HALF_MANT_DIG :: Exp Int
_HALF_MANT_DIG                  = Exp Half -> Exp Int
forall a. RealFloat a => Exp a -> Exp Int
floatDigits (Exp Half
forall a. HasCallStack => a
undefined::Exp Half)
      (Exp Int
_HALF_MIN_EXP, Exp Int
_HALF_MAX_EXP)  = Exp Half -> (Exp Int, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int, Exp Int)
floatRange  (Exp Half
forall a. HasCallStack => a
undefined::Exp Half)

      high1 :: Exp Int16
high1 = Exp Word16 -> Exp Int16
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word16
i
      high2 :: Exp Int16
high2 = Exp Int16
high1 Exp Int16 -> Exp Int16 -> Exp Int16
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. (Exp Int16
_HHIGHBIT Exp Int16 -> Exp Int16 -> Exp Int16
forall a. Num a => a -> a -> a
- Exp Int16
1)

      exp1 :: Exp Int
exp1  = ((Exp Int16 -> Exp Int
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int16
high1 Exp Int -> Exp Int -> Exp Int
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftR` Exp Int
10) Exp Int -> Exp Int -> Exp Int
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int
0x1F) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
_HMINEXP
      exp2 :: Exp Int
exp2  = Exp Int
exp1 Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
1

      T2 Exp Int16
high3 Exp Int
exp3
            = Exp Bool
-> Exp (Int16, Int) -> Exp (Int16, Int) -> Exp (Int16, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
exp1 Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Int
_HMINEXP)
                   -- don't add hidden bit to denorms
                   (Exp Int16 -> Exp Int -> Exp (Int16, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp Int16
high2 Exp Int16 -> Exp Int16 -> Exp Int16
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp Int16
_HHIGHBIT) Exp Int
exp1)
                   -- a denorm, normalise the mantissa
                   ((Exp (Int16, Int) -> Exp Bool)
-> (Exp (Int16, Int) -> Exp (Int16, Int))
-> Exp (Int16, Int)
-> Exp (Int16, Int)
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (\(T2 Exp Int16
h Exp Int
_) -> (Exp Int16
h Exp Int16 -> Exp Int16 -> Exp Int16
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int16
_HHIGHBIT) Exp Int16 -> Exp Int16 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Int16
0 )
                          (\(T2 Exp Int16
h Exp Int
e) -> Exp Int16 -> Exp Int -> Exp (Int16, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp Int16
h Exp Int16 -> Exp Int -> Exp Int16
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftL` Exp Int
1) (Exp Int
eExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
-Exp Int
1))
                          (Exp Int16 -> Exp Int -> Exp (Int16, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp Int16
high2 Exp Int
exp2))

      high4 :: Exp Int16
high4 = Exp Bool -> Exp Int16 -> Exp Int16 -> Exp Int16
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Word16 -> Exp Int16
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word16
i Exp Int16 -> Exp Int16 -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< (Exp Int16
0 :: Exp Int16)) (-Exp Int16
high3) Exp Int16
high3
  in
  Exp Bool
-> Exp (Int16, Int) -> Exp (Int16, Int) -> Exp (Int16, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int16
high1 Exp Int16 -> Exp Int16 -> Exp Int16
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int16 -> Exp Int16
forall a. Bits a => Exp a -> Exp a
complement Exp Int16
_HMSBIT Exp Int16 -> Exp Int16 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int16
0)
       (Exp Int16 -> Exp Int -> Exp (Int16, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp Int16
0 Exp Int
0)
       (Exp Int16 -> Exp Int -> Exp (Int16, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp Int16
high4 Exp Int
exp3)


-- From: ghc/rts/StgPrimFloat.c
-- ----------------------------

ieee754_f32_decode :: Exp Word32 -> Exp (Int32, Int)
ieee754_f32_decode :: Exp Word32 -> Exp (Int32, Int)
ieee754_f32_decode Exp Word32
i =
  let
      _FHIGHBIT :: Exp Int32
_FHIGHBIT                     = Exp Int32
0x00800000
      _FMSBIT :: Exp Int32
_FMSBIT                       = Exp Int32
0x80000000
      _FMINEXP :: Exp Int
_FMINEXP                      = ((Exp Int
_FLT_MIN_EXP) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- (Exp Int
_FLT_MANT_DIG) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
1)
      _FLT_MANT_DIG :: Exp Int
_FLT_MANT_DIG                 = Exp Float -> Exp Int
forall a. RealFloat a => Exp a -> Exp Int
floatDigits (Exp Float
forall a. HasCallStack => a
undefined::Exp Float)
      (Exp Int
_FLT_MIN_EXP, Exp Int
_FLT_MAX_EXP)  = Exp Float -> (Exp Int, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int, Exp Int)
floatRange  (Exp Float
forall a. HasCallStack => a
undefined::Exp Float)

      high1 :: Exp Int32
high1 = Exp Word32 -> Exp Int32
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word32
i
      high2 :: Exp Int32
high2 = Exp Int32
high1 Exp Int32 -> Exp Int32 -> Exp Int32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. (Exp Int32
_FHIGHBIT Exp Int32 -> Exp Int32 -> Exp Int32
forall a. Num a => a -> a -> a
- Exp Int32
1)

      exp1 :: Exp Int
exp1  = ((Exp Int32 -> Exp Int
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int32
high1 Exp Int -> Exp Int -> Exp Int
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftR` Exp Int
23) Exp Int -> Exp Int -> Exp Int
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int
0xFF) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
_FMINEXP
      exp2 :: Exp Int
exp2  = Exp Int
exp1 Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
1

      T2 Exp Int32
high3 Exp Int
exp3
            = Exp Bool
-> Exp (Int32, Int) -> Exp (Int32, Int) -> Exp (Int32, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
exp1 Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Int
_FMINEXP)
                   -- don't add hidden bit to denorms
                   (Exp Int32 -> Exp Int -> Exp (Int32, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp Int32
high2 Exp Int32 -> Exp Int32 -> Exp Int32
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp Int32
_FHIGHBIT) Exp Int
exp1)
                   -- a denorm, normalise the mantissa
                   ((Exp (Int32, Int) -> Exp Bool)
-> (Exp (Int32, Int) -> Exp (Int32, Int))
-> Exp (Int32, Int)
-> Exp (Int32, Int)
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (\(T2 Exp Int32
h Exp Int
_) -> (Exp Int32
h Exp Int32 -> Exp Int32 -> Exp Int32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int32
_FHIGHBIT) Exp Int32 -> Exp Int32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Int32
0 )
                          (\(T2 Exp Int32
h Exp Int
e) -> Exp Int32 -> Exp Int -> Exp (Int32, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp Int32
h Exp Int32 -> Exp Int -> Exp Int32
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftL` Exp Int
1) (Exp Int
eExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
-Exp Int
1))
                          (Exp Int32 -> Exp Int -> Exp (Int32, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp Int32
high2 Exp Int
exp2))

      high4 :: Exp Int32
high4 = Exp Bool -> Exp Int32 -> Exp Int32 -> Exp Int32
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Word32 -> Exp Int32
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word32
i Exp Int32 -> Exp Int32 -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< (Exp Int32
0 :: Exp Int32)) (-Exp Int32
high3) Exp Int32
high3
  in
  Exp Bool
-> Exp (Int32, Int) -> Exp (Int32, Int) -> Exp (Int32, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int32
high1 Exp Int32 -> Exp Int32 -> Exp Int32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int32 -> Exp Int32
forall a. Bits a => Exp a -> Exp a
complement Exp Int32
_FMSBIT Exp Int32 -> Exp Int32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int32
0)
       (Exp Int32 -> Exp Int -> Exp (Int32, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp Int32
0 Exp Int
0)
       (Exp Int32 -> Exp Int -> Exp (Int32, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp Int32
high4 Exp Int
exp3)


ieee754_f64_decode :: Exp Word64 -> Exp (Int64, Int)
ieee754_f64_decode :: Exp Word64 -> Exp (Int64, Int)
ieee754_f64_decode Exp Word64
i =
  let T4 Exp Int
s Exp Word32
h Exp Word32
l Exp Int
e = Exp Word64 -> Exp (Int, Word32, Word32, Int)
ieee754_f64_decode2 Exp Word64
i
   in Exp Int64 -> Exp Int -> Exp (Int64, Int)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp Int -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
s Exp Int64 -> Exp Int64 -> Exp Int64
forall a. Num a => a -> a -> a
* (Exp Word32 -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word32
h Exp Int64 -> Exp Int -> Exp Int64
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftL` Exp Int
32 Exp Int64 -> Exp Int64 -> Exp Int64
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp Word32 -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word32
l)) Exp Int
e

ieee754_f64_decode2 :: Exp Word64 -> Exp (Int, Word32, Word32, Int)
ieee754_f64_decode2 :: Exp Word64 -> Exp (Int, Word32, Word32, Int)
ieee754_f64_decode2 Exp Word64
i =
  let
      _DHIGHBIT :: Exp Word32
_DHIGHBIT                     = Exp Word32
0x00100000
      _DMSBIT :: Exp Word32
_DMSBIT                       = Exp Word32
0x80000000
      _DMINEXP :: Exp Int
_DMINEXP                      = ((Exp Int
_DBL_MIN_EXP) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- (Exp Int
_DBL_MANT_DIG) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
1)
      _DBL_MANT_DIG :: Exp Int
_DBL_MANT_DIG                 = Exp Double -> Exp Int
forall a. RealFloat a => Exp a -> Exp Int
floatDigits (Exp Double
forall a. HasCallStack => a
undefined::Exp Double)
      (Exp Int
_DBL_MIN_EXP, Exp Int
_DBL_MAX_EXP)  = Exp Double -> (Exp Int, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int, Exp Int)
floatRange  (Exp Double
forall a. HasCallStack => a
undefined::Exp Double)

      low :: Exp Word32
low   = Exp Word64 -> Exp Word32
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word64
i
      high :: Exp Word32
high  = Exp Word64 -> Exp Word32
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp Word64
i Exp Word64 -> Exp Int -> Exp Word64
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftR` Exp Int
32)

      iexp :: Exp Int
iexp  = (Exp Word32 -> Exp Int
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral ((Exp Word32
high Exp Word32 -> Exp Int -> Exp Word32
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftR` Exp Int
20) Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word32
0x7FF) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
_DMINEXP)
      sign :: Exp Int
sign = Exp Bool -> Exp Int -> Exp Int -> Exp Int
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Word64 -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word64
i Exp Int64 -> Exp Int64 -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< (Exp Int64
0 :: Exp Int64)) (-Exp Int
1) Exp Int
1

      high2 :: Exp Word32
high2 = Exp Word32
high Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. (Exp Word32
_DHIGHBIT Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Num a => a -> a -> a
- Exp Word32
1)
      iexp2 :: Exp Int
iexp2 = Exp Int
iexp Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
1

      T3 Exp Word32
hi Exp Word32
lo Exp Int
ie
            = Exp Bool
-> Exp (Word32, Word32, Int)
-> Exp (Word32, Word32, Int)
-> Exp (Word32, Word32, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
iexp2 Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Int
_DMINEXP)
                   -- don't add hidden bit to denorms
                   (Exp Word32 -> Exp Word32 -> Exp Int -> Exp (Word32, Word32, Int)
forall (con :: * -> *) x0 x1 x2.
IsPattern con (x0, x1, x2) (con x0, con x1, con x2) =>
con x0 -> con x1 -> con x2 -> con (x0, x1, x2)
T3 (Exp Word32
high2 Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp Word32
_DHIGHBIT) Exp Word32
low Exp Int
iexp)
                   -- a denorm, nermalise the mantissa
                   ((Exp (Word32, Word32, Int) -> Exp Bool)
-> (Exp (Word32, Word32, Int) -> Exp (Word32, Word32, Int))
-> Exp (Word32, Word32, Int)
-> Exp (Word32, Word32, Int)
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (\(T3 Exp Word32
h Exp Word32
_ Exp Int
_) -> (Exp Word32
h Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word32
_DHIGHBIT) Exp Word32 -> Exp Word32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Word32
0)
                          (\(T3 Exp Word32
h Exp Word32
l Exp Int
e) ->
                            let h1 :: Exp Word32
h1 = Exp Word32
h Exp Word32 -> Exp Int -> Exp Word32
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftL` Exp Int
1
                                h2 :: Exp Word32
h2 = Exp Bool -> Exp Word32 -> Exp Word32 -> Exp Word32
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond ((Exp Word32
l Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Word32
_DMSBIT) Exp Word32 -> Exp Word32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp Word32
0) (Exp Word32
h1Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Num a => a -> a -> a
+Exp Word32
1) Exp Word32
h1
                            in  Exp Word32 -> Exp Word32 -> Exp Int -> Exp (Word32, Word32, Int)
forall (con :: * -> *) x0 x1 x2.
IsPattern con (x0, x1, x2) (con x0, con x1, con x2) =>
con x0 -> con x1 -> con x2 -> con (x0, x1, x2)
T3 Exp Word32
h2 (Exp Word32
l Exp Word32 -> Exp Int -> Exp Word32
forall a. Bits a => Exp a -> Exp Int -> Exp a
`unsafeShiftL` Exp Int
1) (Exp Int
eExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
-Exp Int
1))
                          (Exp Word32 -> Exp Word32 -> Exp Int -> Exp (Word32, Word32, Int)
forall (con :: * -> *) x0 x1 x2.
IsPattern con (x0, x1, x2) (con x0, con x1, con x2) =>
con x0 -> con x1 -> con x2 -> con (x0, x1, x2)
T3 Exp Word32
high2 Exp Word32
low Exp Int
iexp2))

  in
  Exp Bool
-> Exp (Int, Word32, Word32, Int)
-> Exp (Int, Word32, Word32, Int)
-> Exp (Int, Word32, Word32, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Word32
low Exp Word32 -> Exp Word32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word32
0 Exp Bool -> Exp Bool -> Exp Bool
&& (Exp Word32
high Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. (Exp Word32 -> Exp Word32
forall a. Bits a => Exp a -> Exp a
complement Exp Word32
_DMSBIT)) Exp Word32 -> Exp Word32 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Word32
0)
       (Exp Int
-> Exp Word32
-> Exp Word32
-> Exp Int
-> Exp (Int, Word32, Word32, Int)
forall (con :: * -> *) x0 x1 x2 x3.
IsPattern con (x0, x1, x2, x3) (con x0, con x1, con x2, con x3) =>
con x0 -> con x1 -> con x2 -> con x3 -> con (x0, x1, x2, x3)
T4 Exp Int
1 Exp Word32
0 Exp Word32
0 Exp Int
0)
       (Exp Int
-> Exp Word32
-> Exp Word32
-> Exp Int
-> Exp (Int, Word32, Word32, Int)
forall (con :: * -> *) x0 x1 x2 x3.
IsPattern con (x0, x1, x2, x3) (con x0, con x1, con x2, con x3) =>
con x0 -> con x1 -> con x2 -> con x3 -> con (x0, x1, x2, x3)
T4 Exp Int
sign Exp Word32
hi Exp Word32
lo Exp Int
ie)