libBF 0.6.6 → 0.6.7

raw patch · 5 files changed

+73/−40 lines, 5 filesdep +tastydep +tasty-hunitdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: tasty, tasty-hunit

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• libBF.cabal +6/−10
• src/LibBF.hs +10/−0
• src/LibBF/Mutable.hsc +5/−3
• tests/RunUnitTests.hs +48/−27

@@ -1,5 +1,9 @@ # Revision history for libBF-hs +## 0.6.7 -- 2023.11.28++* Add `Data` instances for `BigFloat`, `Sign`, `BFRep`, and `BFNum`.+ ## 0.6.6 -- 2023.07.17  * Update the vendored version of `libbf` to include the changes from the

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                libBF-version:             0.6.6+version:             0.6.7 synopsis:            A binding to the libBF library. description:         LibBF is a C library for working with arbitray precision                      IEEE 754 floating point numbers.@@ -78,17 +78,13 @@   ghc-options:         -Wall   default-language:    Haskell2010 -executable bf-test-  main-is:            RunUnitTests.hs-  hs-source-dirs:     tests-  build-depends:      base, libBF-  default-language:   Haskell2010-- test-suite libBF-tests   type:               exitcode-stdio-1.0   hs-source-dirs:     tests   main-is:            RunUnitTests.hs+  ghc-options:        -Wall   default-language:   Haskell2010-  build-depends:      base, libBF-+  build-depends:      base,+                      libBF,+                      tasty >= 1.3 && < 1.6,+                      tasty-hunit >= 0.10 && < 0.11

@@ -61,6 +61,7 @@   import Data.Bits+import Data.Data (Data(..)) import Data.Hashable import Data.Word import Data.Int@@ -72,6 +73,15 @@  -- | Arbitrary precision floating point numbers. newtype BigFloat = BigFloat BF++instance Data BigFloat where+  -- BigFloat is exported as an abstract data type, so we intentionally define+  -- the Data instance in a simplistic way so as to avoid leaking the BF+  -- internals.+  gfoldl _ z = z+  gunfold _ _ = error "Data.Data.gunfold(BigFloat)"+  toConstr _ = error "Data.Data.toConstr(BigFloat)"+  dataTypeOf _ = error "Data.Data.dataTypeOf(BigFloat)"  instance NFData BigFloat where   rnf x = x `seq` ()

