bv-sized 1.0.2 → 1.0.3

raw patch · 7 files changed

+136/−27 lines, 7 filesdep +MonadRandomdep +deepseqdep +randomdep ~tastydep ~tasty-hedgehogPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: MonadRandom, deepseq, random

Dependency ranges changed: tasty, tasty-hedgehog

API changes (from Hackage documentation)

Files

• bv-sized.cabal +7/−4
• changelog.md +6/−0
• src/Data/BitVector/Sized.hs +5/−0
• src/Data/BitVector/Sized/Internal.hs +46/−13
• src/Data/BitVector/Sized/Signed.hs +16/−5
• src/Data/BitVector/Sized/Unsigned.hs +16/−5
• test/Main.hs +40/−0

@@ -1,5 +1,5 @@ name:                bv-sized-version:             1.0.2+version:             1.0.3 category:            Bit Vectors synopsis:            a bitvector datatype that is parameterized by the vector width description:@@ -29,12 +29,14 @@   build-depends:       base >= 4.10 && <5,                        bitwise >= 1.0.0 && < 1.1,                        bytestring >= 0.10 && < 0.11,+                       deepseq >= 1.4.0 && < 1.5.0,                        panic >= 0.4.0 && < 0.5,                        parameterized-utils >= 2.0.2 && < 2.2,+                       random >= 1.2.0 && < 1.3,                        th-lift >= 0.8.1 && < 0.9   hs-source-dirs:      src   default-language:    Haskell2010-  ghc-options:         -Wall+  ghc-options:         -Wall -Wcompat  test-suite bv-sized-tests   type:                exitcode-stdio-1.0@@ -44,8 +46,9 @@                        bv-sized,                        bytestring,                        hedgehog,+                       MonadRandom >= 0.5.3 && < 0.6,                        parameterized-utils,-                       tasty >= 1.2.3 && < 1.4,-                       tasty-hedgehog >= 1.0.0.2 && < 1.1+                       tasty >= 1.2.3 && < 1.5,+                       tasty-hedgehog >= 1.0.0.2 && < 1.2   default-language:    Haskell2010   ghc-options:         -Wall -Wcompat

@@ -1,5 +1,11 @@ # Changelog for [`bv-sized` package](http://hackage.haskell.org/package/bv-sized) +## 1.0.3 *April 2021*++* New instances (`NFData`, `Random`)+* New functions for `BV` that create uniformly random bitvectors+* Fix: Adds `asBV` for `SignedBV` (should have been there to begin with)+ ## 1.0.2 *August 2020*  * Allows tasty 1.3 for test suite

