{-# 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 f :: 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 w :: 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 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)

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

  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)

#if __GLASGOW_HASKELL__ >= 800
instance Lift Half where
  lift :: Half -> Q Exp
lift (Half (CUShort w :: Word16
w)) = [| Half (CUShort w) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped (Half (CUShort 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 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)

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