@@ -2,6 +2,7 @@ {-# Language PatternSynonyms #-} {-# Language MultiWayIf #-} {-# Language BlockArguments #-}+{-# Language DeriveDataTypeable #-} -- | Mutable big-float computation. module LibBF.Mutable   ( -- * Allocation@@ -69,6 +70,7 @@ import Foreign.ForeignPtr import Foreign.C.Types import Foreign.C.String+import Data.Data (Data) import Data.Word import Data.Int import Data.Bits@@ -175,7 +177,7 @@  -- | Indicates if a number is positive or negative. data Sign = Neg {-^ Negative -} | Pos {-^ Positive -}-             deriving (Eq,Ord,Show)+             deriving (Data,Eq,Ord,Show)   foreign import ccall "bf_set_nan"@@ -553,7 +555,7 @@ -- | An explicit representation for big nums. data BFRep  = BFRep !Sign !BFNum    -- ^ A signed number             | BFNaN                 -- ^ Not a number-              deriving (Eq,Ord,Show)+              deriving (Data,Eq,Ord,Show)  instance Hashable BFRep where   hashWithSalt s BFNaN           = s `hashWithSalt` (0::Int)@@ -564,7 +566,7 @@ data BFNum  = Zero                 -- ^ zero             | Num Integer !Int64   -- ^ @x * 2 ^ y@             | Inf                  -- ^ infinity-              deriving (Eq,Ord,Show)+              deriving (Data,Eq,Ord,Show)  instance Hashable BFNum where   hashWithSalt s Zero         = s `hashWithSalt` (0::Int)

@@ -1,42 +1,63 @@ {-# Language BlockArguments #-} module Main(main) where -import Data.Foldable(traverse_)-import System.Exit(exitFailure)-import System.IO(hPutStrLn,stderr)-import Control.Monad(unless)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit ((@=?), assertFailure, testCase)  import LibBF   main :: IO () main =-  do putStrLn $ bfToString 16 (showFree Nothing) bfNaN-     print $ bfFromString 10 (expBits 3 <> precBits 2 <> rnd ToZero) "0.001"-     print $ bfFromString 10 (expBits 3 <> precBits 2 <> rnd ToZero) "1.0e200"-     dblTest "+" (+) (bfAdd (float64 NearEven)) 1 2-     dblTest "/" (/) (bfDiv (float64 NearEven)) 1 0-     traverse_ (\bf -> bfSubnormalTest bf False)-       [bfPosZero, bfFromInt 1, bfFromInt 0, bfNaN, bfNegInf, bfPosInf]+  defaultMain $+  testGroup "LibBF tests"+    [ testGroup "bfToString"+        [ testCase "NaN" $+            "NaN" @=? bfToString 16 (showFree Nothing) bfNaN+        ]+    , testGroup "bfFromString"+        [ testCase "Underflow" $+            let (_, status) =+                  bfFromString 10 (expBits 3 <> precBits 2 <> rnd ToZero) "0.001" in+            True @=? statusUnderflow status+        , testCase "Overflow" $+            let (_, status) =+                  bfFromString 10 (expBits 3 <> precBits 2 <> rnd ToZero) "1.0e200" in+            True @=? statusOverflow status+        ]+    , testGroup "bfAdd"+        [ dblTestCase "+" (+) (bfAdd (float64 NearEven)) 1 2+        ]+    , testGroup "bfDiv"+        [ dblTestCase "/" (/) (bfDiv (float64 NearEven)) 1 0+        ]+    , testGroup "bfIsSubnormal (float32 NearEven)"+        (map (\bf -> bfSubnormalTestCase bf False)+             [bfPosZero, bfFromInt 1, bfFromInt 0, bfNaN, bfNegInf, bfPosInf])+    ] -check :: String -> Bool -> IO ()-check x b = unless b-              do hPutStrLn stderr ("Test failed: " ++ x)-                 exitFailure+statusUnderflow :: Status -> Bool+statusUnderflow Underflow = True+statusUnderflow _         = False -dblTest ::+statusOverflow :: Status -> Bool+statusOverflow Overflow = True+statusOverflow _        = False++-- Check that a binary operation over BigFloats returns the same result as the+-- corresponding operation over doubles.+dblTestCase ::   String ->   (Double -> Double -> Double) ->   (BigFloat -> BigFloat -> (BigFloat, Status)) ->-  Double -> Double -> IO ()-dblTest op opD opBF x y =+  Double -> Double -> TestTree+dblTestCase op opD opBF x y =+  testCase (unwords [show x, op, show y]) $   case z1 of-    Left err -> check (lab ("status: " ++ err)) False-    Right a  -> check (lab (show a)) (z == a)+    Left err -> assertFailure ("status: " ++ err)+    Right actual -> expected @=? actual   where-  lab err = unwords [ show x, op, show y, "=", show z, err ]--  z  = opD x y+  expected = opD x y   z1 = case opBF (bfFromDouble x) (bfFromDouble y) of         (res,_) ->           case bfToDouble NearEven res of@@ -45,7 +66,7 @@  -- Check that calling bfIsSubnormal on a BigFloat value returns the expected -- result.-bfSubnormalTest :: BigFloat -> Bool -> IO ()-bfSubnormalTest bf expected =-  check ("bfIsSubnormal (float32 NearEven) " ++ show bf)-        (bfIsSubnormal (float32 NearEven) bf == expected)+bfSubnormalTestCase :: BigFloat -> Bool -> TestTree+bfSubnormalTestCase bf expected =+  testCase (show bf) $+  expected @=? bfIsSubnormal (float32 NearEven) bf