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

#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.Internal
  ( Half(..)
  , isZero
  , fromHalf
  , toHalf
  -- * Patterns
  -- | These are available with GHC-7.8 and later.
#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
  -- * Pure conversions
  , pure_floatToHalf
  , pure_halfToFloat
  ) where

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

import Language.Haskell.TH.Syntax (Lift (..))
#if __GLASGOW_HASKELL__ < 800
import Language.Haskell.TH
#endif

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

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)

instance NFData Half where
#if MIN_VERSION_deepseq(1,4,0)
  rnf :: Half -> ()
rnf (Half CUShort
f) = CUShort -> ()
forall a. NFData a => a -> ()
rnf CUShort
f
#else
  rnf (Half f) = f `seq` ()
#endif

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 (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 (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 (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 :: Half -> (b, Half)
properFraction 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, 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
  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

#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
  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)

#if __GLASGOW_HASKELL__ >= 800
instance Lift Half where
  lift :: Half -> Q Exp
lift (Half (CUShort Word16
w)) = [| Half (CUShort w) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: Half -> Q (TExp Half)
liftTyped (Half (CUShort Word16
w)) = [|| Half (CUShort w) ||]
#endif
#else
instance Lift Half where
  lift (Half (CUShort w)) =
    appE (conE 'Half) . appE (conE 'CUShort) . litE . integerL . fromIntegral $
    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 (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