packages feed

exact-real 0.12.4.1 → 0.12.5

raw patch · 8 files changed

+85/−64 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

changelog.md view
@@ -2,6 +2,9 @@  ## WIP +## [0.12.5] - 2021-05-29+- Tweak test suite to fix #35+ ## [0.12.4.1] - 2020-11-01   - Use newer version of `checkers`
default.nix view
@@ -1,34 +1,21 @@-{ pkgs ? import <nixpkgs> { }, compiler ? null, hoogle ? true-, forShell ? pkgs.lib.inNixShell }:+{ nixpkgsSrc ? builtins.fetchTarball {+  url =+    "https://github.com/NixOS/nixpkgs/archive/540dccb2aeaffa9dc69bfdc41c55abd7ccc6baa3.tar.gz"; # nixos-unstable+  sha256 = "1j58m811w7xxjncf36hqcjqsfj979hkfcwx9wcrm3g3zbayavapg";+}, pkgs ? import nixpkgsSrc { }, compiler ? null, extraOverrides ? _: _: { }+, modifier ? x: x }:  let-  src = pkgs.nix-gitignore.gitignoreSource [ ] ./.;--  compiler' = if compiler != null then-    compiler+  haskellPackages = if compiler == null then+    pkgs.haskellPackages   else-    "ghc" + pkgs.lib.concatStrings-    (pkgs.lib.splitVersion pkgs.haskellPackages.ghc.version);--  # Any overrides we require to the specified haskell package set-  haskellPackages = with pkgs.haskell.lib;-    pkgs.haskell.packages.${compiler'}.override {-      overrides = self: super:-        { } // pkgs.lib.optionalAttrs hoogle {-          ghc = super.ghc // { withPackages = super.ghc.withHoogle; };-          ghcWithPackages = self.ghc.withPackages;-        };-    };+    pkgs.haskell.packages.${compiler}; -  # Generate a haskell derivation using the cabal2nix tool on `package.yaml`-  drv = let old = haskellPackages.callCabal2nix "" src { };-  in old // {-    env = pkgs.lib.overrideDerivation old.env (attrs:-      pkgs.lib.optionalAttrs hoogle {-        shellHook = attrs.shellHook + ''-          export HIE_HOOGLE_DATABASE="$(cat $(${pkgs.which}/bin/which hoogle) | sed -n -e 's|.*--database \(.*\.hoo\).*|\1|p')"-        '';-      });-  };+in haskellPackages.developPackage {+  name = "";+  root = pkgs.nix-gitignore.gitignoreSource [ ] ./.;+  overrides = with pkgs.haskell.lib;+    pkgs.lib.composeExtensions (_self: _super: { }) extraOverrides;+  inherit modifier;+} -in if forShell then drv.env else drv
exact-real.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.24 --- This file has been generated from package.yaml by hpack version 0.34.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack  name:           exact-real-version:        0.12.4.1+version:        0.12.5 synopsis:       Exact real arithmetic description:    A type to represent exact real numbers using fast binary Cauchy sequences. category:       Math
package.yaml view
@@ -1,5 +1,5 @@ name: exact-real-version: "0.12.4.1"+version: "0.12.5" synopsis: Exact real arithmetic description: A type to represent exact real numbers using fast binary Cauchy sequences. category: Math@@ -61,8 +61,8 @@     - checkers >=0.5.6     - exact-real     when:-        condition: impl(ghc < 8.0.0)-        buildable: false+      condition: impl(ghc < 8.0.0)+      buildable: false    doctests:     main: Doctests.hs
src/Data/CReal/Internal.hs view
@@ -75,7 +75,7 @@ import GHC.TypeLits import Text.Read import qualified Text.Read.Lex as L-import System.Random (Random(..), RandomGen(..))+import System.Random (Random(..)) import Control.Concurrent.MVar import Control.Exception import System.IO.Unsafe (unsafePerformIO)@@ -128,7 +128,7 @@ (CR mvc f) `atPrecision` (!p) = unsafePerformIO $ modifyMVar mvc $ \vc -> do   vc' <- evaluate vc   case vc' of-    Current j v | j >= p -> do+    Current j v | j >= p ->       pure (vc', v /^ (j - p))     _ -> do       v <- evaluate $ f p@@ -268,8 +268,8 @@                   -- 0.75 <= x <= 2                 | l == 0 -> logBounded x                   -- x >= 2-                | l > 0  -> let a = x `shiftR` l-                            in logBounded a + fromIntegral l *. ln2+                | otherwise  -> let a = x `shiftR` l+                                in logBounded a + fromIntegral l *. ln2    sqrt x = crMemoize (\p -> let n = atPrecision x (2 * p)                             in isqrt n)@@ -297,7 +297,7 @@    tan x = sin x .* recip (cos x) -  asin x = (atan (x .*. recipBounded (1 + sqrt (1 - squareBounded x)))) `shiftL` 1+  asin x = atan (x .*. recipBounded (1 + sqrt (1 - squareBounded x))) `shiftL` 1    acos x = piBy2 - asin x @@ -355,9 +355,7 @@                   v = x `atPrecision` p                   r = v .&. (bit p - 1)                   n = unsafeShiftR (v - r) p-                  in case r /= 0 of-                    True -> fromInteger $ n + 1-                    _    -> fromInteger n+                  in if r /= 0 then fromInteger $ n + 1 else fromInteger n    floor x = let p = crealPrecision x                 v = x `atPrecision` p@@ -408,14 +406,16 @@ instance KnownNat n => Eq (CReal n) where   -- TODO, should this try smaller values first?   CR mvx _ == CR mvy _ | mvx == mvy = True-  x == y = let p = crealPrecision x + 2-           in (atPrecision x p - atPrecision y p) /^ 2 == 0+  x == y = let p = crealPrecision x+           in ((x - y) `atPrecision` p) == 0 --- | Like equality values of type @CReal p@ are compared at precision @p@.++-- | Like equality, values of type @CReal p@ are compared at precision @p@. instance KnownNat n => Ord (CReal n) where   compare (CR mvx _) (CR mvy _) | mvx == mvy = EQ-  compare x y = let p = crealPrecision x + 2-                in compare ((atPrecision x p - atPrecision y p) /^ 2) 0+  compare x y =+    let p = crealPrecision x+    in compare ((x - y) `atPrecision` p) 0   max x y = crMemoize (\p -> max (atPrecision x p) (atPrecision y p))   min x y = crMemoize (\p -> min (atPrecision x p) (atPrecision y p)) @@ -442,7 +442,7 @@ --  piBy4 :: CReal n-piBy4 = (atanBounded (recipBounded 5) `shiftL` 2) - atanBounded (recipBounded 239) -- Machin Formula+piBy4 = atanBounded (recipBounded 5) `shiftL` 2 - atanBounded (recipBounded 239) -- Machin Formula  piBy2 :: CReal n piBy2 = piBy4 `shiftL` 1@@ -609,7 +609,7 @@ shiftR x n = crMemoize (\p -> let p' = p - n                               in if p' >= 0                                  then atPrecision x p'-                                 else atPrecision x 0 /^ (negate p'))+                                 else atPrecision x 0 /^ negate p')  -- | @x \`shiftL\` n@ is equal to @x@ multiplied by 2^@n@ --@@ -645,8 +645,7 @@               _  -> ""         ds = show (roundD (abs n * 10^places) d)         l = length ds-        (is, fs) = if | l <= places -> ("0", replicate (places - l) '0' ++ ds)-                      | otherwise -> splitAt (l - places) ds+        (is, fs) = if l <= places then ("0", replicate (places - l) '0' ++ ds) else splitAt (l - places) ds   --@@ -713,7 +712,7 @@ isqrt x | x < 0     = error "Sqrt applied to negative Integer"         | x == 0    = 0         | otherwise = until satisfied improve initialGuess-  where improve r    = unsafeShiftR (r + (x `div` r)) 1+  where improve r    = unsafeShiftR (r + x `div` r) 1         satisfied r  = let r2 = r * r in r2 <= x && r2 + unsafeShiftL r 1 >= x         initialGuess = bit (unsafeShiftR (log2 x) 1) @@ -727,7 +726,7 @@ findFirstMonotonic p = findBounds 0 1   where findBounds !l !u = if p u then binarySearch l u                                   else findBounds u (u * 2)-        binarySearch !l !u = let !m = l + ((u - l) `div` 2)+        binarySearch !l !u = let !m = l + (u - l) `div` 2                              in if | l+1 == u  -> l                                    | p m       -> binarySearch l m                                    | otherwise -> binarySearch m u@@ -743,7 +742,11 @@ -- [1,-2,3,-4,5] {-# INLINABLE alternateSign #-} alternateSign :: Num a => [a] -> [a]-alternateSign = \ls -> foldr (\a r b -> if b then (negate a):r False else a:r True) (const []) ls False+alternateSign ls = foldr+  (\a r b -> if b then negate a : r False else a : r True)+  (const [])+  ls+  False  -- | @powerSeries q f x `atPrecision` p@ will evaluate the power series with -- coefficients @q@ up to the coefficient at index @f p@ at value @x@
test/Data/CReal/Extra.hs view
@@ -6,7 +6,7 @@  import Data.CReal import GHC.TypeLits-import Test.QuickCheck (Arbitrary(..), choose)+import Test.QuickCheck (Arbitrary(..), chooseAny) import Test.QuickCheck.Checkers (EqProp(..), eq)  instance KnownNat n => EqProp (CReal n) where@@ -15,6 +15,6 @@ instance KnownNat n => Arbitrary (CReal n) where   arbitrary = do     integralPart <- fromInteger <$> arbitrary-    fractionalPart <- choose (-0.5, 0.5)+    fractionalPart <- (subtract 0.5) <$> chooseAny     pure (integralPart + fractionalPart)
test/Ord.hs view
@@ -6,17 +6,25 @@  import Test.QuickCheck (Arbitrary) import Test.QuickCheck.Checkers (EqProp)-import Test.QuickCheck.Classes.Extra (ordRel, complement)-import Test.Tasty.Extra (testGroup, TestTree, testTreeFromNamedBatch)-import Test.Tasty.QuickCheck (Gen, oneof, arbitrary, testProperty, property)+import Test.QuickCheck.Classes.Extra (complement, strictTotalOrd)+import Test.Tasty.Extra (testGroup, TestTree)+import Test.Tasty.QuickCheck (Gen, arbitrary, testProperty, property)  ord :: forall a. (Arbitrary a, Show a, EqProp a, Ord a) => a -> TestTree ord _ = testGroup "Test Ord instance" ts   where     gen :: a -> Gen a-    gen x = oneof [pure x, arbitrary]-    ts = [ testTreeFromNamedBatch "<= is a total ordering" (ordRel (<=) gen)-         , testTreeFromNamedBatch ">= is a total ordering" (ordRel (>=) gen)+    gen = const arbitrary+    ts = [ -- It's a bit of a pain, but basically the arbitrary instance could+           -- generate for precision p:+           --+           -- 2, 1, 3. Where 2 <= 1 and 2<=3 (because they compare equal at the low+           -- precision p) and hence 1 <= 3 (which is detected and fails the test).+           --+           -- testTreeFromNamedBatch "<= is a total ordering" (ordRel (<=) gen)+           -- testTreeFromNamedBatch ">= is a total ordering" (ordRel (>=) gen)+           strictTotalOrd "< is a strict total ordering" gen (<)+         , strictTotalOrd "< is a strict total ordering" gen (>)          , complement "< is the complement of >=" gen (<) (>=)          , complement "> is the complement of <=" gen (>) (<=)          , testProperty "max x y >= x and y" (property $ \x y ->
test/Test/QuickCheck/Classes/Extra.hs view
@@ -13,13 +13,14 @@    -- | Relations   , complement+  , strictTotalOrd   ) where  import Data.Group (invert, Group, Abelian) import Data.Monoid ((<>), Sum(..), Product)-import Test.QuickCheck.Extra (Arbitrary, (<=>))+import Test.QuickCheck.Extra (Arbitrary, (<=>), (==>)) import Test.QuickCheck.Modifiers (NonZero)-import Test.QuickCheck.Checkers (commutes, EqProp, (=-=), BinRel)+import Test.QuickCheck.Checkers (commutes, transitive, EqProp, (=-=), BinRel) import Test.QuickCheck.Classes import Test.Tasty.Extra (testGroup, TestTree, testTreeFromBatch, testTreeFromNamedBatch) import Test.Tasty.QuickCheck (testProperty, Property, Gen, property, forAll)@@ -79,3 +80,22 @@                forAll (gen a) $ \ b ->                a `r1` b <=> not (a `r2` b))              ]++strictTotalOrd+  :: forall a+   . (Arbitrary a, EqProp a, Eq a, Show a)+  => String+  -> (a -> Gen a)+  -> BinRel a+  -> TestTree+strictTotalOrd s gen r = testGroup s ts+ where+  ts =+    [ testProperty "irreflexive" (property $ \a -> not (a `r` a))+    , testProperty "transitive" $ transitive r gen+    , testProperty+      "connected"+      ( property+      $ \a -> forAll (gen a) $ \b -> (a /= b) ==> (a `r` b) || (b `r` a)+      )+    ]