@@ -94,6 +94,11 @@   , succUnsigned, succSigned   , predUnsigned, predSigned   , enumFromToUnsigned, enumFromToSigned+    -- * Generating random bitvectors+    -- | 'BV' versions of the functions in 'System.Random'.+  , uniformM+  , uUniformRM+  , sUniformRM     -- * Pretty printing   , ppHex   , ppBin

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE GADTs #-}@@ -29,18 +30,19 @@ -- Qualified imports import qualified Data.Bits                  as B import qualified Data.Bits.Bitwise          as B-import qualified Data.ByteString as BS+import qualified Data.ByteString            as BS import qualified Numeric                    as N import qualified Data.Parameterized.NatRepr as P-import qualified Prelude as Prelude+import qualified Prelude  -- Unqualified imports+import Control.DeepSeq (NFData) import Data.Char (intToDigit) import Data.List (genericLength)-import Data.Int+import Data.Int (Int8, Int16, Int32, Int64) import Data.Kind (Type) import Data.Maybe (fromJust)-import Data.Word+import Data.Word (Word8, Word16, Word32, Word64) import Data.Parameterized ( NatRepr                           , mkNatRepr                           , natValue@@ -52,11 +54,12 @@                           , Some(..)                           , Pair(..)                           )-import GHC.Generics-import GHC.TypeLits+import GHC.Generics (Generic)+import GHC.TypeLits (Nat, type(+), type(<=)) import Language.Haskell.TH.Lift (Lift)-import Numeric.Natural+import Numeric.Natural (Natural) import Prelude hiding (abs, or, and, negate, concat, signum)+import System.Random.Stateful  ---------------------------------------- -- Utility functions@@ -95,6 +98,7 @@   BV :: Integer -> BV w    deriving ( Generic+           , NFData            , Show            , Read            , Eq@@ -618,14 +622,14 @@ ctz :: NatRepr w -> BV w -> BV w ctz w (BV x) = BV (go 0)   where go !i | i < intValue w &&-                B.testBit x (fromInteger i) == False = go (i+1)+                not (B.testBit x (fromInteger i)) = go (i+1)               | otherwise = i  -- | Count leading zeros in a 'BV'. clz :: NatRepr w -> BV w -> BV w clz w (BV x) = BV (go 0)  where go !i | i < intValue w &&-               B.testBit x (fromInteger (intValue w - i - 1)) == False =+               not (B.testBit x (fromInteger (intValue w - i - 1))) =                  go (i+1)              | otherwise = i @@ -768,7 +772,7 @@        -- ^ Lower-order bits        -> BV (w+w') concat w w' (BV hi) (BV lo) = checkNatRepr (w `addNat` w') $-  BV ((hi `B.shiftL` (fromNatural (natValue w'))) B..|. lo)+  BV ((hi `B.shiftL` fromNatural (natValue w')) B..|. lo)  -- | Slice out a smaller bitvector from a larger one. --@@ -786,7 +790,7 @@        -> BV w' select ix w' (BV x) = mkBV' w' xShf   -- NB fromNatural is OK because of (ix + w' <= w) constraint-  where xShf = x `B.shiftR` (fromNatural (natValue ix))+  where xShf = x `B.shiftR` fromNatural (natValue ix)  -- | Like 'select', but takes a 'Natural' as the index to start -- selecting from. Neither the index nor the output width is checked@@ -806,7 +810,7 @@         -- ^ Bitvector to select from         -> BV w' select' ix w' (BV x)-  | toInteger ix < toInteger (maxBound :: Int) = mkBV w' (x `B.shiftR` (fromNatural ix))+  | toInteger ix < toInteger (maxBound :: Int) = mkBV w' (x `B.shiftR` fromNatural ix)   | otherwise = zero w'  -- | Zero-extend a bitvector to one of strictly greater width.@@ -905,7 +909,36 @@                  -> BV w                  -- ^ Upper bound                  -> [BV w]-enumFromToSigned w bv1 bv2 = (BV . fromJust . signedToUnsigned w) <$> [asSigned w bv1 .. asSigned w bv2]+enumFromToSigned w bv1 bv2 =+  BV . fromJust . signedToUnsigned w <$> [asSigned w bv1 .. asSigned w bv2]++----------------------------------------+-- Generating random bitvectors++-- | Generates a bitvector uniformly distributed over all possible values for a+-- given width. (See 'System.Random.Stateful.uniformM').+uniformM :: StatefulGen g m => NatRepr w -> g -> m (BV w)+uniformM w g = BV <$> uniformRM (P.minUnsigned w, P.maxUnsigned w) g++-- | Generates a bitvector uniformly distributed over the provided range+-- (interpreted as a range of /unsigned/ bitvectors), which is interpreted as+-- inclusive in the lower and upper bound. (See+-- 'System.Random.Stateful.uniformRM').+uUniformRM :: StatefulGen g m => (BV w, BV w) -> g -> m (BV w)+uUniformRM (lo, hi) g =+  let loI = asUnsigned lo+      hiI = asUnsigned hi+  in BV <$> uniformRM (loI, hiI) g++-- | Generates a bitvector uniformly distributed over the provided range+-- (interpreted as a range of /signed/ bitvectors), which is interpreted as+-- inclusive in the lower and upper bound. (See+-- 'System.Random.Stateful.uniformRM').+sUniformRM :: (StatefulGen g m, 1 <= w) => NatRepr w -> (BV w, BV w) -> g -> m (BV w)+sUniformRM w (lo, hi) g =+  let loI = asSigned w lo+      hiI = asSigned w hi+  in mkBV w <$> uniformRM (loI, hiI) g  ---------------------------------------- -- Pretty printing

@@ -36,21 +36,23 @@ import GHC.Generics import GHC.TypeLits import Numeric.Natural+import System.Random+import System.Random.Stateful  -- | Signed bit vector.-newtype SignedBV w = SignedBV (BV w)+newtype SignedBV w = SignedBV { asBV :: BV w }   deriving (Generic, Show, Read, Eq) --- | Convenience wrapper for 'BV.mkBV'.-mkSignedBV :: NatRepr w -> Integer -> SignedBV w-mkSignedBV w x = SignedBV (BV.mkBV w x)- instance (KnownNat w, 1 <= w) => Ord (SignedBV w) where   SignedBV bv1 `compare` SignedBV bv2 =     if | bv1 == bv2              -> EQ        | BV.slt knownNat bv1 bv2 -> LT        | otherwise               -> GT +-- | Convenience wrapper for 'BV.mkBV'.+mkSignedBV :: NatRepr w -> Integer -> SignedBV w+mkSignedBV w x = SignedBV (BV.mkBV w x)+ liftUnary :: (BV w -> BV w)           -> SignedBV w           -> SignedBV w@@ -126,3 +128,12 @@ instance (KnownNat w, 1 <= w) => Bounded (SignedBV w) where   minBound = SignedBV (BV.minSigned knownNat)   maxBound = SignedBV (BV.maxSigned knownNat)++instance KnownNat w => Uniform (SignedBV w) where+  uniformM g = SignedBV <$> BV.uniformM knownNat g++instance (KnownNat w, 1 <= w) => UniformRange (SignedBV w) where+  uniformRM (SignedBV lo, SignedBV hi) g =+    SignedBV <$> BV.sUniformRM knownNat (lo, hi) g++instance (KnownNat w, 1 <= w) => Random (SignedBV w)

