From 4e75700e917c1adb74e677d33dce380c6468a52a Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Sat, 23 Dec 2023 01:08:52 +0000 Subject: [PATCH] Even more asthetics (#11) * change maintainer, and clarify comments. * add another license header, and qualify imports. * add more qualification and license headers --- src/Data/Bits/Floating.hs | 9 +++++---- src/Data/Bits/Floating/Prim.hs | 4 ++-- test/Bench.hs | 20 ++++++++++++++++---- test/Test.hs | 28 +++++++++++++++++++++------- test/TestUtils.hs | 16 ++++++++++++++-- 5 files changed, 58 insertions(+), 19 deletions(-) diff --git a/src/Data/Bits/Floating.hs b/src/Data/Bits/Floating.hs index c8b5de3..cce8c13 100644 --- a/src/Data/Bits/Floating.hs +++ b/src/Data/Bits/Floating.hs @@ -69,11 +69,12 @@ class (Floating f, Integral w) => FloatingBits f w | f -> w where -- If the argument is 0.0, the maximum value smaller than 0.0 is returned. -- If the argument is -INF, -INF is returned. nextDown :: f -> f - -- | Return the size of an ulp of the argument. If the argument is NaN, NaN - -- is returned. If the argument is +INF or -INF, +INF is returned. If - -- the argument is 0.0, the minimum value greater than 0.0 is returned. + -- | Return the size of the Unit of Least Precision of the argument. + -- If the argument is NaN, NaN is returned. + -- If the argument is +INF or -INF, +INF is returned. + -- If the argument is 0.0, the minimum value greater than 0.0 is returned. -- - -- If @x@ is not NaN, @'ulp' x == 'ulp' (-x)@ holds. + -- If @x@ is not NaN or one of the infinities, @'ulp' x == 'ulp' (-x)@ holds. ulp :: f -> f class ShowFloat f where diff --git a/src/Data/Bits/Floating/Prim.hs b/src/Data/Bits/Floating/Prim.hs index c8fcd71..cb0a4ff 100644 --- a/src/Data/Bits/Floating/Prim.hs +++ b/src/Data/Bits/Floating/Prim.hs @@ -1,8 +1,8 @@ ----------------------------------------------------------------------------- -- | --- Copyright : (C) 2015 Anselm Jonas Scholl +-- Copyright : (C) 2015 Anselm Jonas Scholl, (C) 2023 Julia Longtin -- License : BSD3 --- Maintainer : Anselm Jonas Scholl +-- Maintainer : Julia Longtin -- Stability : experimental -- Portability : GHC-specific -- diff --git a/test/Bench.hs b/test/Bench.hs index 0ae3856..14bd2f0 100644 --- a/test/Bench.hs +++ b/test/Bench.hs @@ -1,11 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (C) 2015 Anselm Jonas Scholl, (C) 2023 Julia Longtin +-- License : BSD3 +-- Maintainer : Julia Longtin +-- Stability : experimental +-- Portability : GHC-specific +-- + module Main where -import TestUtils +import Prelude (Double, Float, IO, ($), (++), concatMap, map, shows, unzip) + +import TestUtils (refDoubleDown, refDoubleToWord, refDoubleUp, refDoubleUlp, refFloatDown, refFloatToWord, refFloatUp, refFloatUlp, refWordToDouble, refWordToFloat, showW, testD, testF) + +import Data.Word (Word32, Word64) -import Data.Word -import Data.Bits.Floating +import Data.Bits.Floating (coerceToFloat, coerceToWord, nextDown, nextUp, ulp) -import Criterion.Main +import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) mkSingleBenchmarks :: ((Float, Word32) -> [Benchmark]) -> ((Double, Word64) -> [Benchmark]) -> [Benchmark] mkSingleBenchmarks mkFTest mkDTest = concatMap mkFTest testF ++ concatMap mkDTest testD diff --git a/test/Test.hs b/test/Test.hs index 3c5d3da..1917253 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -1,16 +1,30 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (C) 2015 Anselm Jonas Scholl, (C) 2023 Julia Longtin +-- License : BSD3 +-- Maintainer : Julia Longtin +-- Stability : experimental +-- Portability : GHC-specific +-- + {-# LANGUAGE BangPatterns #-} + {-# LANGUAGE ScopedTypeVariables #-} + module Main where -import TestUtils +import Prelude(Bool(False), Double, Float, Integral, IO, MonadFail, RealFloat, Show, String, (.), (<), ($), (+), (-), (&&), (++), (<=), (>=), (/=), (==), (||), (<$>), either, fail, fromIntegral, fst, isInfinite, isNaN, isNegativeZero, mapM_, maxBound, minBound, not, otherwise, putStrLn, realToFrac, rem, return, quot, show, shows, snd) + +import TestUtils (refDoubleDown, refDoubleToWord, refDoubleUp, refDoubleUlp, refFloatDown, refFloatToWord, refFloatUlp, refFloatUp, refWordToDouble, refWordToFloat, showW, testD, testF) + +import Data.Word (Word32, Word64) -import Data.Word -import Data.Bits -import Data.Bits.Floating +import Data.Bits ((.&.), complement) +import Data.Bits.Floating (FloatingBits, ShowFloat, coerceToFloat, coerceToWord, nextDown, nextUp, showFloat, ulp) -import Control.Concurrent -import Control.Exception -import Control.Monad +import Control.Concurrent (MVar, forkIO, getNumCapabilities, newEmptyMVar, putMVar, takeMVar) +import Control.Exception (SomeException, throwIO, try) +import Control.Monad (forM_, join, replicateM_, unless, void, when) main :: IO () main = do diff --git a/test/TestUtils.hs b/test/TestUtils.hs index f265e43..88dfb35 100644 --- a/test/TestUtils.hs +++ b/test/TestUtils.hs @@ -1,9 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (C) 2015 Anselm Jonas Scholl, (C) 2023 Julia Longtin +-- License : BSD3 +-- Maintainer : Julia Longtin +-- Stability : experimental +-- Portability : GHC-specific +-- + {-# LANGUAGE ForeignFunctionInterface #-} + module TestUtils where -import Data.Word +import Prelude (Double, Float, Integral, Show, String, (/), pi, sqrt) + +import Data.Word (Word32, Word64) -import Numeric +import Numeric (showHex) -- we do not test NaNs here because their binary representation can be changed -- without changing their value and some processors have been observed to do that.