half (empty) → 0.1

raw patch · 9 files changed

+375/−0 lines, 9 filesdep +basesetup-changed

Dependencies added: base

Files

.gitignore +17/−0
.travis.yml +56/−0
CHANGELOG.markdown +4/−0
LICENSE +26/−0
README.markdown +17/−0
Setup.hs +2/−0
cbits/half.c +62/−0
half.cabal +33/−0
src/Numeric/Half.hs +158/−0

+ .gitignore view

@@ -0,0 +1,17 @@+dist/+.hsenv/+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#+.cabal-sandbox/+cabal.sandbox.config+codex.tags

+ .travis.yml view

@@ -0,0 +1,56 @@+language: haskell++env:+  - GHCVER=7.4.2+  - GHCVER=7.6.3+  - GHCVER=7.8.3+  - GHCVER=head++matrix:+  allow_failures:+    - env: GHCVER=head++before_install:+  # If $GHCVER is the one travis has, don't bother reinstalling it.+  # We can also have faster builds by installing some libraries with+  # `apt`. If it isn't, install the GHC we want from hvr's PPA along+  # with cabal-1.18.+  - |+    if [ $GHCVER = `ghc --numeric-version` ]; then+      # Try installing some of the build-deps with apt-get for speed.+      travis/cabal-apt-install --enable-tests $MODE+      export CABAL=cabal+    else+      # Install the GHC we want from hvr's PPA+      travis_retry sudo add-apt-repository -y ppa:hvr/ghc+      travis_retry sudo apt-get update+      travis_retry sudo apt-get install cabal-install-1.18 ghc-$GHCVER happy+      export CABAL=cabal-1.18+      export PATH=/opt/ghc/$GHCVER/bin:$PATH+    fi+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && $CABAL update+  - $CABAL update++  # Update happy when building with GHC head+  - |+    if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.3" ]; then+      $CABAL install happy alex+      export PATH=$HOME/.cabal/bin:$PATH+    fi++install:+  - $CABAL install --dependencies-only --enable-tests+  - $CABAL configure --enable-tests $MODE++script:+  - $CABAL build+  - $CABAL test --show-details=always++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313gl\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"

+ CHANGELOG.markdown view

@@ -0,0 +1,4 @@+0.1+---+* Initial release+

+ LICENSE view

@@ -0,0 +1,26 @@+Copyright 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.

+ README.markdown view

@@ -0,0 +1,17 @@+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

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ cbits/half.c view

@@ -0,0 +1,62 @@+unsigned 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.cabal view

@@ -0,0 +1,33 @@+name:          half+category:      Numeric+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+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+tested-with:   GHC == 7.8.3+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/analytics/half.git++library+  hs-source-dirs: src+  c-sources: cbits/half.c+  build-depends: base >= 4.3 && < 5+  ghc-options: -Wall -fwarn-tabs -O2+  exposed-modules: Numeric.Half

+ src/Numeric/Half.hs view

@@ -0,0 +1,158 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- 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 +  ( Half(..)+  , isZero+  , toFloat+  , toHalf+  , 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+  ) where++import Data.Bits+import Data.Function (on)+import Data.Typeable+import Foreign.C.Types+import Foreign.Storable++-- | 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" toFloat :: Half -> Float+{-# RULES "toFloat" realToFrac = toFloat #-}++newtype Half = Half { getHalf :: CUShort } deriving (Storable, Typeable)++instance Show Half where+  showsPrec d h = showsPrec d (toFloat h)++instance Eq Half where+  (==) = (==) `on` toFloat++instance Ord Half where+  compare = compare `on` toFloat++instance Real Half where+  toRational = toRational . toFloat++instance Fractional Half where+  fromRational = toHalf . fromRational+  recip = toHalf . recip . toFloat+  a / b = toHalf $ toFloat a / toFloat b++instance RealFrac Half where+  properFraction a = case properFraction (toFloat a) of+    (b, c) -> (b, toHalf c)+  truncate = truncate . toFloat+  round = round . toFloat+  ceiling = ceiling . toFloat+  floor = floor . toFloat++instance Floating Half where+  pi = toHalf pi+  exp = toHalf . exp . toFloat+  sqrt = toHalf . sqrt . toFloat+  log = toHalf . log . toFloat+  a ** b = toHalf $ toFloat a ** toFloat b+  logBase a b = toHalf $ logBase (toFloat a) (toFloat b)+  sin = toHalf . sin . toFloat+  tan = toHalf . tan . toFloat+  cos = toHalf . cos . toFloat+  asin = toHalf . asin . toFloat+  atan = toHalf . atan . toFloat+  acos = toHalf . acos . toFloat+  sinh = toHalf . sinh . toFloat+  tanh = toHalf . tanh . toFloat+  cosh = toHalf . cosh . toFloat+  asinh = toHalf . asinh . toFloat+  atanh = toHalf . atanh . toFloat+  acosh = toHalf . acosh . toFloat++instance RealFloat Half where+  floatRadix  _ = 2+  floatDigits _ = 11+  decodeFloat = decodeFloat . toFloat+  isInfinite (Half h) = unsafeShiftR h 10 .&. 0x1f >= 32+  isIEEE _ = isIEEE (undefined :: Float)+  atan2 a b = toHalf $ atan2 (toFloat a) (toFloat b)+  isDenormalized (Half h) = unsafeShiftR h 10 .&. 0x1f == 0 && h .&. 0x3ff /= 0+  isNaN (Half h) = unsafeShiftR h 10 .&. 0x1f == 0x1f && h .&. 0x3ff /= 0+  isNegativeZero (Half h) = h == 0x8000+  floatRange _ = (16,-13)+  encodeFloat i j = toHalf $ encodeFloat i j+  exponent = exponent . toFloat+  significand = toHalf . significand . toFloat+  scaleFloat n = toHalf . scaleFloat n . toFloat++-- | Is this 'Half' equal to 0?+isZero :: Half -> Bool+isZero (Half h) = h .&. 0x7fff == 0++-- | 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 = 5.96046448e-08 :: Half ++-- | Smallest positive normalized half+pattern HALF_NRM_MIN = 6.10351562e-05 :: Half++-- | Largest positive half+pattern HALF_MAX = 65504.0 :: Half++-- | Smallest positive e for which half (1.0 + e) != half (1.0)+pattern HALF_EPSILON = 0.00097656 :: Half++-- | 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++instance Num Half where+  a * b = toHalf (toFloat a * toFloat b)+  a - b = toHalf (toFloat a - toFloat b)+  a + b = toHalf (toFloat a + toFloat b)+  negate (Half a) = Half (xor 0x8000 a)+  abs = toHalf . abs . toFloat+  signum = toHalf . signum . toFloat+  fromInteger a = toHalf (fromInteger a)