{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskellQuotes    #-}
{-# LANGUAGE PatternSynonyms          #-}
{-# LANGUAGE Trustworthy              #-}

-----------------------------------------------------------------------------
-- |
-- 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.Internal
  ( Half(..)
  , isZero
  , fromHalf
  , toHalf
  -- * Patterns
  , 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
  -- * Pure conversions
  , pure_floatToHalf
  , pure_halfToFloat
  ) where

import Control.DeepSeq (NFData (..))
import Data.Bits
import Data.Function (on)
import Data.Int
import Foreign.C.Types (CUShort (..))
import Foreign.Ptr (castPtr)
import Foreign.Storable
import GHC.Generics
import Text.Read (Read (..))

import Language.Haskell.TH.Syntax (Lift (..))

import Data.Binary (Binary (..))

#ifdef __GHCJS__
toHalf :: Float -> Half
toHalf = pure_floatToHalf

fromHalf :: Half -> Float
fromHalf = pure_halfToFloat
#else
-- | 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 #-}
#endif

-- | A half-precision floating point value
newtype
  {-# CTYPE "unsigned short" #-}
  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
$cfrom :: forall x. Half -> Rep Half x
from :: forall x. Half -> Rep Half x
$cto :: forall x. Rep Half x -> Half
to :: forall x. Rep Half x -> Half
Generic

instance NFData Half where
  rnf :: Half -> ()
rnf (Half CUShort
f) = CUShort -> ()
forall a. NFData a => a -> ()
rnf CUShort
f

instance Binary Half where
  put :: Half -> Put
put (Half (CUShort Word16
w)) = Word16 -> Put
forall t. Binary t => t -> Put
put Word16
w
  get :: Get Half
get = (Word16 -> Half) -> Get Word16 -> Get Half
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CUShort -> Half
Half (CUShort -> Half) -> (Word16 -> CUShort) -> Word16 -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CUShort
CUShort)  Get Word16
forall t. Binary t => Get t
get

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 Ptr Half
p = (CUShort -> Half) -> IO CUShort -> IO Half
forall a b. (a -> b) -> IO a -> IO b
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 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 Int
d 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 a b. (a -> b) -> ReadPrec a -> ReadPrec b
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
  Half
a / :: Half -> Half -> Half
/ 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 :: forall b. Integral b => Half -> (b, Half)
properFraction Half
a = case Float -> (b, Float)
forall b. Integral b => Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Half -> Float
fromHalf Half
a) of
    (b
b, Float
c) -> (b
b, Float -> Half
toHalf Float
c)
  truncate :: forall b. Integral b => Half -> b
truncate = Float -> b
forall b. Integral b => 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 :: forall b. Integral b => Half -> b
round = Float -> b
forall b. Integral b => 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 :: forall b. Integral b => Half -> b
ceiling = Float -> b
forall b. Integral b => 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 :: forall b. Integral b => Half -> b
floor = Float -> b
forall b. Integral b => 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
  Half
a ** :: Half -> Half -> Half
** 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 Half
a 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  Half
_ = Integer
2
  floatDigits :: Half -> Int
floatDigits Half
_ = Int
11
  decodeFloat :: Half -> (Integer, Int)
decodeFloat = Half -> (Integer, Int)
ieee754_f16_decode
  isIEEE :: Half -> Bool
isIEEE Half
_ = Float -> Bool
forall a. RealFloat a => a -> Bool
isIEEE (Float
forall a. HasCallStack => a
undefined :: Float)
  atan2 :: Half -> Half -> Half
atan2 Half
a 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)

  isInfinite :: Half -> Bool
isInfinite (Half CUShort
h) = CUShort -> Int -> CUShort
forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h Int
10 CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x1f CUShort -> CUShort -> Bool
forall a. Ord a => a -> a -> Bool
>= CUShort
31 Bool -> Bool -> Bool
&& CUShort
h CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== CUShort
0
  isDenormalized :: Half -> Bool
isDenormalized (Half CUShort
h) = CUShort -> Int -> CUShort
forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h Int
10 CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x1f CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== CUShort
0 Bool -> Bool -> Bool
&& CUShort
h CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
/= CUShort
0
  isNaN :: Half -> Bool
isNaN (Half CUShort
h) = CUShort -> Int -> CUShort
forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h Int
10 CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x1f CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== CUShort
0x1f Bool -> Bool -> Bool
&& CUShort
h CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
/= CUShort
0

  isNegativeZero :: Half -> Bool
isNegativeZero (Half CUShort
h) = CUShort
h CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== CUShort
0x8000
  floatRange :: Half -> (Int, Int)
floatRange Half
_ = (-Int
13,Int
16)
  encodeFloat :: Integer -> Int -> Half
encodeFloat Integer
i 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 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 CUShort
h) = CUShort
h CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x7fff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== CUShort
0

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

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

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

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

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

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

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

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

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

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

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

instance Num Half where
  Half
a * :: Half -> Half -> Half
* 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)
  Half
a - :: Half -> Half -> Half
- 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)
  Half
