packages feed

fp-ieee 0.1.0 → 0.1.0.1

raw patch · 5 files changed

+265/−3 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for fp-ieee +## Version 0.1.0.1 (2021-01-02)++Fix some packaging issues.+ ## Version 0.1.0 (2020-12-27)  Initial release.
+ decimal-test/Util.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}+module Util where+import           Control.Applicative+import           Data.Ratio+import           Numeric+import           Numeric.Decimal+import           Numeric.Floating.IEEE+import           System.Random+import           Test.QuickCheck++-- | Compares two floating point values.+--+-- Unlike @(==)@, @+0@ and @-0@ are considered distinct and NaNs are equal.+--+-- >>> sameFloat 0 (-0 :: Double)+-- False+-- >>> sameFloat (0/0) (0/0 :: Double)+-- True+sameFloat :: RealFloat a => a -> a -> Bool+sameFloat x y | isNaN x && isNaN y = True+              | x == 0 && y == 0 = isNegativeZero x == isNegativeZero y+              | otherwise = x == y++sameFloatP :: (RealFloat a, Show a) => a -> a -> Property+sameFloatP x y = counterexample (shows x . showString (interpret res) . showHFloat y $ "") res+  where+    res = sameFloat x y+    interpret True  = " === "+    interpret False = " =/= "++infix 4 `sameFloat`, `sameFloatP`++variousFloats :: forall a. (RealFloat a, Arbitrary a, Random a, Show a) => Gen a+variousFloats = frequency+  [ (10, arbitrary)+  , (10, choose (-1, 1))+  , (10, (* encodeFloat 1 expMin) <$> choose (-1, 1) ) -- subnormal or very small normal+  , (10, (* encodeFloat 1 (expMax-1)) <$> choose (-2, 2) ) -- infinity or very large normal+  , (1, pure 0) -- positive zero+  , (1, pure (-0)) -- negative zero+  , (1, pure (1/0)) -- positive infinity+  , (1, pure (-1/0)) -- negative infinity+  , (1, pure (0/0)) -- NaN+  , (1, pure maxFinite) -- max finite+  , (1, pure (-maxFinite)) -- min negative+  , (1, pure minPositive) -- min positive+  , (1, pure (-minPositive)) -- max negative+  ]+  where (expMin,expMax) = floatRange (undefined :: a)++forAllFloats :: (RealFloat a, Arbitrary a, Random a, Show a, Testable prop) => (a -> prop) -> Property+forAllFloats = forAllShow variousFloats (\x -> show x)++forAllFloats2 :: (RealFloat a, Arbitrary a, Random a, Show a, Testable prop) => (a -> a -> prop) -> Property+forAllFloats2 f = forAllFloats $ \x -> forAllFloats $ \y -> f x y++forAllFloats3 :: (RealFloat a, Arbitrary a, Random a, Show a, Testable prop) => (a -> a -> a -> prop) -> Property+forAllFloats3 f = forAllFloats $ \x -> forAllFloats $ \y -> forAllFloats $ \z -> f x y z++-- orphan instances+instance (FinitePrecision p, Rounding r) => Arbitrary (Decimal p r) where+  arbitrary = arbitrarySizedFractional+  shrink = shrinkDecimal++instance (FinitePrecision p, Rounding r) => Random (Decimal p r) where+  randomR (lo,hi) g = let (x,g') = random g+                      in (lo + x * (hi - lo), g') -- TODO: avoid overflow+  random g = let x :: Int+                 (x,g') = random g+             in (fromRational (toInteger x % 1000), g') -- TODO
fp-ieee.cabal view
@@ -4,17 +4,18 @@ -- -- see: https://github.com/sol/hpack ----- hash: f0bf89e9df957b5023d91e55d09165cecb06208750fddaf58af69fd7c2b7e35d+-- hash: 62a346063dd10a9b7bb7de4d7624dd805ceef339ead48206730d6c47e94e17d2  name:           fp-ieee-version:        0.1.0+version:        0.1.0.1+synopsis:       IEEE 754-2019 compliant operations description:    Please see the README on GitHub at <https://github.com/minoki/haskell-floating-point/tree/master/fp-ieee#readme> category:       Numeric, Math homepage:       https://github.com/minoki/haskell-floating-point#readme bug-reports:    https://github.com/minoki/haskell-floating-point/issues author:         ARATA Mizuki maintainer:     minorinoki@gmail.com-copyright:      2020 ARATA Mizuki+copyright:      2020-2021 ARATA Mizuki license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -166,6 +167,7 @@   main-is: Spec.hs   other-modules:       NextFloatSpec+      Util   hs-source-dirs:       decimal-test   ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts@@ -299,9 +301,11 @@       IntegerInternalsSpec       MinMaxSpec       NaNSpec+      NextFloatSpec       RoundingSpec       RoundToIntegralSpec       TwoSumSpec+      Util   hs-source-dirs:       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
+ test/NextFloatSpec.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+module NextFloatSpec where+import           Data.Proxy+import           Numeric.Floating.IEEE+import           Test.Hspec+import           Test.Hspec.QuickCheck (prop)+import           Test.QuickCheck+import           Util (forAllFloats, sameFloatP)++#if defined(USE_FFI)++foreign import ccall unsafe "nextafter"+  c_nextafter_double :: Double -> Double -> Double+foreign import ccall unsafe "nextafterf"+  c_nextafter_float :: Float -> Float -> Float++class Fractional a => CFloat a where+  c_nextafter :: a -> a -> a++instance CFloat Double where+  c_nextafter = c_nextafter_double++instance CFloat Float where+  c_nextafter = c_nextafter_float++c_nextUp, c_nextDown, c_nextTowardZero :: (RealFloat a, CFloat a) => a -> a+c_nextUp x = c_nextafter x (1/0)+c_nextDown x = c_nextafter x (-1/0)+c_nextTowardZero x | isNegativeZero x = x+                   | otherwise = c_nextafter x 0++prop_nextUp_match :: (RealFloat a, CFloat a, Show a) => Proxy a -> a -> Property+prop_nextUp_match _ x = nextUp x `sameFloatP` c_nextUp x++prop_nextDown_match :: (RealFloat a, CFloat a, Show a) => Proxy a -> a -> Property+prop_nextDown_match _ x = nextDown x `sameFloatP` c_nextDown x++prop_nextTowardZero_match :: (RealFloat a, CFloat a, Show a) => Proxy a -> a -> Property+prop_nextTowardZero_match _ x = nextTowardZero x `sameFloatP` c_nextTowardZero x++#endif++isPositiveZero :: RealFloat a => a -> Bool+isPositiveZero x = x == 0 && not (isNegativeZero x)++prop_nextUp_nextDown :: (RealFloat a, Show a) => Proxy a -> a -> Property+prop_nextUp_nextDown _ x = x /= (-1/0) ==>+  let x' = nextUp (nextDown x)+  in x' `sameFloatP` x .||. (isPositiveZero x .&&. isNegativeZero x')++prop_nextDown_nextUp :: (RealFloat a, Show a) => Proxy a -> a -> Property+prop_nextDown_nextUp _ x = x /= (1/0) ==>+  let x' = nextDown (nextUp x)+  in x' `sameFloatP` x .||. (isNegativeZero x .&&. isPositiveZero x')++{-# NOINLINE spec #-}+spec :: Spec+spec = do+  describe "Double" $ do+    let proxy :: Proxy Double+        proxy = Proxy+#if defined(USE_FFI)+    prop "nextUp vs C nextafter" $ forAllFloats $ prop_nextUp_match proxy+    prop "nextDown vs C nextafter" $ forAllFloats $ prop_nextDown_match proxy+    prop "nextTowardZero vs C nextafter" $ forAllFloats $ prop_nextTowardZero_match proxy+#endif+    prop "nextUp . nextDown == id (unless -inf)" $ forAllFloats $ prop_nextUp_nextDown proxy+    prop "nextDown . nextUp == id (unless inf)" $ forAllFloats $ prop_nextDown_nextUp proxy++  describe "Float" $ do+    let proxy :: Proxy Float+        proxy = Proxy+#if defined(USE_FFI)+    prop "nextUp vs C nextafter" $ forAllFloats $ prop_nextUp_match proxy+    prop "nextDown vs C nextafter" $ forAllFloats $ prop_nextDown_match proxy+    prop "nextTowardZero vs C nextafter" $ forAllFloats $ prop_nextTowardZero_match proxy+#endif+    prop "nextUp . nextDown == id (unless -inf)" $ forAllFloats $ prop_nextUp_nextDown proxy+    prop "nextDown . nextUp == id (unless inf)" $ forAllFloats $ prop_nextDown_nextUp proxy
+ test/Util.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans -Wno-type-defaults #-}+module Util+  ( module Util+  , mapSpecItem_ -- from Test.Hspec.Core.Spec+  ) where+import           Control.Applicative+import           Data.Ratio+import           Numeric+import           Numeric.Floating.IEEE+import           System.Random+import           Test.Hspec.Core.Spec+import           Test.QuickCheck++newtype ShowHexFloat a = ShowHexFloat a deriving (Eq,Ord,Arbitrary)++instance RealFloat a => Show (ShowHexFloat a) where+  showsPrec _prec (ShowHexFloat x) = showHFloat x++-- | Compares two floating point values.+--+-- Unlike @(==)@, @+0@ and @-0@ are considered distinct and NaNs are equal.+--+-- >>> sameFloat 0 (-0 :: Double)+-- False+-- >>> sameFloat (0/0) (0/0 :: Double)+-- True+sameFloat :: RealFloat a => a -> a -> Bool+sameFloat x y | isNaN x && isNaN y = True+              | x == 0 && y == 0 = isNegativeZero x == isNegativeZero y+              | otherwise = x == y++sameFloatP :: (RealFloat a) => a -> a -> Property+sameFloatP x y = counterexample (showHFloat x . showString (interpret res) . showHFloat y $ "") res+  where+    res = sameFloat x y+    interpret True  = " === "+    interpret False = " =/= "++sameFloatPairP :: (RealFloat a, Show a) => (a, a) -> (a, a) -> Property+sameFloatPairP (x,y) (x',y') = counterexample (showPair x y . showString (interpret res) . showPair x' y' $ "") res+  where+    showPair s t = showChar '(' . showHFloat s . showChar ',' . showHFloat t . showChar ')'+    res = x `sameFloat` x' && y `sameFloat` y'+    interpret True  = " === "+    interpret False = " =/= "++infix 4 `sameFloat`, `sameFloatP`, `sameFloatPairP`++variousFloats :: forall a. (RealFloat a, Arbitrary a, Random a, Show a) => Gen a+variousFloats = frequency+  [ (10, arbitrary)+  , (10, choose (-1, 1))+  , (10, (* encodeFloat 1 expMin) <$> choose (-1, 1) ) -- subnormal or very small normal+  , (10, (* encodeFloat 1 (expMax-1)) <$> choose (-2, 2) ) -- infinity or very large normal+  , (1, pure 0) -- positive zero+  , (1, pure (-0)) -- negative zero+  , (1, pure (1/0)) -- positive infinity+  , (1, pure (-1/0)) -- negative infinity+  , (1, pure (0/0)) -- NaN+  , (1, pure maxFinite) -- max finite+  , (1, pure (-maxFinite)) -- min negative+  , (1, pure minPositive) -- min positive+  , (1, pure (-minPositive)) -- max negative+  ]+  where (expMin,expMax) = floatRange (undefined :: a)++variousIntegers :: Gen Integer+variousIntegers = frequency+  [ (10, arbitrary)+  , (10, elements [id,negate] <*> choose (2^52, 2^54))+  , (10, elements [id,negate] <*> choose (2^62, 2^64))+  , (10, elements [id,negate] <*> choose (2^100, 2^101))+  , (10, elements [id,negate] <*> choose (2^1020, 2^1030))+  , (5, elements [id,negate] <*> choose (2^1070, 2^1075))+  , (5, elements [id,negate] <*> choose (2^16382, 2^16384))+  , (3, elements [id,negate] <*> choose (2^16440, 2^16445))+  ]++variousRationals :: Gen Rational+variousRationals = liftA2 (%) variousIntegers (variousIntegers `suchThat` (/= 0))++forAllFloats :: (RealFloat a, Arbitrary a, Random a, Show a, Testable prop) => (a -> prop) -> Property+forAllFloats = forAllShow variousFloats (\x -> showHFloat x "")++forAllFloats2 :: (RealFloat a, Arbitrary a, Random a, Show a, Testable prop) => (a -> a -> prop) -> Property+forAllFloats2 f = forAllFloats $ \x -> forAllFloats $ \y -> f x y++forAllFloats3 :: (RealFloat a, Arbitrary a, Random a, Show a, Testable prop) => (a -> a -> a -> prop) -> Property+forAllFloats3 f = forAllFloats $ \x -> forAllFloats $ \y -> forAllFloats $ \z -> f x y z++allowFailure :: String -> Item a -> Item a+allowFailure message item@(Item { itemExample = origExample }) = item { itemExample = newExample }+  where+    newExample params around callback = do+      result <- origExample params around callback+      case result of+        Result { resultStatus = Test.Hspec.Core.Spec.Failure loc reason } -> do+          let message' = case reason of+                           NoReason -> message+                           _        -> message ++ ": " ++ show reason+          return result { resultStatus = Pending loc (Just message') }+        _ -> return result