{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2014 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  PatternSynonyms
--
-- Half-precision floating-point values. These arise commonly in GPU work
-- and it is useful to be able to compute them and compute with them on the
-- CPU as well.
----------------------------------------------------------------------------

module Numeric.Half
  ( Half(..)
  , isZero
  , fromHalf
  , toHalf
#if __GLASGOW_HASKELL__ >= 708
  , pattern POS_INF
  , pattern NEG_INF
  , pattern QNaN
  , pattern SNaN
  , pattern HALF_MIN
  , pattern HALF_NRM_MIN
  , pattern HALF_MAX
  , pattern HALF_EPSILON
  , pattern HALF_DIG
  , pattern HALF_MIN_10_EXP
  , pattern HALF_MAX_10_EXP
#endif
  ) where

#if __GLASGOW_HASKELL__ >= 708
import Control.DeepSeq (NFData)
#endif
import Data.Bits
import Data.Function (on)
import Data.Int
import Data.Typeable
import Foreign.C.Types
import Foreign.Ptr (castPtr)
import Foreign.Storable
import GHC.Generics
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Text.Read hiding (lift)

-- | Convert a 'Float' to a 'Half' with proper rounding, while preserving NaN and dealing appropriately with infinity
foreign import ccall unsafe "hs_floatToHalf" toHalf :: Float -> Half
-- {-# RULES "toHalf"  realToFrac = toHalf #-}

-- | Convert a 'Half' to a 'Float' while preserving NaN
foreign import ccall unsafe "hs_halfToFloat" fromHalf :: Half -> Float
-- {-# RULES "fromHalf" realToFrac = fromHalf #-}

newtype
#if __GLASGOW_HASKELL__ >= 706
  {-# CTYPE "unsigned short" #-}
#endif
  Half = Half { Half -> CUShort
getHalf :: CUShort } deriving ((forall x. Half -> Rep Half x)
-> (forall x. Rep Half x -> Half) -> Generic Half
forall x. Rep Half x -> Half
forall x. Half -> Rep Half x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Half x -> Half
$cfrom :: forall x. Half -> Rep Half x
Generic, Typeable)

#if __GLASGOW_HASKELL__ >= 708
instance NFData Half where
#endif

instance Storable Half where
  sizeOf :: Half -> Int
sizeOf = CUShort -> Int
forall a. Storable a => a -> Int
sizeOf (CUShort -> Int) -> (Half -> CUShort) -> Half -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> CUShort
getHalf
  alignment :: Half -> Int
alignment = CUShort -> Int
forall a. Storable a => a -> Int
alignment (CUShort -> Int) -> (Half -> CUShort) -> Half -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> CUShort
getHalf
  peek :: Ptr Half -> IO Half
peek p :: Ptr Half
p = (CUShort -> Half) -> IO CUShort -> IO Half
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUShort -> Half
Half (Ptr CUShort -> IO CUShort
forall a. Storable a => Ptr a -> IO a
peek (Ptr Half -> Ptr CUShort
forall a b. Ptr a -> Ptr b
castPtr Ptr Half
p))
  poke :: Ptr Half -> Half -> IO ()
poke p :: Ptr Half
p = Ptr CUShort -> CUShort -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Half -> Ptr CUShort
forall a b. Ptr a -> Ptr b
castPtr Ptr Half
p) (CUShort -> IO ()) -> (Half -> CUShort) -> Half -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> CUShort
getHalf

instance Show Half where
  showsPrec :: Int -> Half -> ShowS
showsPrec d :: Int
d h :: Half
h = Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (Half -> Float
fromHalf Half
h)

instance Read Half where
  readPrec :: ReadPrec Half
readPrec = (Float -> Half) -> ReadPrec Float -> ReadPrec Half
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Half
toHalf ReadPrec Float
forall a. Read a => ReadPrec a
readPrec

instance Eq Half where
  == :: Half -> Half -> Bool
(==) = Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Float -> Float -> Bool) -> (Half -> Float) -> Half -> Half -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf

instance Ord Half where
  compare :: Half -> Half -> Ordering
compare = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Ordering)
-> (Half -> Float) -> Half -> Half -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  < :: Half -> Half -> Bool
(<) = Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Float -> Float -> Bool) -> (Half -> Float) -> Half -> Half -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  <= :: Half -> Half -> Bool
(<=) = Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (Float -> Float -> Bool) -> (Half -> Float) -> Half -> Half -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  > :: Half -> Half -> Bool
(>) = Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
(>) (Float -> Float -> Bool) -> (Half -> Float) -> Half -> Half -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  >= :: Half -> Half -> Bool
(>=) = Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (Float -> Float -> Bool) -> (Half -> Float) -> Half -> Half -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf

