{-# 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 <[email protected]>
-- 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. 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) = 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)) = forall t. Binary t => t -> Put
put Word16
w
  get :: Get Half
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CUShort -> Half
Half forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CUShort
CUShort)  forall t. Binary t => Get t
get

instance Storable Half where
  sizeOf :: Half -> Int
sizeOf = forall a. Storable a => a -> Int
sizeOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> CUShort
getHalf
  alignment :: Half -> Int
alignment = forall a. Storable a => a -> Int
alignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> CUShort
getHalf
  peek :: Ptr Half -> IO Half
peek Ptr Half
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUShort -> Half
Half (forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr Half
p))
  poke :: Ptr Half -> Half -> IO ()
poke Ptr Half
p = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Half
p) 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 = forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (Half -> Float
fromHalf Half
h)

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

instance Eq Half where
  == :: Half -> Half -> Bool
(==) = forall a. Eq a => a -> a -> 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 = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  < :: Half -> Half -> Bool
(<) = forall a. Ord a => a -> a -> Bool
(<) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  <= :: Half -> Half -> Bool
(<=) = forall a. Ord a => a -> a -> Bool
(<=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  > :: Half -> Half -> Bool
(>) = forall a. Ord a => a -> a -> Bool
(>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Half -> Float
fromHalf
  >= :: Half -> Half -> Bool
(>=) = forall a. Ord a => a -> a -> 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 = forall a. Real a => a -> Rational
toRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf

instance Fractional Half where
  fromRational :: Rational -> Half
fromRational = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
  recip :: Half -> Half
recip = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => a -> a
recip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  Half
a / :: Half -> Half -> Half
/ Half
b = Float -> Half
toHalf forall a b. (a -> b) -> a -> b
$ Half -> Float
fromHalf Half
a 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 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 = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  round :: forall b. Integral b => Half -> b
round = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  ceiling :: forall b. Integral b => Half -> b
ceiling = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  floor :: forall b. Integral b => Half -> b
floor = forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf

instance Floating Half where
  pi :: Half
pi = Float -> Half
toHalf forall a. Floating a => a
pi
  exp :: Half -> Half
exp = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
exp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  sqrt :: Half -> Half
sqrt = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
sqrt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  log :: Half -> Half
log = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
log forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  Half
a ** :: Half -> Half -> Half
** Half
b = Float -> Half
toHalf forall a b. (a -> b) -> a -> b
$ Half -> Float
fromHalf Half
a forall a. Floating a => a -> a -> a
** Half -> Float
fromHalf Half
b
  logBase :: Half -> Half -> Half
logBase Half
a Half
b = Float -> Half
toHalf forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
sin forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  tan :: Half -> Half
tan = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
tan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  cos :: Half -> Half
cos = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
cos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  asin :: Half -> Half
asin = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
asin forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  atan :: Half -> Half
atan = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
atan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  acos :: Half -> Half
acos = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
acos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  sinh :: Half -> Half
sinh = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
sinh forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  tanh :: Half -> Half
tanh = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
tanh forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  cosh :: Half -> Half
cosh = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
cosh forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  asinh :: Half -> Half
asinh = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
asinh forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  atanh :: Half -> Half
atanh = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
atanh forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  acosh :: Half -> Half
acosh = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
acosh 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
_ = forall a. RealFloat a => a -> Bool
isIEEE (forall a. HasCallStack => a
undefined :: Float)
  atan2 :: Half -> Half -> Half
atan2 Half
a Half
b = Float -> Half
toHalf forall a b. (a -> b) -> a -> b
$ 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) = forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h Int
10 forall a. Bits a => a -> a -> a
.&. CUShort
0x1f forall a. Ord a => a -> a -> Bool
>= CUShort
31 Bool -> Bool -> Bool
&& CUShort
h forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff forall a. Eq a => a -> a -> Bool
== CUShort
0
  isDenormalized :: Half -> Bool
isDenormalized (Half CUShort
h) = forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h Int
10 forall a. Bits a => a -> a -> a
.&. CUShort
0x1f forall a. Eq a => a -> a -> Bool
== CUShort
0 Bool -> Bool -> Bool
&& CUShort
h forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff forall a. Eq a => a -> a -> Bool
/= CUShort
0
  isNaN :: Half -> Bool
isNaN (Half CUShort
h) = forall a. Bits a => a -> Int -> a
unsafeShiftR CUShort
h Int
10 forall a. Bits a => a -> a -> a
.&. CUShort
0x1f forall a. Eq a => a -> a -> Bool
== CUShort
0x1f Bool -> Bool -> Bool
&& CUShort
h forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff forall a. Eq a => a -> a -> Bool
/= CUShort
0

  isNegativeZero :: Half -> Bool
isNegativeZero (Half CUShort
h) = CUShort
h 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 forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
i Int
j
  exponent :: Half -> Int
exponent = forall a. RealFloat a => a -> Int
exponent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  significand :: Half -> Half
significand = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => a -> a
significand forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  scaleFloat :: Int -> Half -> Half
scaleFloat Int
n = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => Int -> a -> a
scaleFloat Int
n 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 forall a. Bits a => a -> a -> a
.&. CUShort
0x7fff forall a. Eq a => a -> a -> Bool
== CUShort
0

#if __GLASGOW_HASKELL__ >= 708

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

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

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

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

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

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

-- | Largest positive half
pattern $bHALF_MAX :: Half
$mHALF_MAX :: forall {r}. Half -> ((# #) -> r) -> ((# #) -> 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 -> ((# #) -> r) -> ((# #) -> r) -> r
HALF_EPSILON = Half 0x1400  -- 0.00097656

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

-- Minimum positive integer such that 10 raised to that power is a normalized half
pattern $bHALF_MIN_10_EXP :: forall {a}. (Eq a, Num a) => a
$mHALF_MIN_10_EXP :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> 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 :: forall {a}. (Eq a, Num a) => a
$mHALF_MAX_10_EXP :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> 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 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 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 forall a. Num a => a -> a -> a
+ Half -> Float
fromHalf Half
b)
  negate :: Half -> Half
negate (Half CUShort
a) = CUShort -> Half
Half (forall a. Bits a => a -> a -> a
xor CUShort
0x8000 CUShort
a)
  abs :: Half -> Half
abs = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  signum :: Half -> Half
signum = Float -> Half
toHalf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
signum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Float
fromHalf
  fromInteger :: Integer -> Half
fromInteger Integer
a = Float -> Half
toHalf (forall a. Num a => Integer -> a
fromInteger Integer
a)

#if __GLASGOW_HASKELL__ >= 800
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)) = [|| 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) forall a. Num a => a -> a -> a
- (Int
_HALF_MANT_DIG) forall a. Num a => a -> a -> a
- Int
1)
      _HALF_MANT_DIG :: Int
