half-0.3/0000755000000000000000000000000013267402414010457 5ustar0000000000000000half-0.3/Setup.hs0000644000000000000000000000005613267402414012114 0ustar0000000000000000import Distribution.Simple main = defaultMain half-0.3/LICENSE0000644000000000000000000000235713267402414011473 0ustar0000000000000000Copyright 2014 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. half-0.3/half.cabal0000644000000000000000000000244413267402414012361 0ustar0000000000000000name: half category: Numeric version: 0.3 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/half bug-reports: http://github.com/ekmett/half/issues copyright: Copyright (C) 2014 Edward A. Kmett build-type: Simple synopsis: Half-precision floating-point description: Half-precision floating-point. extra-source-files: .travis.yml .gitignore README.markdown CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/half.git library hs-source-dirs: src c-sources: cbits/half.c build-depends: base >= 4.3 && < 5 , template-haskell if impl(ghc >= 7.8) build-depends: deepseq >= 1.4 && < 1.5 if impl(ghc < 7.6) build-depends: ghc-prim ghc-options: -Wall -fwarn-tabs -O2 if impl(ghc >= 8) ghc-options: -Wno-missing-pattern-synonym-signatures exposed-modules: Numeric.Half test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test ghc-options: -Wall if impl(ghc >= 7.8) build-depends: base >= 4.3 && < 5 , half , hspec >= 2.4 , QuickCheck >= 2.9 else buildable: False half-0.3/README.markdown0000644000000000000000000000116513267402414013163 0ustar0000000000000000half ==== [![Hackage](https://img.shields.io/hackage/v/half.svg)](https://hackage.haskell.org/package/half) [![Build Status](https://secure.travis-ci.org/ekmett/half.png?branch=master)](http://travis-ci.org/ekmett/half) This package supplies half-precision floating point values w/ 1 bit of sign, 5 bits of exponent, 11 bits of mantissa trailing a leading 1 bit with proper underflow. These arise commonly in GPU applications. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett half-0.3/.gitignore0000644000000000000000000000022613267402414012447 0ustar0000000000000000dist/ dist-newstyle/ .ghc.env* .hsenv/ docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# .cabal-sandbox/ cabal.sandbox.config codex.tags half-0.3/CHANGELOG.markdown0000644000000000000000000000160613267402414013515 0ustar00000000000000000.3 --- * Fixed bound in `floatRange`. * Fixed `decodeFloat`. * Added a `Lift` instance for `Half` for `template-haskell` support. 0.2.2.3 ------- * Avoid the new warnings for missing pattern synonym signatures on GHC 8 0.2.2.2 ------- * Fixed an issue with `Storable` that was causing crashing for some users. 0.2.2.1 ------- * Added support for older GHCs still. `unsafeShiftR` was only added in 7.4. 0.2.2 ----- * Fixed `isInfinite`. * Added support for older GHCs. On GHC < 7.8 the pattern synonyms are disabled. 0.2.1 ----- * Removed need for `GeneralizedNewtypeDeriving` and `ScopedTypeVariables`. 0.2.0.1 ------- * Fixed source repository location 0.2 --- * Renamed `toFloat` to `fromHalf` for easier unqualified use. * Added a `Read` instance. 0.1.1 ----- * Added a `CTYPE` to the Half declaration so that it can be used with `CApiFFI` as an unsigned short. 0.1 --- * Initial release half-0.3/.travis.yml0000644000000000000000000001133313267402414012571 0ustar0000000000000000language: c sudo: false cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: include: - env: CABALVER=1.16 GHCVER=7.4.2 compiler: ": #GHC 7.4.2" addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.16 GHCVER=7.6.3 compiler: ": #GHC 7.6.3" addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=7.10.1 compiler: ": #GHC 7.10.1" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=7.10.2 compiler: ": #GHC 7.10.2" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=8.0.2 compiler: ": #GHC 8.0.2" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=8.2.2 compiler: ": #GHC 8.2.2" addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=2.0 GHCVER=8.4.1 compiler: ": #GHC 8.4.1" addons: {apt: {packages: [cabal-install-2.0,ghc-8.4.1,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=head GHCVER=head compiler: ": #GHC head" addons: {apt: {packages: [cabal-install-head,ghc-head,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} # NOTE: The `primitve` package is currently broken with 8.4.1, remove the line below when this is fixed. allow_failures: - env: CABALVER=2.0 GHCVER=8.4.1 - env: CABALVER=head GHCVER=head before_install: - unset CC - export HAPPYVER=1.19.5 - export ALEXVER=3.1.7 - export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH install: - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi - travis_retry cabal update - "sed -i 's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config" - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install --only-dependencies --enable-tests --enable-benchmarks; if [ "$GHCVER" = "7.10.1" ]; then cabal install Cabal-1.22.4.0; fi; fi # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - cabal configure --enable-tests -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests) - cabal test - cabal bench || true # expected result: these will crash - cabal sdist || true # tests that a source-distribution can be generated # Check that the resulting source distribution can be built & installed. # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ") notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313half\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f" # EOF half-0.3/cbits/0000755000000000000000000000000013267402414011563 5ustar0000000000000000half-0.3/cbits/half.c0000644000000000000000000000273613267402414012651 0ustar0000000000000000unsigned short hs_floatToHalf (float f) { union { float d; unsigned int i; } u = { f }; int s = (u.i >> 16) & 0x8000; int e = ((u.i >> 23) & 0xff) - 112; int m = u.i & 0x7fffff; if (e <= 0) { if (e < -10) return s; /* underflowed */ /* force leading 1 and round */ m |= 0x800000; int t = 14 - e; int a = (1 << (t - 1)) - 1; int b = (m >> t) & 1; return s | ((m + a + b) >> t); } if (e == 143) { if (m == 0) return s | 0x7c00; /* +/- infinity */ /* NaN, m == 0 forces us to set at least one bit and not become an infinity */ m >>= 13; return s | 0x7c00 | m | (m == 0); } /* round the normalized float */ m = m + 0xfff + ((m >> 13) & 1); /* significand overflow */ if (m & 0x800000) { m = 0; e += 1; } /* exponent overflow */ if (e > 30) return s | 0x7c00; return s | (e << 10) | (m >> 13); } int hs_halfToFloatRep (unsigned short c) { int s = (c >> 15) & 0x001; int e = (c >> 10) & 0x01f; int m = c & 0x3ff; if (e == 0) { if (m == 0) /* +/- 0 */ return s << 31; /* denormalized, renormalize it */ while (!(m & 0x400)) { m <<= 1; e -= 1; } e += 1; m &= ~0x400; } else if (e == 31) return (s << 31) | 0x7f800000 | (m << 13); /* NaN or +/- infinity */ e += 112; m <<= 13; return (s << 31) | (e << 23) | m; } float hs_halfToFloat (unsigned short c) { union { float d; unsigned int i; } u; u.i = hs_halfToFloatRep(c); return u.d; } half-0.3/test/0000755000000000000000000000000013267402414011436 5ustar0000000000000000half-0.3/test/Spec.hs0000644000000000000000000000155313267402414012670 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} import Numeric.Half import Test.Hspec import Test.QuickCheck instance Arbitrary Half where arbitrary = fmap Half arbitrary main :: IO () main = hspec $ do describe "Half Ord instance" $ do it "(>=) is the opposite of (<) except for NaN" $ property $ \x y -> ((x >= y) /= (x < y)) || isNaN x || isNaN (y :: Half) let nans = [QNaN, SNaN] it "returns False for NaN > NaN" $ or [a > b | a <- nans, b <- nans] `shouldBe` False it "returns False for NaN < NaN" $ or [a < b | a <- nans, b <- nans] `shouldBe` False describe "Round trip" $ do let roundTrip w = (getHalf . toHalf . fromHalf . Half $ w) == w it "should round trip properly" $ property roundTrip it "should round trip for a NaN value" $ roundTrip 0x7d00 `shouldBe` True half-0.3/src/0000755000000000000000000000000013267402414011246 5ustar0000000000000000half-0.3/src/Numeric/0000755000000000000000000000000013267402414012650 5ustar0000000000000000half-0.3/src/Numeric/Half.hs0000644000000000000000000001636413267402414014070 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TemplateHaskell #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE PatternSynonyms #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2014 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : PatternSynonyms -- -- Half-precision floating-point values. These arise commonly in GPU work -- and it is useful to be able to compute them and compute with them on the -- CPU as well. ---------------------------------------------------------------------------- module Numeric.Half ( Half(..) , isZero , fromHalf , toHalf #if __GLASGOW_HASKELL__ >= 708 , pattern POS_INF , pattern NEG_INF , pattern QNaN , pattern SNaN , pattern HALF_MIN , pattern HALF_NRM_MIN , pattern HALF_MAX , pattern HALF_EPSILON , pattern HALF_DIG , pattern HALF_MIN_10_EXP , pattern HALF_MAX_10_EXP #endif ) where #if __GLASGOW_HASKELL__ >= 708 import Control.DeepSeq (NFData) #endif import Data.Bits import Data.Function (on) import Data.Int import Data.Typeable import Foreign.C.Types import Foreign.Ptr (castPtr) import Foreign.Storable import GHC.Generics import Language.Haskell.TH import Language.Haskell.TH.Syntax import Text.Read hiding (lift) -- | Convert a 'Float' to a 'Half' with proper rounding, while preserving NaN and dealing appropriately with infinity foreign import ccall unsafe "hs_floatToHalf" toHalf :: Float -> Half -- {-# RULES "toHalf" realToFrac = toHalf #-} -- | Convert a 'Half' to a 'Float' while preserving NaN foreign import ccall unsafe "hs_halfToFloat" fromHalf :: Half -> Float -- {-# RULES "fromHalf" realToFrac = fromHalf #-} newtype #if __GLASGOW_HASKELL__ >= 706 {-# CTYPE "unsigned short" #-} #endif Half = Half { getHalf :: CUShort } deriving (Generic, Typeable) #if __GLASGOW_HASKELL__ >= 708 instance NFData Half where #endif instance Storable Half where sizeOf = sizeOf . getHalf alignment = alignment . getHalf peek p = fmap Half (peek (castPtr p)) poke p = poke (castPtr p) . getHalf instance Show Half where showsPrec d h = showsPrec d (fromHalf h) instance Read Half where readPrec = fmap toHalf readPrec instance Eq Half where (==) = (==) `on` fromHalf instance Ord Half where compare = compare `on` fromHalf (<) = (<) `on` fromHalf (<=) = (<=) `on` fromHalf (>) = (>) `on` fromHalf (>=) = (>=) `on` fromHalf instance Real Half where toRational = toRational . fromHalf instance Fractional Half where fromRational = toHalf . fromRational recip = toHalf . recip . fromHalf a / b = toHalf $ fromHalf a / fromHalf b instance RealFrac Half where properFraction a = case properFraction (fromHalf a) of (b, c) -> (b, toHalf c) truncate = truncate . fromHalf round = round . fromHalf ceiling = ceiling . fromHalf floor = floor . fromHalf instance Floating Half where pi = toHalf pi exp = toHalf . exp . fromHalf sqrt = toHalf . sqrt . fromHalf log = toHalf . log . fromHalf a ** b = toHalf $ fromHalf a ** fromHalf b logBase a b = toHalf $ logBase (fromHalf a) (fromHalf b) sin = toHalf . sin . fromHalf tan = toHalf . tan . fromHalf cos = toHalf . cos . fromHalf asin = toHalf . asin . fromHalf atan = toHalf . atan . fromHalf acos = toHalf . acos . fromHalf sinh = toHalf . sinh . fromHalf tanh = toHalf . tanh . fromHalf cosh = toHalf . cosh . fromHalf asinh = toHalf . asinh . fromHalf atanh = toHalf . atanh . fromHalf acosh = toHalf . acosh . fromHalf instance RealFloat Half where floatRadix _ = 2 floatDigits _ = 11 decodeFloat = ieee754_f16_decode isIEEE _ = isIEEE (undefined :: Float) atan2 a b = toHalf $ atan2 (fromHalf a) (fromHalf b) #if MIN_VERSION_base(4,5,0) isInfinite (Half h) = unsafeShiftR h 10 .&. 0x1f >= 31 isDenormalized (Half h) = unsafeShiftR h 10 .&. 0x1f == 0 && h .&. 0x3ff /= 0 isNaN (Half h) = unsafeShiftR h 10 .&. 0x1f == 0x1f && h .&. 0x3ff /= 0 #else isInfinite (Half h) = shiftR h 10 .&. 0x1f >= 31 isDenormalized (Half h) = shiftR h 10 .&. 0x1f == 0 && h .&. 0x3ff /= 0 isNaN (Half h) = shiftR h 10 .&. 0x1f == 0x1f && h .&. 0x3ff /= 0 #endif isNegativeZero (Half h) = h == 0x8000 floatRange _ = (-13,16) encodeFloat i j = toHalf $ encodeFloat i j exponent = exponent . fromHalf significand = toHalf . significand . fromHalf scaleFloat n = toHalf . scaleFloat n . fromHalf -- | Is this 'Half' equal to 0? isZero :: Half -> Bool isZero (Half h) = h .&. 0x7fff == 0 #if __GLASGOW_HASKELL__ >= 708 -- | Positive infinity pattern POS_INF = Half 0x7c00 -- | Negative infinity pattern NEG_INF = Half 0xfc00 -- | Quiet NaN pattern QNaN = Half 0x7fff -- | Signalling NaN pattern SNaN = Half 0x7dff -- | Smallest positive half pattern HALF_MIN = Half 0x0001 -- 5.96046448e-08 -- | Smallest positive normalized half pattern HALF_NRM_MIN = Half 0x0400 -- 6.10351562e-05 -- | Largest positive half pattern HALF_MAX = Half 0x7bff -- 65504.0 -- | Smallest positive e for which half (1.0 + e) != half (1.0) pattern HALF_EPSILON = Half 0x1400 -- 0.00097656 -- | Number of base 10 digits that can be represented without change pattern HALF_DIG = 2 -- Minimum positive integer such that 10 raised to that power is a normalized half pattern HALF_MIN_10_EXP = -4 -- Maximum positive integer such that 10 raised to that power is a normalized half pattern HALF_MAX_10_EXP = 4 #endif instance Num Half where a * b = toHalf (fromHalf a * fromHalf b) a - b = toHalf (fromHalf a - fromHalf b) a + b = toHalf (fromHalf a + fromHalf b) negate (Half a) = Half (xor 0x8000 a) abs = toHalf . abs . fromHalf signum = toHalf . signum . fromHalf fromInteger a = toHalf (fromInteger a) instance Lift Half where lift (Half (CUShort w)) = appE (conE 'Half) . appE (conE 'CUShort) . litE . integerL . fromIntegral $ w -- Adapted from ghc/rts/StgPrimFloat.c -- ieee754_f16_decode :: Half -> (Integer, Int) ieee754_f16_decode (Half (CUShort i)) = let _HHIGHBIT = 0x0400 _HMSBIT = 0x8000 _HMINEXP = ((_HALF_MIN_EXP) - (_HALF_MANT_DIG) - 1) _HALF_MANT_DIG = floatDigits (undefined::Half) (_HALF_MIN_EXP, _HALF_MAX_EXP) = floatRange (undefined::Half) high1 = fromIntegral i high2 = high1 .&. (_HHIGHBIT - 1) exp1 = ((fromIntegral high1 `unsafeShiftR` 10) .&. 0x1F) + _HMINEXP exp2 = exp1 + 1 (high3, exp3) = if exp1 /= _HMINEXP then (high2 .|. _HHIGHBIT, exp1) else let go (!h, !e) = if h .&. _HHIGHBIT /= 0 then go (h `unsafeShiftL` 1, e-1) else (h, e) in go (high2, exp2) high4 = if fromIntegral i < (0 :: Int16) then -high3 else high3 in if high1 .&. complement _HMSBIT == 0 then (0,0) else (high4, exp3)