instance Real Half where
  toRational :: Half -> Rational
toRational = Float -> Rational
forall a. Real a => a -> Rational
toRational (Float -> Rational) -> (Half -> Float) -> Half -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf

instance Fractional Half where
  fromRational :: Rational -> Half
fromRational = Float -> Half
toHalf (Float -> Half) -> (Rational -> Float) -> Rational -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational
  recip :: Half -> Half
recip = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Fractional a => a -> a
recip (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  a :: Half
a / :: Half -> Half -> Half
/ b :: Half
b = Float -> Half
toHalf (Float -> Half) -> Float -> Half
forall a b. (a -> b) -> a -> b
$ Half -> Float
fromHalf Half
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Half -> Float
fromHalf Half
b

instance RealFrac Half where
  properFraction :: Half -> (b, Half)
properFraction a :: Half
a = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Half -> Float
fromHalf Half
a) of
    (b :: b
b, c :: Float
c) -> (b
b, Float -> Half
toHalf Float
c)
  truncate :: Half -> b
truncate = Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> b) -> (Half -> Float) -> Half -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  round :: Half -> b
round = Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> b) -> (Half -> Float) -> Half -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  ceiling :: Half -> b
ceiling = Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Float -> b) -> (Half -> Float) -> Half -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  floor :: Half -> b
floor = Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> b) -> (Half -> Float) -> Half -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf

instance Floating Half where
  pi :: Half
pi = Float -> Half
toHalf Float
forall a. Floating a => a
pi
  exp :: Half -> Half