_HALF_MANT_DIG                  = forall a. RealFloat a => a -> Int
floatDigits (forall a. HasCallStack => a
undefined::Half)
      (Int
_HALF_MIN_EXP, Int
_HALF_MAX_EXP)  = forall a. RealFloat a => a -> (Int, Int)
floatRange  (forall a. HasCallStack => a
undefined::Half)

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

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

      (Integer
high3, Int
exp3)
            = if Int
exp1 forall a. Eq a => a -> a -> Bool
/= Int
_HMINEXP
                then (Integer
high2 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 forall a. Bits a => a -> a -> a
.&. Integer
_HHIGHBIT forall a. Eq a => a -> a -> Bool
/= Integer
0
                              then (Integer, b) -> (Integer, b)
go (Integer
h forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1, b
eforall a. Num a => a -> a -> a
-b
1)
                              else (Integer
h, b
e)
                      in
                      forall {b}. Num b => (Integer, b) -> (Integer, b)
go (Integer
high2, Int
exp2)

      high4 :: Integer
high4 = if forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i forall a. Ord a => a -> a -> Bool
< (Int16
0 :: Int16)
                then -Integer
high3
                else  Integer
high3
  in
  if Integer
high1 forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Integer
_HMSBIT 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 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 | forall a. RealFloat a => a -> Bool
isInfinite Float
x = if Float
x forall a. Ord a => a -> a -> Bool
< Float
0 then CUShort
0xfc00 else CUShort
0x7c00
pure_floatToHalf' Float
x | 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 | 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) = forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x
  -- sign bit
  s :: Int
s = if forall a. Num a => a -> a
signum Integer
m forall a. Ord a => a -> a -> Bool
< Integer
0 then Int
0x8000 else Int
0
  m1 :: Int
m1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs Integer
m :: Int
  -- bit len of m1, here m1 /= 0
  len :: Int
len = Int
1 forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Int
acc, Int
res) Int
y -> if Int
acc forall a. Bits a => a -> a -> a
.&. Int
y forall a. Eq a => a -> a -> Bool
== Int
0
                                         then (Int
acc,       Int
2forall a. Num a => a -> a -> a
*Int
res)
                                         else (Int
acc forall a. Bits a => a -> a -> a
.&. Int
y, Int
2forall a. Num a => a -> a -> a
*Int
res 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 forall a. Ord a => a -> a -> Bool
> Int
11 then (Int
len, Int
m1, Int
n)
                   else (Int
12, forall a. Bits a => a -> Int -> a
shiftL Int
m1 (Int
11 forall a. Num a => a -> a -> a
- Int
len), Int
n forall a. Num a => a -> a -> a
- (Int
11 forall a. Num a => a -> a -> a
- Int
len))
  e :: Int
e = Int
n' forall a. Num a => a -> a -> a
+ Int
len' forall a. Num a => a -> a -> a
- Int
1
  in
  if Int
e forall a. Ord a => a -> a -> Bool
> Int
15 then forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
s forall a. Bits a => a -> a -> a
.|. Int
0x7c00)
  else if Int
