Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-bitvec for openSUSE:Factory checked in at 2026-06-10 15:57:59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-bitvec (Old) and /work/SRC/openSUSE:Factory/.ghc-bitvec.new.2375 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-bitvec" Wed Jun 10 15:57:59 2026 rev:7 rq:1358333 version:1.1.6.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-bitvec/ghc-bitvec.changes 2025-01-27 20:50:54.251869299 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-bitvec.new.2375/ghc-bitvec.changes 2026-06-10 15:58:33.014137108 +0200 @@ -1,0 +2,8 @@ +Wed Feb 18 00:32:25 UTC 2026 - Peter Simons <[email protected]> + +- Update bitvec to version 1.1.6.0. + # 1.1.6.0 + + * Make `basicOverlaps` precise instead of rounding bounds up to the next `Word`. + +------------------------------------------------------------------- Old: ---- bitvec-1.1.5.0.tar.gz bitvec.cabal New: ---- bitvec-1.1.6.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-bitvec.spec ++++++ --- /var/tmp/diff_new_pack.PzOkhf/_old 2026-06-10 15:58:34.218187002 +0200 +++ /var/tmp/diff_new_pack.PzOkhf/_new 2026-06-10 15:58:34.218187002 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-bitvec # -# Copyright (c) 2025 SUSE LLC +# Copyright (c) 2026 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -20,13 +20,12 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.1.5.0 +Version: 1.1.6.0 Release: 0 Summary: Space-efficient bit vectors License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/3.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-base-devel BuildRequires: ghc-base-prof @@ -112,7 +111,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ bitvec-1.1.5.0.tar.gz -> bitvec-1.1.6.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench/Intersection.hs new/bitvec-1.1.6.0/bench/Bench/Intersection.hs --- old/bitvec-1.1.5.0/bench/Bench/Intersection.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench/Intersection.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,4 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Avoid lambda" #-} +{- HLINT ignore "Avoid lambda" -} module Bench.Intersection ( benchIntersection diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench/Product.hs new/bitvec-1.1.6.0/bench/Bench/Product.hs --- old/bitvec-1.1.5.0/bench/Bench/Product.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench/Product.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,4 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Avoid lambda" #-} +{- HLINT ignore "Avoid lambda" -} module Bench.Product ( benchProduct diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench/RandomFlip.hs new/bitvec-1.1.6.0/bench/Bench/RandomFlip.hs --- old/bitvec-1.1.5.0/bench/Bench/RandomFlip.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench/RandomFlip.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,6 +2,7 @@ ( benchRandomFlip ) where +import Prelude hiding (Foldable(..)) import Control.Monad import Control.Monad.ST import Data.Bit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench/RandomWrite.hs new/bitvec-1.1.6.0/bench/Bench/RandomWrite.hs --- old/bitvec-1.1.5.0/bench/Bench/RandomWrite.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench/RandomWrite.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,6 +2,7 @@ ( benchRandomWrite ) where +import Prelude hiding (Foldable(..)) import Control.Monad import Control.Monad.ST import Data.Bit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench/Remainder.hs new/bitvec-1.1.6.0/bench/Bench/Remainder.hs --- old/bitvec-1.1.5.0/bench/Bench/Remainder.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench/Remainder.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,5 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Avoid lambda" #-} +{- HLINT ignore "Avoid lambda" -} module Bench.Remainder ( benchRemainder @@ -11,11 +9,7 @@ import qualified Data.Bit.ThreadSafe as TS import Data.Bits import GHC.Exts -#ifdef MIN_VERSION_ghc_bignum import GHC.Num.Integer -#else -import GHC.Integer.Logarithms -#endif import Test.Tasty.Bench import Bench.Common @@ -30,11 +24,7 @@ binRem :: Integer -> Integer -> Integer binRem x y = go x where -#ifdef MIN_VERSION_ghc_bignum binLog n = I# (word2Int# (integerLog2# n)) -#else - binLog n = I# (integerLog2# n) -#endif ly = binLog y go z = if lz < ly then z else go (z `xor` (y `shiftL` (lz - ly))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench/Sum.hs new/bitvec-1.1.6.0/bench/Bench/Sum.hs --- old/bitvec-1.1.5.0/bench/Bench/Sum.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench/Sum.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,11 +1,11 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Avoid lambda" #-} +{- HLINT ignore "Avoid lambda" -} module Bench.Sum ( benchAdd , benchSum ) where +import Prelude hiding (Foldable(..)) import Data.Bit import qualified Data.Bit.ThreadSafe as TS import Data.Bits diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench/Union.hs new/bitvec-1.1.6.0/bench/Bench/Union.hs --- old/bitvec-1.1.5.0/bench/Bench/Union.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench/Union.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,4 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Avoid lambda" #-} +{- HLINT ignore "Avoid lambda" -} module Bench.Union ( benchUnion diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bench/Bench.hs new/bitvec-1.1.6.0/bench/Bench.hs --- old/bitvec-1.1.5.0/bench/Bench.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bench/Bench.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,4 @@ -module Main where +module Main (main) where import Test.Tasty.Bench import Test.Tasty.Patterns.Printer diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/bitvec.cabal new/bitvec-1.1.6.0/bitvec.cabal --- old/bitvec-1.1.5.0/bitvec.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/bitvec.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: bitvec -version: 1.1.5.0 +version: 1.1.6.0 cabal-version: 2.0 build-type: Simple license: BSD3 @@ -51,14 +51,14 @@ author: Andrew Lelechenko <[email protected]>, James Cook <[email protected]> -tested-with: GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.1 GHC ==8.8.2 GHC ==8.8.4 GHC ==8.10.7 GHC ==9.0.2 GHC ==9.2.7 GHC ==9.4.4 GHC ==9.6.1 +tested-with: GHC ==9.0.2 GHC ==9.2.8 GHC ==9.4.8 GHC ==9.6.7 GHC ==9.8.4 GHC ==9.10.3 GHC ==9.12.2 GHC ==9.14.1 extra-doc-files: changelog.md README.md source-repository head type: git - location: git://github.com/Bodigrim/bitvec.git + location: https://github.com/Bodigrim/bitvec.git flag simd description: @@ -72,11 +72,12 @@ Data.Bit Data.Bit.ThreadSafe build-depends: - base >=4.11 && <5, + base >=4.15 && <5, bytestring >=0.10 && <0.13, deepseq <1.6, - primitive >=0.5, - vector >=0.11 && <0.14 + ghc-bignum <1.5, + primitive >=0.5 && <0.10, + vector >=0.13 && <0.14 default-language: Haskell2010 hs-source-dirs: src other-modules: @@ -92,12 +93,6 @@ Data.Bit.Utils ghc-options: -O2 -Wall -Wcompat include-dirs: src - - if impl(ghc <9.0) - build-depends: integer-gmp - else - build-depends: ghc-bignum - if flag(simd) && !arch(javascript) && !arch(wasm32) c-sources: cbits/bitvec_simd.c cc-options: -fopenmp-simd @@ -111,12 +106,13 @@ build-depends: base, bitvec, - primitive >=0.5 && <0.9, + ghc-bignum, + primitive >=0.5 && <0.10, quickcheck-classes-base <0.7, quickcheck-classes >=0.6.1 && <0.7, vector >=0.11, - tasty <1.5, - tasty-quickcheck <0.11 + tasty <1.6, + tasty-quickcheck <0.12 default-language: Haskell2010 hs-source-dirs: test other-modules: @@ -128,22 +124,20 @@ Tests.SetOps Tests.SetOpsTS Tests.Vector - ghc-options: -Wall -threaded -rtsopts -Wcompat + ghc-options: -Wall -Wcompat + if !arch(wasm32) + ghc-options: -threaded -rtsopts include-dirs: test - if impl(ghc <9.0) - build-depends: integer-gmp <1.2 - else - build-depends: ghc-bignum - benchmark bitvec-bench build-depends: base, bitvec, - containers <0.7, - random <1.3, + containers <0.9, + ghc-bignum, + random <1.4, tasty, - tasty-bench >=0.3.2 && <0.4, + tasty-bench >=0.4 && <0.6, vector type: exitcode-stdio-1.0 main-is: Bench.hs @@ -164,8 +158,3 @@ Bench.Sum Bench.Union ghc-options: -O2 -Wall -Wcompat - - if impl(ghc <9.0) - build-depends: integer-gmp - else - build-depends: ghc-bignum diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/changelog.md new/bitvec-1.1.6.0/changelog.md --- old/bitvec-1.1.5.0/changelog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/changelog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,7 @@ +# 1.1.6.0 + +* Make `basicOverlaps` precise instead of rounding bounds up to the next `Word`. + # 1.1.5.0 * Make `zipBits` unconditionally strict in its second bit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/src/Data/Bit/F2Poly.hs new/bitvec-1.1.6.0/src/Data/Bit/F2Poly.hs --- old/bitvec-1.1.5.0/src/Data/Bit/F2Poly.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/src/Data/Bit/F2Poly.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} @@ -36,24 +35,17 @@ import Data.Char import Data.Coerce import Data.Primitive.ByteArray -import Data.Typeable import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MU import GHC.Exts import GHC.Generics -import Numeric - -#ifdef MIN_VERSION_ghc_bignum import GHC.Num.BigNat import GHC.Num.Integer -#else -import GHC.Integer.GMP.Internals -import GHC.Integer.Logarithms -#endif +import Numeric -- | Binary polynomials of one variable, backed --- by an unboxed 'Data.Vector.Unboxed.Vector' 'Bit'. +-- by an unboxed 'Data.Vector.Unboxed.Vector' t'Bit'. -- -- Polynomials are stored normalized, without leading zero coefficients. -- @@ -68,7 +60,7 @@ -- @since 1.0.1.0 newtype F2Poly = F2Poly { unF2Poly :: U.Vector Bit - -- ^ Convert an 'F2Poly' to a vector of coefficients + -- ^ Convert an t'F2Poly' to a vector of coefficients -- (first element corresponds to a constant term). -- -- >>> :set -XBinaryLiterals @@ -77,9 +69,9 @@ -- -- @since 1.0.1.0 } - deriving (Eq, Ord, Typeable, Generic, NFData) + deriving (Eq, Ord, Generic, NFData) --- | Make an 'F2Poly' from a list of coefficients +-- | Make an t'F2Poly' from a list of coefficients -- (first element corresponds to a constant term). -- -- >>> :set -XOverloadedLists @@ -92,21 +84,13 @@ zero :: F2Poly zero = F2Poly $ BitVec 0 0 $ -#ifdef MIN_VERSION_ghc_bignum ByteArray (unBigNat bigNatZero) -#else - fromBigNat zeroBigNat -#endif one :: F2Poly one = F2Poly $ BitVec 0 1 $ -#ifdef MIN_VERSION_ghc_bignum ByteArray (unBigNat bigNatOne) -#else - fromBigNat oneBigNat -#endif --- -- | A valid 'F2Poly' has offset 0 and no trailing garbage. +-- -- | A valid t'F2Poly' has offset 0 and no trailing garbage. -- _isValid :: F2Poly -> Bool -- _isValid (F2Poly (BitVec o l arr)) = o == 0 && l == l' -- where @@ -117,7 +101,7 @@ -- 'abs' = 'id' and 'signum' = 'const' 1. -- -- 'fromInteger' converts a binary polynomial, encoded as 'Integer', --- to 'F2Poly' encoding. +-- to t'F2Poly' encoding. instance Num F2Poly where (+) = coerce xorBits (-) = coerce xorBits @@ -125,7 +109,6 @@ abs = id signum = const one (*) = coerce ((dropWhileEnd .) . karatsuba) -#ifdef MIN_VERSION_ghc_bignum fromInteger !n = case n of IS i# | n < 0 -> throw Underflow @@ -134,16 +117,6 @@ IP bn# -> F2Poly $ BitVec 0 (I# (word2Int# (integerLog2# n)) + 1) $ ByteArray bn# IN{} -> throw Underflow {-# INLINE fromInteger #-} -#else - fromInteger !n = case n of - S# i# - | n < 0 -> throw Underflow - | otherwise -> F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#)))) - $ fromBigNat $ wordToBigNat (int2Word# i#) - Jp# bn# -> F2Poly $ BitVec 0 (I# (integerLog2# n) + 1) $ fromBigNat bn# - Jn#{} -> throw Underflow - {-# INLINE fromInteger #-} -#endif {-# INLINE (+) #-} {-# INLINE (-) #-} @@ -154,25 +127,16 @@ instance Enum F2Poly where fromEnum = fromIntegral -#ifdef MIN_VERSION_ghc_bignum toEnum (I# i#) = F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#)))) $ ByteArray (bigNatFromWord# (int2Word# i#)) -#else - toEnum (I# i#) = F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#)))) - $ fromBigNat $ wordToBigNat (int2Word# i#) -#endif instance Real F2Poly where toRational = fromIntegral --- | 'toInteger' converts a binary polynomial, encoded as 'F2Poly', +-- | 'toInteger' converts a binary polynomial, encoded as t'F2Poly', -- to an 'Integer' encoding. instance Integral F2Poly where -#ifdef MIN_VERSION_ghc_bignum toInteger xs = integerFromBigNat# (bitsToByteArray (unF2Poly xs)) -#else - toInteger xs = bigNatToInteger (BN# (bitsToByteArray (unF2Poly xs))) -#endif quotRem (F2Poly xs) (F2Poly ys) = (F2Poly (dropWhileEnd qs), F2Poly (dropWhileEnd rs)) where (qs, rs) = quotRemBits xs ys @@ -191,21 +155,12 @@ xorBits xs (BitVec _ 0 _) = xs -- GMP has platform-dependent ASM implementations for mpn_xor_n, -- which are impossible to beat by native Haskell. -#ifdef MIN_VERSION_ghc_bignum xorBits (BitVec 0 lx (ByteArray xarr)) (BitVec 0 ly (ByteArray yarr)) = case lx `compare` ly of LT -> BitVec 0 ly zs EQ -> dropWhileEnd $ BitVec 0 (lx `min` (sizeofByteArray zs `shiftL` 3)) zs GT -> BitVec 0 lx zs where zs = ByteArray (xarr `bigNatXor` yarr) -#else -xorBits (BitVec 0 lx xarr) (BitVec 0 ly yarr) = case lx `compare` ly of - LT -> BitVec 0 ly zs - EQ -> dropWhileEnd $ BitVec 0 (lx `min` (sizeofByteArray zs `shiftL` 3)) zs - GT -> BitVec 0 lx zs - where - zs = fromBigNat (toBigNat xarr `xorBigNat` toBigNat yarr) -#endif xorBits xs ys = dropWhileEnd $ runST $ do let lx = U.length xs ly = U.length ys @@ -331,15 +286,6 @@ ys = if U.null xs then U.singleton (0 :: Word) else cloneToWords xs !(P.Vector _ _ (ByteArray arr)) = toPrimVector ys -#ifdef MIN_VERSION_ghc_bignum -#else -fromBigNat :: BigNat -> ByteArray -fromBigNat (BN# arr) = ByteArray arr - -toBigNat :: ByteArray -> BigNat -toBigNat (ByteArray arr) = BN# arr -#endif - -- | Execute the extended Euclidean algorithm. -- For polynomials @a@ and @b@, compute their unique greatest common divisor @g@ -- and the unique coefficient polynomial @s@ satisfying \( a \cdot s + b \cdot t = g \). diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/src/Data/Bit/Immutable.hs new/bitvec-1.1.6.0/src/Data/Bit/Immutable.hs --- old/bitvec-1.1.5.0/src/Data/Bit/Immutable.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/src/Data/Bit/Immutable.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,15 +1,14 @@ -{-# LANGUAGE CPP #-} - {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{- HLINT ignore "Unused LANGUAGE pragma" -} #ifndef BITVEC_THREADSAFE module Data.Bit.Immutable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/src/Data/Bit/Internal.hs new/bitvec-1.1.6.0/src/Data/Bit/Internal.hs --- old/bitvec-1.1.5.0/src/Data/Bit/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/src/Data/Bit/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,15 +1,13 @@ -{-# LANGUAGE CPP #-} - {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ViewPatterns #-} +{- HLINT ignore "Unused LANGUAGE pragma" -} #ifndef BITVEC_THREADSAFE module Data.Bit.Internal @@ -27,12 +25,6 @@ , modifyByteArray ) where -#if MIN_VERSION_vector(0,13,0) -import Data.Vector.Internal.Check (checkIndex, Checks(..)) -#else -#include "vector.h" -#endif - import Control.DeepSeq import Control.Exception import Control.Monad.Primitive @@ -41,9 +33,9 @@ import Data.Bit.Utils import Data.Primitive.ByteArray import Data.Ratio -import Data.Typeable import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as MV +import Data.Vector.Internal.Check (checkIndex, Checks(..)) import qualified Data.Vector.Unboxed as U import GHC.Generics @@ -55,7 +47,7 @@ -- | A newtype wrapper with a custom instance -- for "Data.Vector.Unboxed", which packs booleans -- as efficient as possible (8 values per byte). --- Unboxed vectors of `Bit` use 8x less memory +-- Unboxed vectors of t'Bit' use 8x less memory -- than unboxed vectors of 'Bool' (which store one value per byte), -- but random writes are slightly slower. -- @@ -65,7 +57,7 @@ } deriving (Bounded, Enum, Eq, Ord , FiniteBits -- ^ @since 0.2.0.0 - , Bits, Typeable + , Bits , Generic -- ^ @since 1.0.1.0 , NFData -- ^ @since 1.0.1.0 ) @@ -73,7 +65,7 @@ -- | A newtype wrapper with a custom instance -- for "Data.Vector.Unboxed", which packs booleans -- as efficient as possible (8 values per byte). --- Unboxed vectors of `Bit` use 8x less memory +-- Unboxed vectors of t'Bit' use 8x less memory -- than unboxed vectors of 'Bool' (which store one value per byte), -- but random writes are slightly slower. -- @@ -83,7 +75,7 @@ } deriving (Bounded, Enum, Eq, Ord , FiniteBits -- ^ @since 0.2.0.0 - , Bits, Typeable + , Bits , Generic -- ^ @since 1.0.1.0 , NFData -- ^ @since 1.0.1.0 ) @@ -91,7 +83,7 @@ -- | There is only one lawful 'Num' instance possible -- with '+' = 'xor' and --- 'fromInteger' = 'Bit' . 'odd'. +-- 'fromInteger' = v'Bit' . 'odd'. -- -- @since 1.0.1.0 instance Num Bit where @@ -204,16 +196,9 @@ let !(# state', _ #) = fetchAndIntArray# mba ix (word2Int# msk) state in let !(# state'', _ #) = fetchOrIntArray# mba ix (word2Int# new) state' in (# state'', () #) - --- https://gitlab.haskell.org/ghc/ghc/issues/17334 -#if __GLASGOW_HASKELL__ == 808 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1 -{-# NOINLINE modifyByteArray #-} -#else {-# INLINE modifyByteArray #-} #endif -#endif - -- | Write a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.). If the offset is such that the word extends past the end of the vector, the word is truncated and as many low-order bits as possible are written. writeWord :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> Word -> m () writeWord (BitMVec _ 0 _) !_ !_ = pure () @@ -266,14 +251,10 @@ pure $ BitMVec 0 n arr {-# INLINE basicOverlaps #-} - basicOverlaps (BitMVec i' m' arr1) (BitMVec j' n' arr2) = + basicOverlaps (BitMVec i m arr1) (BitMVec j n arr2) = sameMutableByteArray arr1 arr2 && (between i j (j + n) || between j i (i + m)) where - i = divWordSize i' - m = nWords (i' + m') - i - j = divWordSize j' - n = nWords (j' + n') - j between x y z = x >= y && x < z {-# INLINE basicLength #-} @@ -446,11 +427,7 @@ -- @since 1.0.0.0 unsafeFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () unsafeFlipBit v i = -#if MIN_VERSION_vector(0,13,0) checkIndex Unsafe -#else - UNSAFE_CHECK(checkIndex) "flipBit" -#endif i (MV.length v) $ basicFlipBit v i {-# INLINE unsafeFlipBit #-} @@ -479,11 +456,7 @@ -- @since 1.0.0.0 flipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () flipBit v i = -#if MIN_VERSION_vector(0,13,0) checkIndex Bounds -#else - BOUNDS_CHECK(checkIndex) "flipBit" -#endif i (MV.length v) $ unsafeFlipBit v i {-# INLINE flipBit #-} @@ -503,11 +476,7 @@ -- [1,0,1] unsafeFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () unsafeFlipBit v i = -#if MIN_VERSION_vector(0,13,0) checkIndex Unsafe -#else - UNSAFE_CHECK(checkIndex) "flipBit" -#endif i (MV.length v) $ basicFlipBit v i {-# INLINE unsafeFlipBit #-} @@ -532,11 +501,7 @@ -- [1,0,1] flipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m () flipBit v i = -#if MIN_VERSION_vector(0,13,0) checkIndex Bounds -#else - BOUNDS_CHECK(checkIndex) "flipBit" -#endif i (MV.length v) $ basicFlipBit v i {-# INLINE flipBit #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/src/Data/Bit/Mutable.hs new/bitvec-1.1.6.0/src/Data/Bit/Mutable.hs --- old/bitvec-1.1.5.0/src/Data/Bit/Mutable.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/src/Data/Bit/Mutable.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,10 +1,10 @@ -{-# LANGUAGE CPP #-} - {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{- HLINT ignore "Unused LANGUAGE pragma" -} #ifndef BITVEC_THREADSAFE module Data.Bit.Mutable @@ -116,15 +116,19 @@ -- rewriting the contents of the second argument. -- Cf. 'Data.Bit.zipBits'. -- --- Note: If one input is larger than the other, the remaining bits will be ignored. --- -- >>> :set -XOverloadedLists -- >>> import Data.Bits -- >>> Data.Vector.Unboxed.modify (zipInPlace (.&.) [1,1,0]) [0,1,1] -- [0,1,0] +-- >>> Data.Vector.Unboxed.modify (zipInPlace (\x y -> x .&. complement y) [1,1,0]) [0,1,1] +-- [1,0,0] -- --- __Warning__: if the immutable vector is shorter than the mutable one, --- it is the caller's responsibility to trim the result: +-- __Warning__: +-- If the immutable vector is longer than the mutable one, +-- trailing bits will be ignored. +-- If it's a mutable vector who is longer, +-- trailing bits will be kept unchanged; +-- it is caller's responsibility to trim the result: -- -- >>> :set -XOverloadedLists -- >>> import Data.Bits @@ -201,7 +205,6 @@ writeByteArray ys i (f x y) loop (i + 1) accNew -{-# SPECIALIZE zipInPlace :: (forall a. Bits a => a -> a -> a) -> Vector Bit -> MVector s Bit -> ST s () #-} {-# INLINABLE zipInPlace #-} -- | Apply a function to a mutable vector bitwise, @@ -224,7 +227,6 @@ (False, True) -> const $ pure () (True, False) -> invertInPlace (True, True) -> (`MU.set` Bit True) -{-# SPECIALIZE mapInPlace :: (forall a. Bits a => a -> a) -> MVector s Bit -> ST s () #-} {-# INLINE mapInPlace #-} -- | Invert (flip) all bits in-place. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/src/Data/Bit/Utils.hs new/bitvec-1.1.6.0/src/Data/Bit/Utils.hs --- old/bitvec-1.1.5.0/src/Data/Bit/Utils.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/src/Data/Bit/Utils.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,4 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MagicHash #-} module Data.Bit.Utils ( lgWordSize @@ -29,9 +27,7 @@ import qualified Data.Vector.Primitive as P import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Base as UB -#if __GLASGOW_HASKELL__ >= 810 import GHC.Exts -#endif import Data.Bit.PdepPext @@ -102,40 +98,9 @@ meld b lo hi = (lo .&. m) .|. (hi .&. complement m) where m = mask b {-# INLINE meld #-} -#if __GLASGOW_HASKELL__ >= 810 - reverseWord :: Word -> Word reverseWord (W# w#) = W# (bitReverse# w#) -#else - -reverseWord :: Word -> Word -reverseWord = case wordSize of - 32 -> reverseWord32 - 64 -> reverseWord64 - _ -> error "reverseWord: unknown architecture" - -reverseWord64 :: Word -> Word -reverseWord64 x0 = x6 - where - x1 = ((x0 .&. 0x5555555555555555) `shiftL` 1) .|. ((x0 .&. 0xAAAAAAAAAAAAAAAA) `shiftR` 1) - x2 = ((x1 .&. 0x3333333333333333) `shiftL` 2) .|. ((x1 .&. 0xCCCCCCCCCCCCCCCC) `shiftR` 2) - x3 = ((x2 .&. 0x0F0F0F0F0F0F0F0F) `shiftL` 4) .|. ((x2 .&. 0xF0F0F0F0F0F0F0F0) `shiftR` 4) - x4 = ((x3 .&. 0x00FF00FF00FF00FF) `shiftL` 8) .|. ((x3 .&. 0xFF00FF00FF00FF00) `shiftR` 8) - x5 = ((x4 .&. 0x0000FFFF0000FFFF) `shiftL` 16) .|. ((x4 .&. 0xFFFF0000FFFF0000) `shiftR` 16) - x6 = ((x5 .&. 0x00000000FFFFFFFF) `shiftL` 32) .|. ((x5 .&. 0xFFFFFFFF00000000) `shiftR` 32) - -reverseWord32 :: Word -> Word -reverseWord32 x0 = x5 - where - x1 = ((x0 .&. 0x55555555) `shiftL` 1) .|. ((x0 .&. 0xAAAAAAAA) `shiftR` 1) - x2 = ((x1 .&. 0x33333333) `shiftL` 2) .|. ((x1 .&. 0xCCCCCCCC) `shiftR` 2) - x3 = ((x2 .&. 0x0F0F0F0F) `shiftL` 4) .|. ((x2 .&. 0xF0F0F0F0) `shiftR` 4) - x4 = ((x3 .&. 0x00FF00FF) `shiftL` 8) .|. ((x3 .&. 0xFF00FF00) `shiftR` 8) - x5 = ((x4 .&. 0x0000FFFF) `shiftL` 16) .|. ((x4 .&. 0xFFFF0000) `shiftR` 16) - -#endif - reversePartialWord :: Int -> Word -> Word reversePartialWord n w | n >= wordSize = reverseWord w diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/test/Main.hs new/bitvec-1.1.6.0/test/Main.hs --- old/bitvec-1.1.5.0/test/Main.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/test/Main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} module Main where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/test/Tests/Conc.hs new/bitvec-1.1.6.0/test/Tests/Conc.hs --- old/bitvec-1.1.5.0/test/Tests/Conc.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/test/Tests/Conc.hs 2001-09-09 03:46:40.000000000 +0200 @@ -29,7 +29,7 @@ takeMVar m case_conc_invert :: Property -case_conc_invert = ioProperty $ replicateM_ 1000 $ do +case_conc_invert = once $ ioProperty $ replicateM_ 1000 $ do let len = 64 len' = 37 vec <- M.replicate len (Bit True) @@ -41,7 +41,7 @@ pure $ ref === wec case_conc_reverse :: Property -case_conc_reverse = ioProperty $ replicateM_ 1000 $ do +case_conc_reverse = once $ ioProperty $ replicateM_ 1000 $ do let len = 128 len' = 66 vec <- M.new len @@ -54,7 +54,7 @@ pure $ ref === wec case_conc_zip :: Property -case_conc_zip = ioProperty $ replicateM_ 1000 $ do +case_conc_zip = once $ ioProperty $ replicateM_ 1000 $ do let len = 128 len' = 37 vec <- M.replicate len (Bit True) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/test/Tests/F2Poly.hs new/bitvec-1.1.6.0/test/Tests/F2Poly.hs --- old/bitvec-1.1.5.0/test/Tests/F2Poly.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/test/Tests/F2Poly.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,11 +10,7 @@ import Data.Bits import Data.Ratio import GHC.Exts -#ifdef MIN_VERSION_ghc_bignum import GHC.Num.Integer -#else -import GHC.Integer.Logarithms -#endif import Test.Tasty import Test.Tasty.QuickCheck @@ -98,11 +94,7 @@ binRem :: Integer -> Integer -> Integer binRem x y = go x where -#ifdef MIN_VERSION_ghc_bignum binLog n = I# (word2Int# (integerLog2# n)) -#else - binLog n = I# (integerLog2# n) -#endif ly = binLog y go 0 = 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/test/Tests/MVector.hs new/bitvec-1.1.6.0/test/Tests/MVector.hs --- old/bitvec-1.1.5.0/test/Tests/MVector.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/test/Tests/MVector.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} + #ifndef BITVEC_THREADSAFE module Tests.MVector (mvectorTests) where @@ -9,6 +11,7 @@ import Support import Control.Exception +import Control.Monad import Control.Monad.ST #ifndef BITVEC_THREADSAFE import Data.Bit @@ -69,6 +72,9 @@ testProperty "flipBit" prop_flipBit , testProperty "new negative" prop_new_neg , testProperty "replicate negative" prop_replicate_neg + , testProperty "move preserves data around" prop_move_around + , adjustOption (\(QuickCheckMaxRatio n) -> QuickCheckMaxRatio (max 1000 n)) $ + testProperty "copy preserves data around" prop_copy_around ] prop_flipBit :: U.Vector Bit -> NonNegative Int -> Property @@ -76,7 +82,7 @@ where k' = k `mod` U.length xs ys = U.modify (\v -> M.modify v complement k') xs - ys' = U.modify (\v -> flipBit v k') xs + ys' = U.modify (`flipBit` k') xs case_write_init_read1 :: Property case_write_init_read1 = (=== Bit True) $ runST $ do @@ -233,7 +239,7 @@ prop_castFromWords_def :: N.New U.Vector Word -> Property prop_castFromWords_def ws = - runST (N.run ws >>= pure . castFromWordsM >>= V.unsafeFreeze) + runST (N.run ws >>= V.unsafeFreeze . castFromWordsM) === castFromWords (V.new ws) prop_cloneToWords_def :: N.New U.Vector Bit -> Property @@ -266,12 +272,46 @@ prop_replicate_neg (Positive n) x = ioProperty $ do ret <- try (evaluate (runST $ MG.basicUnsafeReplicate (-n) x >>= U.unsafeFreeze)) pure $ property $ case ret of - Left ErrorCallWithLocation{} -> True + Left (_ :: SomeException) -> True _ -> False prop_new_neg :: Positive Int -> Property prop_new_neg (Positive n) = ioProperty $ do ret <- try (evaluate (runST $ MG.basicUnsafeNew (-n) >>= U.unsafeFreeze :: U.Vector Bit)) pure $ property $ case ret of - Left ErrorCallWithLocation{} -> True + Left (_ :: SomeException) -> True _ -> False + +prop_move_around :: Int -> Int -> Int -> U.Vector Bit -> Property +prop_move_around srcFrom' sliceLen' dstFrom' xs = ioProperty $ do + let l = U.length xs + when (l < 1) discard + let sliceLen = sliceLen' `mod` l + srcFrom = srcFrom' `mod` (l - sliceLen) + dstFrom = dstFrom' `mod` (l - sliceLen) + ys <- V.thaw xs + let src = M.slice srcFrom sliceLen ys + dst = M.slice dstFrom sliceLen ys + M.move dst src + xs' <- V.unsafeFreeze ys + let slicePrefix = V.slice 0 dstFrom + sliceSuffix = V.slice (dstFrom + sliceLen) (l - dstFrom - sliceLen) + pure $ slicePrefix xs === slicePrefix xs' .&&. sliceSuffix xs === sliceSuffix xs' + +prop_copy_around :: Bool -> Int -> Int -> Int -> U.Vector Bit -> Property +prop_copy_around b srcFrom' sliceLen' dstFrom' xs = ioProperty $ do + let l = U.length xs + when (l < 4) discard + let sliceLen = 1 + sliceLen' `mod` ((l - 2) `quot` 2) + firstFrom = srcFrom' `mod` (l - 2 * sliceLen) + secondFrom = firstFrom + sliceLen + dstFrom' `mod` (l - firstFrom - 2 * sliceLen) + (srcFrom, dstFrom) = if b then (firstFrom, secondFrom) else (secondFrom, firstFrom) + ys <- V.thaw xs + let src = M.slice srcFrom sliceLen ys + dst = M.slice dstFrom sliceLen ys + when (M.overlaps src dst) discard + M.copy dst src + xs' <- V.unsafeFreeze ys + let slicePrefix = V.slice 0 dstFrom + sliceSuffix = V.slice (dstFrom + sliceLen) (l - dstFrom - sliceLen) + pure $ slicePrefix xs === slicePrefix xs' .&&. sliceSuffix xs === sliceSuffix xs' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/test/Tests/SetOps.hs new/bitvec-1.1.6.0/test/Tests/SetOps.hs --- old/bitvec-1.1.5.0/test/Tests/SetOps.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/test/Tests/SetOps.hs 2001-09-09 03:46:40.000000000 +0200 @@ -25,6 +25,7 @@ , twoTimesMore $ testProperty "zipBits" prop_zipBits , testProperty "zipInPlace" prop_zipInPlace + , testProperty "zipInPlace around" prop_zipInPlace_around , testProperty "mapBits" prop_mapBits , testProperty "mapInPlace" prop_mapInPlace @@ -37,6 +38,7 @@ , mkGroup "invertBits" prop_invertBits , testProperty "invertInPlace" prop_invertInPlace + , testProperty "invertInPlace around" prop_invertInPlace_around , testProperty "invertInPlaceWords" prop_invertInPlaceWords , testProperty "invertInPlace middle" prop_invertInPlace_middle , testProperty "invertInPlaceLong middle" prop_invertInPlaceLong_middle @@ -122,6 +124,18 @@ where f = curry $ applyFun fun +prop_zipInPlace_around :: Fun (Bit, Bit) Bit -> U.Vector Bit -> U.Vector Bit -> Property +prop_zipInPlace_around fun ts xs = ioProperty $ do + let l = U.length xs + f = curry $ applyFun fun + when (l < 2) discard + ys <- U.thaw xs + let zs = MU.slice 1 (l - 2) ys + zipInPlace (generalize2 f) ts zs + hd <- MU.read ys 0 + lst <- MU.read ys (MU.length ys - 1) + pure $ hd === U.head xs .&&. lst === U.last xs + prop_mapBits :: Fun Bit Bit -> U.Vector Bit -> Property prop_mapBits fun xs = U.map (applyFun fun) xs === mapBits (generalize1 (applyFun fun)) xs @@ -138,6 +152,17 @@ prop_invertInPlace xs = U.map complement xs === U.modify invertInPlace xs +prop_invertInPlace_around :: U.Vector Bit -> Property +prop_invertInPlace_around xs = ioProperty $ do + let l = U.length xs + when (l < 2) discard + ys <- U.thaw xs + let zs = MU.slice 1 (l - 2) ys + invertInPlace zs + hd <- MU.read ys 0 + lst <- MU.read ys (MU.length ys - 1) + pure $ hd === U.head xs .&&. lst === U.last xs + prop_invertInPlaceWords :: Large (U.Vector Bit) -> Property prop_invertInPlaceWords = prop_invertInPlace . getLarge diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/bitvec-1.1.5.0/test/Tests/Vector.hs new/bitvec-1.1.6.0/test/Tests/Vector.hs --- old/bitvec-1.1.5.0/test/Tests/Vector.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/bitvec-1.1.6.0/test/Tests/Vector.hs 2001-09-09 03:46:40.000000000 +0200 @@ -280,7 +280,7 @@ prop_nthBit_6 (NonNegative n) xs = ioProperty $ do ret <- try (evaluate (nthBitIndex (Bit True) (-n) xs)) pure $ property $ case ret of - Left ErrorCallWithLocation{} -> True + Left ErrorCall{} -> True _ -> False case_nthBit_1 :: Property