a + :: Half -> Half -> Half
+ 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 CUShort
a) = CUShort -> Half
Half (CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
xor CUShort
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 Integer
a = Float -> Half
toHalf (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
a)

instance Lift Half where
  lift :: forall (m :: * -> *). Quote m => Half -> m Exp
lift (Half (CUShort Word16
w)) = [| Half (CUShort w) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => Half -> Code m Half
liftTyped (Half (CUShort Word16
w)) = [|| CUShort -> Half
Half (Word16 -> CUShort
CUShort Word16
w) ||]
#endif

-- Adapted from ghc/rts/StgPrimFloat.c
--
ieee754_f16_decode :: Half -> (Integer, Int)
ieee754_f16_decode :: Half -> (Integer, Int)
ieee754_f16_decode (Half (CUShort Word16
i)) =
  let
      _HHIGHBIT :: Integer
_HHIGHBIT                       = Integer
0x0400
      _HMSBIT :: Integer
_HMSBIT                         = Integer
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
- Int
1)
      _HALF_MANT_DIG :: Int
_HALF_MANT_DIG                  = Half -> Int
forall a. RealFloat a => a -> Int
floatDigits (Half
forall a. HasCallStack => a
undefined::Half)
      (Int
_HALF_MIN_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
- Integer
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` Int
10) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
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
+ Int
1

      (Integer
high3, 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
/= Integer
0
                              then (Integer, b) -> (Integer, b)
go (Integer
h Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1, b
eb -> b -> b
forall a. Num a => a -> a -> a
-b
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
< (Int16
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
== Integer
0
    then (Integer
0,Int
0)
    else (Integer
high4, Int
exp3)

-- | Naive pure-Haskell implementation of 'toHalf'.
--
pure_floatToHalf :: Float -> Half
pure_floatToHalf :: Float -> Half
pure_floatToHalf = CUShort -> Half
Half (CUShort -> Half) -> (Float -> CUShort) -> Float -> Half
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> CUShort
pure_floatToHalf'

pure_floatToHalf' :: Float -> CUShort
pure_floatToHalf' :: Float -> CUShort
pure_floatToHalf' Float
x | Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
x = if Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 then CUShort
0xfc00 else CUShort
0x7c00
pure_floatToHalf' Float
x | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x = CUShort
0xfe00
-- for some reason, comparing with 0 and then deciding sign fails with GHC-7.8
pure_floatToHalf' Float
x | Float -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero Float
x = CUShort
0x8000
pure_floatToHalf' Float
0 = CUShort
0
pure_floatToHalf' Float
x = let
  (Integer
m, Int
n) = Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x
  -- sign bit
  s :: Int
s = if Integer -> Integer
forall a. Num a => a -> a
signum Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Int
0x8000 else Int
0
  m1 :: Int
m1 = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
m :: Int
  -- bit len of m1, here m1 /= 0
  len :: Int
len = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Int) -> Int
forall a b. (a, b) -> b
snd (((Int, Int) -> Int -> (Int, Int))
-> (Int, Int) -> [Int] -> (Int, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Int
acc, Int
res) Int
y -> if Int
acc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                                         then (Int
acc,       Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
res)
                                         else (Int
acc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
y, Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
res Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                       (Int
m1, Int
0)
                       [ Int
0xffff0000, Int
0xff00ff00ff00, Int
0xf0f0f0f0
                       , Int
0xcccccccc, Int
0xaaaaaaaa]
                )
  -- scale to at least 12bit
  (Int
len', Int
m', Int
n') = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11 then (Int
len, Int
m1, Int
n)
                   else (Int
12, Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
m1 (Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len), Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len))
  e :: Int
e = Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  in
  if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
15 then Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
s Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0x7c00)
  else if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
14 then let t' :: Int
t' = Int
len' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
11
                            m'' :: Int
m'' = Int
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
t' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                  (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
m' Int
t' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1)
                            len'' :: Int
len'' = if Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
m'' Int
len then Int
len' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
len'
                            t'' :: Int
t'' = Int
len'' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
11
                            e'' :: Int
e'' = Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len'' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                            res :: Int
res = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
m'' Int
t'' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3ff) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.
                                  Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL ((Int
e'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
15) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f) Int
10 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.
                                  Int
s
                            in if Int
e'' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
15
                               then Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
s Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0x7c00)
                               else Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res
  -- subnormal
  else if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
25 then let t :: Int
t = -Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
14
                            m'' :: Int
m'' = Int
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                  (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
m' Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1)
                            res :: Int
res = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
m'' Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
s
                            in if Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
15 Bool -> Bool -> Bool
&& Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
m'' (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t)
                               then Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUShort) -> Int -> CUShort
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
m'' Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3ff) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.
                                                   Int
0x400 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
s
                               else Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res
  else Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s

-- | Naive pure-Haskell implementation of 'fromHalf'.
pure_halfToFloat :: Half -> Float
pure_halfToFloat :: Half -> Float
pure_halfToFloat = CUShort -> Float
pure_halfToFloat' (CUShort -> Float) -> (Half -> CUShort) -> Half -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> CUShort
getHalf

pure_halfToFloat' :: CUShort -> Float
pure_halfToFloat' :: CUShort -> Float
pure_halfToFloat' CUShort
0xfc00 = -Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
pure_halfToFloat' CUShort
0x7c00 =  Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
pure_halfToFloat' CUShort
0x0000 =  Float
0
pure_halfToFloat' CUShort
0x8000 = -Float
0
pure_halfToFloat' CUShort
x | (CUShort
x CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x7c00 CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
== CUShort
0x7c00) Bool -> Bool -> Bool
&& (CUShort
x CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
/= CUShort
0) = Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
pure_halfToFloat' CUShort
x = let
  s :: Integer
s = if CUShort
x CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x8000 CUShort -> CUShort -> Bool
forall a. Eq a => a -> a -> Bool
/= CUShort
0 then -Integer
1 else Integer
1
  e :: Int
e = CUShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUShort -> Int -> CUShort
forall a. Bits a => a -> Int -> a
shiftR CUShort
x Int
10) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f :: Int
  m :: CUShort
m = CUShort
x CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff
  (Int
a, CUShort
b) = if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10, CUShort
m CUShort -> CUShort -> CUShort
forall a. Bits a => a -> a -> a
.|. CUShort
0x400)
           else (-Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, CUShort
m)
  in Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* CUShort -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUShort
b) Int
a