e forall a. Ord a => a -> a -> Bool
>= -Int
14 then let t' :: Int
t' = Int
len' forall a. Num a => a -> a -> a
- Int
11
                            m'' :: Int
m'' = Int
m' forall a. Num a => a -> a -> a
+ (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
t' forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+
                                  (forall a. Bits a => a -> Int -> a
shiftR Int
m' Int
t' forall a. Bits a => a -> a -> a
.&. Int
1)
                            len'' :: Int
len'' = if forall a. Bits a => a -> Int -> Bool
testBit Int
m'' Int
len then Int
len' forall a. Num a => a -> a -> a
+ Int
1 else Int
len'
                            t'' :: Int
t'' = Int
len'' forall a. Num a => a -> a -> a
- Int
11
                            e'' :: Int
e'' = Int
n' forall a. Num a => a -> a -> a
+ Int
len'' forall a. Num a => a -> a -> a
- Int
1
                            res :: Int
res = (forall a. Bits a => a -> Int -> a
shiftR Int
m'' Int
t'' forall a. Bits a => a -> a -> a
.&. Int
0x3ff) forall a. Bits a => a -> a -> a
.|.
                                  forall a. Bits a => a -> Int -> a
shiftL ((Int
e'' forall a. Num a => a -> a -> a
+ Int
15) forall a. Bits a => a -> a -> a
.&. Int
0x1f) Int
10 forall a. Bits a => a -> a -> a
.|.
                                  Int
s
                            in if Int
e'' forall a. Ord a => a -> a -> Bool
> Int
15
                               then forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
s forall a. Bits a => a -> a -> a
.|. Int
0x7c00)
                               else forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res
  -- subnormal
  else if Int
e forall a. Ord a => a -> a -> Bool
>= -Int
25 then let t :: Int
t = -Int
n' forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
-Int
11 forall a. Num a => a -> a -> a
- Int
14
                            m'' :: Int
m'' = Int
m' forall a. Num a => a -> a -> a
+ (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
t forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+
                                  (forall a. Bits a => a -> Int -> a
shiftR Int
m' Int
t forall a. Bits a => a -> a -> a
.&. Int
1)
                            res :: Int
res = forall a. Bits a => a -> Int -> a
shiftR Int
m'' Int
t forall a. Bits a => a -> a -> a
.|. Int
s
                            in if Int
e forall a. Eq a => a -> a -> Bool
== -Int
15 Bool -> Bool -> Bool
&& forall a. Bits a => a -> Int -> Bool
testBit Int
m'' (Int
10 forall a. Num a => a -> a -> a
+ Int
t)
                               then forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a. Bits a => a -> Int -> a
shiftR Int
m'' Int
t forall a. Bits a => a -> a -> a
.&. Int
0x3ff) forall a. Bits a => a -> a -> a
.|.
                                                   Int
0x400 forall a. Bits a => a -> a -> a
.|. Int
s
                               else forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res
  else 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' 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
1forall a. Fractional a => a -> a -> a
/Float
0
pure_halfToFloat' CUShort
0x7c00 =  Float
1forall 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 forall a. Bits a => a -> a -> a
.&. CUShort
0x7c00 forall a. Eq a => a -> a -> Bool
== CUShort
0x7c00) Bool -> Bool -> Bool
&& (CUShort
x forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff forall a. Eq a => a -> a -> Bool
/= CUShort
0) = Float
0forall a. Fractional a => a -> a -> a
/Float
0
pure_halfToFloat' CUShort
x = let
  s :: Integer
s = if CUShort
x forall a. Bits a => a -> a -> a
.&. CUShort
0x8000 forall a. Eq a => a -> a -> Bool
/= CUShort
0 then -Integer
1 else Integer
1
  e :: Int
e = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR CUShort
x Int
10) forall a. Bits a => a -> a -> a
.&. Int
0x1f :: Int
  m :: CUShort
m = CUShort
x forall a. Bits a => a -> a -> a
.&. CUShort
0x3ff
  (Int
a, CUShort
b) = if Int
e forall a. Ord a => a -> a -> Bool
> Int
0 then (Int
e forall a. Num a => a -> a -> a
- Int
15 forall a. Num a => a -> a -> a
- Int
10, CUShort
m forall a. Bits a => a -> a -> a
.|. CUShort
0x400)
           else (-Int
15 forall a. Num a => a -> a -> a
- Int
10 forall a. Num a => a -> a -> a
+ Int
1, CUShort
m)
  in forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
s forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral CUShort
b) Int
a