Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-half for openSUSE:Factory checked in at 2021-01-20 18:25:13 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-half (Old) and /work/SRC/openSUSE:Factory/.ghc-half.new.28504 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-half" Wed Jan 20 18:25:13 2021 rev:4 rq:863266 version:0.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-half/ghc-half.changes 2020-12-22 11:40:10.897543946 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-half.new.28504/ghc-half.changes 2021-01-20 18:25:44.239421477 +0100 @@ -1,0 +2,14 @@ +Tue Jan 5 12:05:36 UTC 2021 - [email protected] + +- Update half to version 0.3.1. + 0.3.1 [2021-01-04] + ------------------ + * Downgraded testing claims that NaNs will round-trip, as 32-bit GHCs aren't fulfilling that promise. + Now we merely claim that a NaN will return as a NaN. + * Always provide `NFData Half` instance + * Add `Binary Half` instance + * Explicitly mark module as `Trustworthy` + * Fix `isInfinite` + * Add experimental support for GHCJS, add pure conversion functions. + +------------------------------------------------------------------- Old: ---- half-0.3.tar.gz New: ---- half-0.3.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-half.spec ++++++ --- /var/tmp/diff_new_pack.bPMwCi/_old 2021-01-20 18:25:45.939423095 +0100 +++ /var/tmp/diff_new_pack.bPMwCi/_new 2021-01-20 18:25:45.943423099 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-half # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2021 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,20 +19,23 @@ %global pkg_name half %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3 +Version: 0.3.1 Release: 0 Summary: Half-precision floating-point License: BSD-2-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-binary-devel BuildRequires: ghc-deepseq-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-template-haskell-devel ExcludeArch: %{ix86} %if %{with tests} BuildRequires: ghc-QuickCheck-devel -BuildRequires: ghc-hspec-devel +BuildRequires: ghc-bytestring-devel +BuildRequires: ghc-test-framework-devel +BuildRequires: ghc-test-framework-quickcheck2-devel %endif %description ++++++ half-0.3.tar.gz -> half-0.3.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/.travis.yml new/half-0.3.1/.travis.yml --- old/half-0.3/.travis.yml 2018-04-23 18:08:44.000000000 +0200 +++ new/half-0.3.1/.travis.yml 1970-01-01 01:00:00.000000000 +0100 @@ -1,113 +0,0 @@ -language: 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/CHANGELOG.markdown new/half-0.3.1/CHANGELOG.markdown --- old/half-0.3/CHANGELOG.markdown 2018-04-23 18:08:44.000000000 +0200 +++ new/half-0.3.1/CHANGELOG.markdown 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,13 @@ +0.3.1 [2021-01-04] +------------------ +* Downgraded testing claims that NaNs will round-trip, as 32-bit GHCs aren't fulfilling that promise. + Now we merely claim that a NaN will return as a NaN. +* Always provide `NFData Half` instance +* Add `Binary Half` instance +* Explicitly mark module as `Trustworthy` +* Fix `isInfinite` +* Add experimental support for GHCJS, add pure conversion functions. + 0.3 --- * Fixed bound in `floatRange`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/README.markdown new/half-0.3.1/README.markdown --- old/half-0.3/README.markdown 2018-04-23 18:08:44.000000000 +0200 +++ new/half-0.3.1/README.markdown 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,7 @@ half ==== -[](https://hackage.haskell.org/package/half) [](http://travis-ci.org/ekmett/half) +[](https://hackage.haskell.org/package/half) [](https://github.com/ekmett/half/actions?query=workflow%3AHaskell-CI) 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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/Setup.hs new/half-0.3.1/Setup.hs --- old/half-0.3/Setup.hs 2018-04-23 18:08:44.000000000 +0200 +++ new/half-0.3.1/Setup.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/half.cabal new/half-0.3.1/half.cabal --- old/half-0.3/half.cabal 2018-04-23 18:08:44.000000000 +0200 +++ new/half-0.3.1/half.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,55 +1,85 @@ -name: half -category: Numeric -version: 0.3 -license: BSD3 -cabal-version: >= 1.8 -license-file: LICENSE -author: Edward A. Kmett -maintainer: Edward A. Kmett <[email protected]> -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. - +cabal-version: >=1.10 +name: half +version: 0.3.1 +license: BSD3 +license-file: LICENSE +copyright: Copyright (C) 2014 Edward A. Kmett +maintainer: Edward A. Kmett <[email protected]> +author: Edward A. Kmett +stability: provisional +homepage: http://github.com/ekmett/half +bug-reports: http://github.com/ekmett/half/issues +synopsis: Half-precision floating-point +description: + Half-precision floating-point. +category: Numeric +build-type: Simple extra-source-files: - .travis.yml - .gitignore - README.markdown - CHANGELOG.markdown + .gitignore + README.markdown + CHANGELOG.markdown + +tested-with: GHC == 7.4.2 + , GHC == 7.6.3 + , GHC == 7.8.4 + , GHC == 7.10.3 + , GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.3 source-repository head - type: git - location: git://github.com/ekmett/half.git + 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 + default-language: Haskell2010 + exposed-modules: + Numeric.Half + Numeric.Half.Internal + hs-source-dirs: src + other-extensions: BangPatterns CPP DeriveDataTypeable DeriveGeneric + ForeignFunctionInterface + ghc-options: -Wall -fwarn-tabs -O2 + build-depends: + base >=4.5 && <5, + binary >=0.5.1.0 && <0.9, + deepseq >=1.3.0.0 && <1.5, + template-haskell + + if !impl(ghcjs) + c-sources: + cbits/half.c + + if impl(ghc >= 8.0) + other-extensions: DeriveLift StandaloneDeriving + else + other-extensions: TemplateHaskell + + if impl(ghc >=7.8) + other-extensions: PatternSynonyms + + if impl(ghc <7.6) + build-depends: + ghc-prim - exposed-modules: Numeric.Half + if impl(ghc >=8) + ghc-options: -Wno-missing-pattern-synonym-signatures test-suite spec - type: exitcode-stdio-1.0 - main-is: Spec.hs - hs-source-dirs: test - ghc-options: -Wall - if impl(ghc >= 7.8) + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + ghc-options: -Wall + build-depends: - base >= 4.3 && < 5 - , half - , hspec >= 2.4 - , QuickCheck >= 2.9 - else - buildable: False + base, + binary, + bytestring, + half, + QuickCheck >=2.14.1 && <2.15, + test-framework, + test-framework-quickcheck2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/src/Numeric/Half/Internal.hs new/half-0.3.1/src/Numeric/Half/Internal.hs --- old/half-0.3/src/Numeric/Half/Internal.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/half-0.3.1/src/Numeric/Half/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,355 @@ +{-# 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 { getHalf :: CUShort } deriving (Generic, Typeable) + +instance NFData Half where +#if MIN_VERSION_deepseq(1,4,0) + rnf (Half f) = rnf f +#else + rnf (Half f) = f `seq` () +#endif + +instance Binary Half where + put (Half (CUShort w)) = put w + get = fmap (Half . CUShort) get + +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) + + isInfinite (Half h) = unsafeShiftR h 10 .&. 0x1f >= 31 && h .&. 0x3ff == 0 + 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 _ = (-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) + +#if __GLASGOW_HASKELL__ >= 800 +instance Lift Half where + lift (Half (CUShort 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 (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) + +-- | Naive pure-Haskell implementation of 'toHalf'. +-- +pure_floatToHalf :: Float -> Half +pure_floatToHalf = Half . pure_floatToHalf' + +pure_floatToHalf' :: Float -> CUShort +pure_floatToHalf' x | isInfinite x = if x < 0 then 0xfc00 else 0x7c00 +pure_floatToHalf' x | isNaN x = 0xfe00 +-- for some reason, comparing with 0 and then deciding sign fails with GHC-7.8 +pure_floatToHalf' x | isNegativeZero x = 0x8000 +pure_floatToHalf' 0 = 0 +pure_floatToHalf' x = let + (m, n) = decodeFloat x + -- sign bit + s = if signum m < 0 then 0x8000 else 0 + m1 = fromIntegral $ abs m :: Int + -- bit len of m1, here m1 /= 0 + len = 1 + snd (foldl (\(acc, res) y -> if acc .&. y == 0 + then (acc, 2*res) + else (acc .&. y, 2*res + 1)) + (m1, 0) + [ 0xffff0000, 0xff00ff00ff00, 0xf0f0f0f0 + , 0xcccccccc, 0xaaaaaaaa] + ) + -- scale to at least 12bit + (len', m', n') = if len > 11 then (len, m1, n) + else (12, shiftL m1 (11 - len), n - (11 - len)) + e = n' + len' - 1 + in + if e > 15 then fromIntegral (s .|. 0x7c00) + else if e >= -14 then let t' = len' - 11 + m'' = m' + (2 ^ (t' - 1) - 1) + + (shiftR m' t' .&. 1) + len'' = if testBit m'' len then len' + 1 else len' + t'' = len'' - 11 + e'' = n' + len'' - 1 + res = (shiftR m'' t'' .&. 0x3ff) .|. + shiftL ((e'' + 15) .&. 0x1f) 10 .|. + s + in if e'' > 15 + then fromIntegral (s .|. 0x7c00) + else fromIntegral res + -- subnormal + else if e >= -25 then let t = -n' + 1 -11 - 14 + m'' = m' + (2 ^ (t - 1) - 1) + + (shiftR m' t .&. 1) + res = shiftR m'' t .|. s + in if e == -15 && testBit m'' (10 + t) + then fromIntegral $ (shiftR m'' t .&. 0x3ff) .|. + 0x400 .|. s + else fromIntegral res + else fromIntegral s + +-- | Naive pure-Haskell implementation of 'fromHalf'. +pure_halfToFloat :: Half -> Float +pure_halfToFloat = pure_halfToFloat' . getHalf + +pure_halfToFloat' :: CUShort -> Float +pure_halfToFloat' 0xfc00 = -1/0 +pure_halfToFloat' 0x7c00 = 1/0 +pure_halfToFloat' 0x0000 = 0 +pure_halfToFloat' 0x8000 = -0 +pure_halfToFloat' x | (x .&. 0x7c00 == 0x7c00) && (x .&. 0x3ff /= 0) = 0/0 +pure_halfToFloat' x = let + s = if x .&. 0x8000 /= 0 then -1 else 1 + e = fromIntegral (shiftR x 10) .&. 0x1f :: Int + m = x .&. 0x3ff + (a, b) = if e > 0 then (e - 15 - 10, m .|. 0x400) + else (-15 - 10 + 1, m) + in encodeFloat (s * fromIntegral b) a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/src/Numeric/Half.hs new/half-0.3.1/src/Numeric/Half.hs --- old/half-0.3/src/Numeric/Half.hs 2018-04-23 18:08:44.000000000 +0200 +++ new/half-0.3.1/src/Numeric/Half.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,15 +1,7 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} #if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE PatternSynonyms #-} -#endif - -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 +{-# LANGUAGE PatternSynonyms #-} #endif ----------------------------------------------------------------------------- @@ -30,6 +22,8 @@ , isZero , fromHalf , toHalf + -- * Patterns + -- | These are available with GHC-7.8 and later. #if __GLASGOW_HASKELL__ >= 708 , pattern POS_INF , pattern NEG_INF @@ -45,209 +39,4 @@ #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) - +import Numeric.Half.Internal diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/half-0.3/test/Spec.hs new/half-0.3.1/test/Spec.hs --- old/half-0.3/test/Spec.hs 2018-04-23 18:08:44.000000000 +0200 +++ new/half-0.3.1/test/Spec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,32 +1,183 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE PatternSynonyms #-} +#endif {-# OPTIONS_GHC -fno-warn-orphans #-} -import Numeric.Half -import Test.Hspec -import Test.QuickCheck +import Numeric.Half +import Numeric.Half.Internal +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Arbitrary (..), Property, counterexample, (===), (==>), property, once) +import Foreign.C.Types +import Data.List (sort) +import qualified Data.Binary as Binary +import qualified Data.ByteString.Lazy as LBS 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) +qnan :: Half +qnan = Half 0x7fff + +snan :: Half +snan = Half 0x7dff + +pos_inf :: Half +pos_inf = Half 0x7c00 - let nans = [QNaN, SNaN] +neg_inf :: Half +neg_inf = Half 0xfc00 - it "returns False for NaN > NaN" $ - or [a > b | a <- nans, b <- nans] `shouldBe` False +nans :: [Half] +nans = [qnan, snan] - it "returns False for NaN < NaN" $ - or [a < b | a <- nans, b <- nans] `shouldBe` False +-- test QNaN, SNaN patterns + +main :: IO () +main = defaultMain + [ testGroup "Half Ord instance" + [ testProperty "(>=) is the opposite of (<) except for NaN" $ \x y -> + ((x >= y) /= (x < y)) || isNaN x || isNaN (y :: Half) - describe "Round trip" $ do - let roundTrip w = (getHalf . toHalf . fromHalf . Half $ w) == w + , testProperty "returns False for NaN > NaN" $ + or [a > b | a <- nans, b <- nans] === False - it "should round trip properly" $ - property roundTrip + , testProperty "returns False for NaN < NaN" $ + or [a < b | a <- nans, b <- nans] === False - it "should round trip for a NaN value" $ - roundTrip 0x7d00 `shouldBe` True + ] + , testGroup "Round trip" + [ testProperty "should round trip properly" $ \w -> + if isNaN w + then property $ isNaN $ toHalf (fromHalf w) -- nans go to nans + else toHalf (fromHalf w) === w -- everything goes to itself + + , testProperty "idempotence 1" $ \w -> + not (isNaN w) ==> fromHalf (toHalf $ fromHalf w) === fromHalf w + + , testProperty "idempotence 2" $ \w -> + toHalf (fromHalf $ toHalf w) === toHalf w + ] + + , testGroup "isInfinite" + [ testProperty "should be equivalent to \\x -> x == POS_INF || x == NEG_INF" $ \x -> + isInfinite x === (x == pos_inf || x == neg_inf) + , testProperty "should return True on POS_INF" $ + isInfinite pos_inf === True + , testProperty "should return True on NEG_INF" $ + isInfinite neg_inf === True + , testProperty "should return false on QNaN" $ + isInfinite qnan === False + , testProperty "should return false on SNaN" $ + isInfinite snan === False + ] + +#if __GLASGOW_HASKELL__ >= 708 + , testGroup "Patterns" + [ testProperty "QNaN" $ case qnan of + QNaN -> True + _ -> False + , testProperty "SNaN" $ case snan of + SNaN -> True + _ -> False + , testProperty "POS_INF" $ case pos_inf of + POS_INF -> True + _ -> False + , testProperty "NEG_INF" $ case neg_inf of + NEG_INF -> True + _ -> False + ] +#endif + + -- With GHCJS these tests are trivially true. + , testGroup "Native fromHalf against C version" + [ testProperty "for full CUShort range, both version of fromHalf should return same Float" $ + once prop_from_half_list + ] + + , testGroup "Native toHalf against C version" + [ testProperty "for selected range of Float, both version of toHalf should return same Half" $ + once prop_to_half_list + ] + + , testGroup "Binary" + [ testProperty "Binary round trip a" prop_binary_roundtrip_a + , testProperty "Binary round trip b" prop_binary_roundtrip_b + + -- big endian + , testProperty "Binary encoding example" $ + Binary.encode neg_inf === LBS.pack [252, 0] + ] + ] + +------------------------------------------------------------------------------- +-- Binary +------------------------------------------------------------------------------- + +prop_binary_roundtrip_a :: Half -> Property +prop_binary_roundtrip_a h = getHalf h === getHalf (Binary.decode (Binary.encode h)) + +prop_binary_roundtrip_b :: Half -> Property +prop_binary_roundtrip_b h = not (isNaN h) ==> h === Binary.decode (Binary.encode h) + +------------------------------------------------------------------------------- +-- Pure conversions +------------------------------------------------------------------------------- + +-- test native haskell implementation of toHalf & fromHalf against with C version +prop_from_half :: CUShort -> Bool +prop_from_half i = let + ref = fromHalf $ Half i + imp = pure_halfToFloat $ Half i + in (isNaN ref && isNaN imp) || (ref == imp) + +newtype U16List = U16List [CUShort] deriving (Eq, Ord, Show) + +instance Arbitrary U16List where + arbitrary = return (U16List [0 .. 65535]) + shrink (U16List (_ : [])) = [] + shrink (U16List x) = let p = length x `div` 2 + in [U16List $ take p x, U16List $ drop p x] + +prop_from_half_list :: U16List -> Bool +prop_from_half_list (U16List l) = all id $ map prop_from_half l + +prop_to_half :: Float -> Bool +prop_to_half i = let + ref = getHalf $ toHalf i + imp = getHalf $ pure_floatToHalf i + in ref == imp + +-- cover all range of Half(not Float) +list1 :: [Float] +list1 = let + r1 = filter (not . isNaN) $ map (fromHalf . Half) [0 .. 65535] + r2 = sort $ filter (not . isInfinite) $ filter (>= 0) r1 + r3 = r2 ++ [last r2 + 2 ** 11] + r4 = zipWith (\a b -> let d = (b - a) / 4 + in [a, a + d, a + d * 2, a + d * 3]) + r3 (tail r3) + r5 = concat r4 ++ [last r3] + in r5 + +list2 :: [Float] +list2 = map negate list1 + +list3 :: [Float] +list3 = [1/0, -1/0, 0, -0, 0/0] + + +newtype FloatList = FloatList [Float] deriving (Eq, Ord, Show) + +instance Arbitrary FloatList where + arbitrary = return (FloatList $ list1 ++ list2 ++ list3) + shrink (FloatList (_ : [])) = [] + shrink (FloatList x) = let p = length x `div` 2 + in [FloatList $ take p x, FloatList $ drop p x] + +prop_to_half_list :: FloatList -> Property +prop_to_half_list (FloatList l) = counterexample + (show [ (getHalf (toHalf f), getHalf (pure_floatToHalf f), f, isNegativeZero f) | f <- take 3 l]) + $ all id $ map prop_to_half l