@@ -28,13 +28,15 @@ import           Data.BitVector.Sized.Internal (BV(..), mkBV) import qualified Data.BitVector.Sized.Internal as BV import           Data.BitVector.Sized.Panic (panic)-import Data.Parameterized.NatRepr+import           Data.Parameterized.NatRepr (NatRepr, knownNat, maxUnsigned, widthVal)  import Data.Bits (Bits(..), FiniteBits(..))-import Data.Ix-import GHC.Generics-import GHC.TypeLits-import Numeric.Natural+import Data.Ix (Ix(inRange, range, index))+import GHC.Generics (Generic)+import GHC.TypeLits (KnownNat)+import Numeric.Natural (Natural)+import System.Random+import System.Random.Stateful  -- | Signed bit vector. newtype UnsignedBV w = UnsignedBV { asBV :: BV w }@@ -118,3 +120,12 @@ instance KnownNat w => Bounded (UnsignedBV w) where   minBound = UnsignedBV (BV.minUnsigned knownNat)   maxBound = UnsignedBV (BV.maxUnsigned knownNat)++instance KnownNat w => Uniform (UnsignedBV w) where+  uniformM g = UnsignedBV <$> BV.uniformM knownNat g++instance UniformRange (UnsignedBV w) where+  uniformRM (UnsignedBV lo, UnsignedBV hi) g =+    UnsignedBV <$> BV.uUniformRM (lo, hi) g++instance KnownNat w => Random (UnsignedBV w)

@@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-}@@ -17,8 +18,11 @@  -- Modules under test import qualified Data.BitVector.Sized as BV+import qualified Data.BitVector.Sized.Unsigned as BV+import qualified Data.BitVector.Sized.Signed as BV  -- Auxiliary modules+import Control.Monad.Random import qualified Data.Bits as Bits import qualified Data.ByteString as BS import Data.Maybe (isJust, fromJust)@@ -634,6 +638,41 @@     , testProperty "predSigned" $ wfUnaryMaybe anyPosWidth (forcePos BV.predUnsigned)     ] +testRandomR :: (Ord (f w), Random (f w), Show (f w), Show a)+            => NatRepr w+            -> (forall w' . NatRepr w' -> a -> f w')+            -> (NatRepr w -> Gen a)+            -> Property+testRandomR w mk gen = property $ do+  x <- mk w <$> forAll (gen w)+  y <- mk w <$> forAll (gen w)++  let l = min x y+      h = max x y++  rand  <- liftIO $ getRandomR (l, h)+  rand' <- liftIO $ getRandomR (h, l)++  diff l    (<=) rand+  diff rand (<=) h++  diff l     (<=) rand'+  diff rand' (<=) h++randomTests :: TestTree+randomTests = testGroup "tests for random generation"+  [ testProperty "random unsigned well-formed" $ property $ do+      BV.UnsignedBV (BV.BV x) :: BV.UnsignedBV 32 <- liftIO $ getRandom+      checkBounds x (knownNat @32)+  , testProperty "random signed well-formed" $ property $ do+      BV.SignedBV (BV.BV x) :: BV.SignedBV 32 <- liftIO $ getRandom+      checkBounds x (knownNat @32)+  , testProperty "randomR unsigned well-formed and in bounds" $+    testRandomR (knownNat @32) BV.mkUnsignedBV unsigned+  , testProperty "randomR signed well-formed and in bounds" $+    testRandomR (knownNat @32) BV.mkSignedBV unsigned+  ]+ tests :: TestTree tests = testGroup "bv-sized tests"   [ arithHomTests@@ -641,6 +680,7 @@   , serdeTests   , deserTests   , wellFormedTests+  , randomTests   ]  main :: IO ()