exp = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
exp (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  sqrt :: Half -> Half
sqrt = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
sqrt (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  log :: Half -> Half
log = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
log (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  a :: Half
a ** :: Half -> Half -> Half
** b :: Half
b = Float -> Half
toHalf (Float -> Half) -> Float -> Half
forall a b. (a -> b) -> a -> b
$ Half -> Float
fromHalf Half
a Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Half -> Float
fromHalf Half
b
  logBase :: Half -> Half -> Half
logBase a :: Half
a b :: Half
b = Float -> Half
toHalf (Float -> Half) -> Float -> Half
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase (Half -> Float
fromHalf Half
a) (Half -> Float
fromHalf Half
b)
  sin :: Half -> Half
sin = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
sin (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  tan :: Half -> Half
tan = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
tan (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  cos :: Half -> Half
cos = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
cos (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  asin :: Half -> Half
asin = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
asin (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  atan :: Half -> Half
atan = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
atan (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  acos :: Half -> Half
acos = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
acos (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  sinh :: Half -> Half
sinh = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
sinh (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  tanh :: Half -> Half
tanh = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
tanh (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  cosh :: Half -> Half
cosh = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
cosh (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  asinh :: Half -> Half
asinh = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
asinh (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  atanh :: Half -> Half
atanh = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
atanh (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  acosh :: Half -> Half
acosh = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
acosh (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf

instance RealFloat Half where
  floatRadix :: Half -> Integer
floatRadix  _ = 2
  floatDigits :: Half -> Int
floatDigits _ = 11
  decodeFloat :: Half -> (Integer, Int)
decodeFloat = Half -> (Integer, Int)
ieee754_f16_decode
  isIEEE :: Half -> Bool
isIEEE _ = Float -> Bool
forall a. RealFloat a => a -> Bool
isIEEE (Float
forall a. HasCallStack => a
undefined :: Float)
  atan2 :: Half -> Half -> Half
atan2 a :: Half
a b :: Half
b = Float -> Half
toHalf (Float -> Half) -> Float -> Half
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 (Half -> Float
fromHalf Half
a) (Half -> Float
fromHalf Half
b)
#if MIN_VERSION_base(4,5,0)
  isInfinite :: Half -> Bool
isInfinite (Half h :: CUShort
h) = CUShort -> Int -> CUShort
forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h 10 CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. 0x1f CUShort -> CUShort -> Bool
forall a. Ord a => a -> a -> Bool
>= 31
  isDenormalized :: Half -> Bool
isDenormalized (Half h :: CUShort
h) = CUShort -> Int -> CUShort
forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h 10 CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. 0x1f CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& CUShort
h CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. 0x3ff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
  isNaN :: Half -> Bool
isNaN (Half h :: CUShort
h) = CUShort -> Int -> CUShort
forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h 10 CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. 0x1f CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== 0x1f Bool -> Bool -> Bool
&& CUShort
h CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. 0x3ff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
#else
  isInfinite (Half h) = shiftR h 10 .&. 0x1f >= 31
  isDenormalized (Half h) = shiftR h 10 .&. 0x1f == 0 && h .&. 0x3ff /= 0
  isNaN (Half h) = shiftR h 10 .&. 0x1f == 0x1f && h .&. 0x3ff /= 0
#endif

  isNegativeZero :: Half -> Bool
isNegativeZero (Half h :: CUShort
h) = CUShort
h CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== 0x8000
  floatRange :: Half -> (Int, Int)
floatRange _ = (-13,16)
  encodeFloat :: Integer -> Int -> Half
encodeFloat i :: Integer
i j :: Int
j = Float -> Half
toHalf (Float -> Half) -> Float -> Half
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
i Int
j
  exponent :: Half -> Int
exponent = Float -> Int
forall a. RealFloat a => a -> Int
exponent (Float -> Int) -> (Half -> Float) -> Half -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  significand :: Half -> Half
significand = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. RealFloat a => a -> a
significand (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  scaleFloat :: Int -> Half -> Half
scaleFloat n :: Int
n = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float -> Float
forall a. RealFloat a => Int -> a -> a
scaleFloat Int
n (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf

-- | Is this 'Half' equal to 0?
isZero :: Half -> Bool
isZero :: Half -> Bool
isZero (Half h :: CUShort
h) = CUShort
h CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. 0x7fff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== 0

#if __GLASGOW_HASKELL__ >= 708

-- | Positive infinity
pattern $bPOS_INF :: Half
$mPOS_INF :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
POS_INF = Half 0x7c00

-- | Negative infinity
pattern $bNEG_INF :: Half
$mNEG_INF :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
NEG_INF = Half 0xfc00

-- | Quiet NaN
pattern $bQNaN :: Half
$mQNaN :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
QNaN    = Half 0x7fff

-- | Signalling NaN
pattern $bSNaN :: Half
$mSNaN :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
SNaN    = Half 0x7dff

-- | Smallest positive half
pattern $bHALF_MIN :: Half
$mHALF_MIN :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
HALF_MIN = Half 0x0001  -- 5.96046448e-08

-- | Smallest positive normalized half
pattern $bHALF_NRM_MIN :: Half
$mHALF_NRM_MIN :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
HALF_NRM_MIN = Half 0x0400  -- 6.10351562e-05

-- | Largest positive half
pattern $bHALF_MAX :: Half
$mHALF_MAX :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
HALF_MAX = Half 0x7bff  -- 65504.0

-- | Smallest positive e for which half (1.0 + e) != half (1.0)
pattern $bHALF_EPSILON :: Half
$mHALF_EPSILON :: forall r. Half -> (Void# -> r) -> (Void# -> r) -> r
HALF_EPSILON = Half 0x1400  -- 0.00097656

-- | Number of base 10 digits that can be represented without change
pattern $bHALF_DIG :: a
$mHALF_DIG :: forall r a. (Eq a, Num a) => a -> (Void# -> r) -> (Void# -> r) -> r
HALF_DIG = 2

-- Minimum positive integer such that 10 raised to that power is a normalized half
pattern $bHALF_MIN_10_EXP :: a
$mHALF_MIN_10_EXP :: forall r a. (Eq a, Num a) => a -> (Void# -> r) -> (Void# -> r) -> r
HALF_MIN_10_EXP = -4

-- Maximum positive integer such that 10 raised to that power is a normalized half
pattern $bHALF_MAX_10_EXP :: a
$mHALF_MAX_10_EXP :: forall r a. (Eq a, Num a) => a -> (Void# -> r) -> (Void# -> r) -> r
HALF_MAX_10_EXP = 4

#endif

instance Num Half where
  a :: Half
a * :: Half -> Half -> Half
* b :: Half
b = Float -> Half
toHalf (Half -> Float
fromHalf Half
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Half -> Float
fromHalf Half
b)
  a :: Half
a - :: Half -> Half -> Half
- b :: Half
b = Float -> Half
toHalf (Half -> Float
fromHalf Half
a Float -> Float -> Float
forall a. Num a => a -> a -> a
- Half -> Float
fromHalf Half
b)
  a :: Half
a + :: Half -> Half -> Half
+ b :: Half
b = Float -> Half
toHalf (Half -> Float
fromHalf Half
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Half -> Float
fromHalf Half
b)
  negate :: Half -> Half
negate (Half a :: CUShort
a) = CUShort -> Half
Half (CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
xor 0x8000 CUShort
a)
  abs :: Half -> Half
abs = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  signum :: Half -> Half
signum = Float -> Half
toHalf (Float -> Half) -> (Half -> Float) -> Half -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
signum (Float -> Float) -> (Half -> Float) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  fromInteger :: Integer -> Half
fromInteger a :: Integer
a = Float -> Half
toHalf (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
a)

instance Lift Half where
  lift :: Half -> Q Exp
lift (Half (CUShort w :: Word16
w)) =
    Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
conE 'Half) (Q Exp -> Q Exp) -> (Word16 -> Q Exp) -> Word16 -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
conE 'CUShort) (Q Exp -> Q Exp) -> (Word16 -> Q Exp) -> Word16 -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Q Exp
litE (Lit -> Q Exp) -> (Word16 -> Lit) -> Word16 -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
integerL (Integer -> Lit) -> (Word16 -> Integer) -> Word16 -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Q Exp) -> Word16 -> Q Exp
forall a b. (a -> b) -> a -> b
$
    Word16
w


-- Adapted from ghc/rts/StgPrimFloat.c
--
ieee754_f16_decode :: Half -> (Integer, Int)
ieee754_f16_decode :: Half -> (Integer, Int)
ieee754_f16_decode (Half (CUShort i :: Word16
i)) =
  let
      _HHIGHBIT :: Integer
_HHIGHBIT                       = 0x0400
      _HMSBIT :: Integer
_HMSBIT                         = 0x8000
      _HMINEXP :: Int
_HMINEXP                        = ((Int
_HALF_MIN_EXP) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
_HALF_MANT_DIG) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
      _HALF_MANT_DIG :: Int
_HALF_MANT_DIG                  = Half -> Int
forall a. RealFloat a => a -> Int
floatDigits (Half
forall a. HasCallStack => a
undefined::Half)
      (_HALF_MIN_EXP :: Int
_HALF_MIN_EXP, _HALF_MAX_EXP :: Int
_HALF_MAX_EXP)  = Half -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange  (Half
forall a. HasCallStack => a
undefined::Half)

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

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

      (high3 :: Integer
high3, exp3 :: Int
exp3)
            = if Int
exp1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
_HMINEXP
                then (Integer
high2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
_HHIGHBIT, Int
exp1)
                else
                      let go :: (Integer, b) -> (Integer, b)
go (!Integer
h, !b
e) =
                            if Integer
h Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
_HHIGHBIT Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
                              then (Integer, b) -> (Integer, b)
go (Integer
h Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 1, b
eb -> b -> b
forall a. Num a => a -> a -> a
-1)
                              else (Integer
h, b
e)
                      in
                      (Integer, Int) -> (Integer, Int)
forall b. Num b => (Integer, b) -> (Integer, b)
go (Integer
high2, Int
exp2)

      high4 :: Integer
high4 = if Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
< (0 :: Int16)
                then -Integer
high3
                else  Integer
high3
  in
  if Integer
high1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
_HMSBIT Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
    then (0,0)
    else (Integer
high4, Int
exp3)