diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ ## Efficient little-endian bit vector Haskell library [![Build Status](https://travis-ci.org/recursion-ninja/bv-little.svg?branch=master)](https://travis-ci.org/recursion-ninja/bv-little) +[![Workflow Status](https://github.com/recursion-ninja/bv-little/workflows/build/badge.svg?branch=master)](https://github.com/recursion-ninja/bv-little/actions) [![Coverage Status](https://coveralls.io/repos/github/recursion-ninja/bv-little/badge.svg?branch=master)](https://coveralls.io/github/recursion-ninja/bv-little?branch=master) [![License FreeBSD](https://img.shields.io/badge/license-FreeBSD-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) @@ -11,31 +12,29 @@ [![Stackage Nightly](http://stackage.org/package/bv-little/badge/nightly?style=flat&color=green)](http://stackage.org/nightly/package/bv-little) -This package contains an efficient implementation of *little-endian, immutable* bit vectors. It implements most applicable typeclasses and also conversions to and from signed or unsigned numbers. +This package contains an efficient implementation of *little-endian, immutable* bit vectors. It implements most applicable type-classes and also conversions to and from signed or unsigned numbers. For an implementation of *big-endian, immutable* bit vectors, use the [`bv`](https://hackage.haskell.org/package/bv) package. For an implementation of *little-endian, mutable* bit vectors, use the [`bitvec`](https://hackage.haskell.org/package/bitvec) package. + #### Tests -The test suite ensures that all typeclass instances are "lawful" and that data-structure–specific functionality is well defined. +The test suite ensures that all type-class instances are "lawful" and that data-structure–specific functionality is well defined. The `TestSuite.hs` file contains the specification. It can be run by invoking any of the following commands: - * `cabal new-test` - * `cabal test` * `stack test` + #### Benchmarks The benchmarks provide an empyrical check for the asymptotic complexity of data structure operations and also provide easy metrics for detecting performance regressions. -The `Benchmaks.hs` file contains these metrics. It can be run by invoking any of the following commands: - - * `cabal new-bench` +The `Benchmarks.hs` file contains these metrics. It can be run by invoking any of the following commands: * `cabal bench` diff --git a/bench/Benchmarks.hs b/bench/Benchmarks.hs --- a/bench/Benchmarks.hs +++ b/bench/Benchmarks.hs @@ -1,31 +1,46 @@ -{-# LANGUAGE BangPatterns #-} +{-| -module Main (main) where +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable +-} + +{-# Language BangPatterns #-} + +module Main + ( main + ) where + import Control.DeepSeq import Criterion.Main -import Data.Bits import Data.BitVector.LittleEndian -import Data.List (nubBy) +import Data.BitVector.LittleEndian.Instances () +import Data.Bits import Data.Hashable +import Data.List (nubBy) import Data.MonoTraversable -import Data.Semigroup import Operator.Binary.Logical import Operator.Unary.Logical +{-| +Complete /runtime/ benchmarking suite for the 'BitVector' type. +-} main :: IO () -main = defaultMain [ benchmarks ] +main = defaultMain [benchmarks] benchmarks :: Benchmark -benchmarks = bgroup "BitVector" +benchmarks = bgroup + "BitVector" [ toBitsBench , fromBitsBench , fromNumberBench , toSignedNumberBench , toUnsignedNumberBench - , dimmensionBench + , dimensionBench , isZeroVectorBench , zeroPopCountBench , subRangeBench @@ -66,7 +81,8 @@ -- -- ceiling ( log_2 (pi * 10^100) ) === 334 largeNumber :: Integer -largeNumber = 31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679 +largeNumber = + 31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679 -- | @@ -74,7 +90,8 @@ -- -- ceiling ( log_2 (√2 * 10^200) ) === 665 hugeNumber :: Integer -hugeNumber = 14142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248360558507372126441214970999358314132226659275055927557999505011527820605715 +hugeNumber = + 14142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248360558507372126441214970999358314132226659275055927557999505011527820605715 toBitsBench :: Benchmark @@ -83,17 +100,19 @@ fromBitsBench :: Benchmark fromBitsBench = constantNumberTimeBenchmark "fromBits" id g - where - g int n = let !bitCount = fromEnum $ logBase2Word int - bitStream = force $ foldMap (\i -> [testBit n i]) [0 .. bitCount - 1] - in fromBits bitStream + where + g :: Bits b => Integer -> b -> BitVector + g int n = + let !bitCount = fromEnum $ logBase2Word int + bitStream = force $ foldMap (\i -> [testBit n i]) [0 .. bitCount - 1] + in fromBits bitStream fromNumberBench :: Benchmark fromNumberBench = constantNumberTimeBenchmark "fromNumber" id g - where - g int = let !bitCount = logBase2Word int - in fromNumber bitCount + where + g :: Integral i => Integer -> i -> BitVector + g int = let !bitCount = logBase2Word int in fromNumber bitCount toSignedNumberBench :: Benchmark @@ -104,50 +123,59 @@ toUnsignedNumberBench = unaryBenchmark "toUnsignedNumber" (toUnsignedNumber :: BitVector -> Integer) -dimmensionBench :: Benchmark -dimmensionBench = constantNumberTimeBenchmark "dimmension" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - in dimension bitVector - +dimensionBench :: Benchmark +dimensionBench = constantNumberTimeBenchmark "dimension" id g + where + g :: Integer -> a -> Word + g int _ = + let !bitCount = logBase2Word int + !bitVector = fromNumber bitCount int + in dimension bitVector + isZeroVectorBench :: Benchmark isZeroVectorBench = constantNumberTimeBenchmark "isZeroVector" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - in isZeroVector bitVector - + where + g :: Integer -> a -> Bool + g int _ = + let !bitCount = logBase2Word int + !bitVector = fromNumber bitCount int + in isZeroVector bitVector + zeroPopCountBench :: Benchmark zeroPopCountBench = constantNumberTimeBenchmark "popCount is zero" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - in ((0==) . popCount) bitVector - + where + g :: Integer -> a -> Bool + g int _ = + let !bitCount = logBase2Word int + !bitVector = fromNumber bitCount int + in ((0 ==) . popCount) bitVector + subRangeBench :: Benchmark subRangeBench = constantNumberTimeBenchmark "subRange" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - !lowerBound = bitCount `div` 4 - !upperBound = (bitCount * 3) `div` 4 - in (lowerBound, upperBound) `subRange` bitVector - + where + g :: Integer -> a -> BitVector + g int _ = + let !bitCount = logBase2Word int + !bitVector = fromNumber bitCount int + !lowerBound = bitCount `div` 4 + !upperBound = (bitCount * 3) `div` 4 + in (lowerBound, upperBound) `subRange` bitVector + bitsBench :: Benchmark -bitsBench = bgroup "Bits" - [ binaryBenchmark "(.|.)" (.|.) - , binaryBenchmark "(.&.)" (.&.) - , binaryBenchmark "xor" xor - , unaryBenchmark "complement" complement +bitsBench = bgroup + "Bits" + [ binaryBenchmark "(.|.)" (.|.) + , binaryBenchmark "(.&.)" (.&.) + , binaryBenchmark "xor" xor + , unaryBenchmark "complement" complement -- , unaryBenchmark "bitSize" bitSize - , unaryBenchmark "bitSizeMaybe" bitSizeMaybe - , unaryBenchmark "isSigned" isSigned - , unaryBenchmark "popCount" popCount + , unaryBenchmark "bitSizeMaybe" bitSizeMaybe + , unaryBenchmark "isSigned" isSigned + , unaryBenchmark "popCount" popCount , indexingBenchmark "shift" shift , indexingBenchmark "shiftL" shiftL , indexingBenchmark "shiftR" shiftR @@ -162,7 +190,8 @@ finiteBitsBench :: Benchmark -finiteBitsBench = bgroup "FiniteBits" +finiteBitsBench = bgroup + "FiniteBits" [ unaryBenchmark "finiteBitSize" finiteBitSize , unaryBenchmark "countLeadingZeros" countLeadingZeros , unaryBenchmark "countTrailingZeros" countLeadingZeros @@ -170,108 +199,106 @@ hashableBench :: Benchmark -hashableBench = bgroup "Hashable" - [ unaryBenchmark "hash" hash - , indexingBenchmark "hashWithSalt" (flip hashWithSalt) - ] - +hashableBench = + bgroup "Hashable" [unaryBenchmark "hash" hash, indexingBenchmark "hashWithSalt" (flip hashWithSalt)] + semigroupBench :: Benchmark -semigroupBench = bgroup "Semigroup" - [ binaryBenchmark "(<>)" (<>) - ] - +semigroupBench = bgroup "Semigroup" [binaryBenchmark "(<>)" (<>)] + monoFoldableBench :: Benchmark -monoFoldableBench = bgroup "MonoFoldable" +monoFoldableBench = bgroup + "MonoFoldable" [ fold1Benchmark "ofoldr1Ex" ofoldr1Ex , fold1Benchmark "ofoldl1Ex'" ofoldl1Ex' - , mapBenchmark "omap" omap - , queryBenchmark "oall" oall - , queryBenchmark "oany" oany + , mapBenchmark "omap" omap + , queryBenchmark "oall" oall + , queryBenchmark "oany" oany ] -constantNumberTimeBenchmark :: (NFData a, NFData b) => String -> (Integer -> a) -> (Integer -> a -> b) -> Benchmark -constantNumberTimeBenchmark label f g = bgroup label $ generateBenchmark <$> magicNumbers - where - generateBenchmark (intLabel, intValue) = bench intLabel $ nf app target - where - !target = force $ f intValue - !app = g intValue +constantNumberTimeBenchmark + :: (NFData a, NFData b) => String -> (Integer -> a) -> (Integer -> a -> b) -> Benchmark +constantNumberTimeBenchmark label f g = bgroup label $ generateBenchmark <$> magicNumbers + where + generateBenchmark (intLabel, intValue) = bench intLabel $ nf app target + where + !target = force $ f intValue + !app = g intValue - + unaryBenchmark :: NFData a => String -> (BitVector -> a) -> Benchmark unaryBenchmark label f = bgroup label $ generateBenchmark <$> magicNumbers - where - generateBenchmark (intLabel, intValue) = bench intLabel $ nf f target - where - !target = bvGen intValue + where + generateBenchmark (intLabel, intValue) = bench intLabel $ nf f target where !target = bvGen intValue - + binaryBenchmark :: NFData a => String -> (BitVector -> BitVector -> a) -> Benchmark binaryBenchmark label op = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel1, intValue1, intLabel2, intValue2) = bench message $ nf id target - where - message = unwords [intLabel1, "`op`", intLabel2] - !lhs = bvGen intValue1 - !rhs = bvGen intValue2 - target = lhs `op` rhs - combinations = [ (a,b,c,d) | (a,b) <- magicNumbers, (c,d) <- magicNumbers, b < d ] + where + generateBenchmark (intLabel1, intValue1, intLabel2, intValue2) = bench message $ nf id target + where + message = unwords [intLabel1, "`op`", intLabel2] + !lhs = bvGen intValue1 + !rhs = bvGen intValue2 + target = lhs `op` rhs + combinations = [ (a, b, c, d) | (a, b) <- magicNumbers, (c, d) <- magicNumbers, b < d ] indexingBenchmark :: NFData a => String -> (BitVector -> Int -> a) -> Benchmark indexingBenchmark label op = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel, intValue, idxLabel, idxValue) = bench message $ nf app target - where - message = unwords [intLabel, "@", idxLabel <> ":" <> show idxValue] - !target = bvGen intValue - app = (`op` idxValue) + where + generateBenchmark (intLabel, intValue, idxLabel, idxValue) = bench message $ nf app target + where + message = unwords [intLabel, "@", idxLabel <> ":" <> show idxValue] + !target = bvGen intValue + app = (`op` idxValue) - combinations = do - (a, b) <- magicNumbers - let bitCount = fromEnum $ logBase2Word b - (c, d) <- nubBy (\x y -> snd x == snd y) [("first", 0), ("middle", bitCount `div` 2), ("last", bitCount - 1)] - let e = force (a,b,c,d) - [e] + combinations = do + (a, b) <- magicNumbers + let bitCount = fromEnum $ logBase2Word b + (c, d) <- nubBy + (\x y -> snd x == snd y) + [("first", 0), ("middle", bitCount `div` 2), ("last", bitCount - 1)] + let e = force (a, b, c, d) + [e] fold1Benchmark :: String -> ((Bool -> Bool -> Bool) -> BitVector -> Bool) -> Benchmark fold1Benchmark label fold1Fun = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target - where - message = unwords ["fold1", getBinaryLogicalSymbol lOp, intLabel] - !op = getBinaryLogicalOperator lOp - !bv = bvGen intValue - target = fold1Fun op bv - combinations = [ (a,b, op) | (a,b) <- magicNumbers, op <- [minBound .. maxBound] ] + where + generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target + where + message = unwords ["fold1", getBinaryLogicalSymbol lOp, intLabel] + !op = getBinaryLogicalOperator lOp + !bv = bvGen intValue + target = fold1Fun op bv + combinations = [ (a, b, op) | (a, b) <- magicNumbers, op <- [minBound .. maxBound] ] mapBenchmark :: String -> ((Bool -> Bool) -> BitVector -> BitVector) -> Benchmark mapBenchmark label mapFun = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target - where - message = unwords ["map", getUnaryLogicalSymbol lOp, intLabel] - !op = getUnaryLogicalOperator lOp - !bv = bvGen intValue - target = mapFun op bv - combinations = [ (a,b, op) | (a,b) <- magicNumbers, op <- [minBound .. maxBound] ] + where + generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target + where + message = unwords ["map", getUnaryLogicalSymbol lOp, intLabel] + !op = getUnaryLogicalOperator lOp + !bv = bvGen intValue + target = mapFun op bv + combinations = [ (a, b, op) | (a, b) <- magicNumbers, op <- [minBound .. maxBound] ] queryBenchmark :: String -> ((Bool -> Bool) -> BitVector -> Bool) -> Benchmark queryBenchmark label mapFun = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target - where - message = unwords ["query", getUnaryLogicalSymbol lOp, intLabel] - !op = getUnaryLogicalOperator lOp - !bv = bvGen intValue - target = mapFun op bv - combinations = [ (a,b, op) | (a,b) <- magicNumbers, op <- [minBound .. maxBound] ] + where + generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target + where + message = unwords ["query", getUnaryLogicalSymbol lOp, intLabel] + !op = getUnaryLogicalOperator lOp + !bv = bvGen intValue + target = mapFun op bv + combinations = [ (a, b, op) | (a, b) <- magicNumbers, op <- [minBound .. maxBound] ] bvGen :: Integer -> BitVector @@ -284,10 +311,10 @@ magicNumbers :: [(String, Integer)] magicNumbers = - [ ("zero" , 0) - , ("tiny" , tinyNumber) - , ("small" , smallNumber) + [ ("zero" , 0) + , ("tiny" , tinyNumber) + , ("small" , smallNumber) , ("medium", mediumNumber) - , ("large" , largeNumber) - , ("huge" , hugeNumber) + , ("large" , largeNumber) + , ("huge" , hugeNumber) ] diff --git a/bench/HeapStack.hs b/bench/HeapStack.hs --- a/bench/HeapStack.hs +++ b/bench/HeapStack.hs @@ -1,287 +1,89 @@ -{-# LANGUAGE BangPatterns #-} +{-| -module Main (main) where +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable +-} + +{-# Language BangPatterns #-} + +module Main + ( main + ) where + import Control.DeepSeq import Control.Exception -import Criterion.Main -import Data.Bits import Data.BitVector.LittleEndian +import Data.BitVector.LittleEndian.Instances () +import Data.Bits import Data.Foldable import Data.List (nubBy) -import Data.Hashable -import Data.MonoTraversable -import Data.Semigroup import Numeric.Natural -import Operator.Binary.Logical -import Operator.Unary.Logical +{-| +Complete /memory/ benchmarking suite for the 'BitVector' type. +-} main :: IO () -main = sequenceA_ - [ traverse_ (evaluate . force) actions - , traverse_ (evaluate . force) other - ] +main = sequenceA_ [traverse_ (evaluate . force) actions, traverse_ (evaluate . force) other] other :: [[[Word]]] -other = - [ pure <$> indexingBenchmarkW rank - , toList <$> indexingBenchmarkW select - ] +other = [pure <$> indexingBenchmarkW rank, toList <$> indexingBenchmarkW select] -actions :: [[ BitVector ]] -actions = fold $ replicate (10^7) - [ indexingBenchmark shift - , indexingBenchmark shiftL - , indexingBenchmark shiftR - , indexingBenchmark rotate - , indexingBenchmark rotateL - , indexingBenchmark rotateR - , indexingBenchmark setBit - , indexingBenchmark clearBit +actions :: [[BitVector]] +actions = fold $ replicate + (10 ^ 7) + [ indexingBenchmark shift + , indexingBenchmark shiftL + , indexingBenchmark shiftR + , indexingBenchmark rotate + , indexingBenchmark rotateL + , indexingBenchmark rotateR + , indexingBenchmark setBit + , indexingBenchmark clearBit , indexingBenchmark complementBit -- , indexingBenchmark testBit ] - -benchmarks :: Benchmark -benchmarks = bgroup "BitVector" - [ toBitsBench - , fromBitsBench - , fromNumberBench - , toSignedNumberBench - , toUnsignedNumberBench - , dimmensionBench - , isZeroVectorBench - , zeroPopCountBench - , subRangeBench --- , bitsBench - , finiteBitsBench - , hashableBench - , semigroupBench - , monoFoldableBench - ] - - -indexingBenchmark' :: NFData a => String -> (BitVector -> Int -> a) -> Benchmark -indexingBenchmark' = undefined - - -toBitsBench :: Benchmark -toBitsBench = unaryBenchmark "toBitsNumber" toBits - - -fromBitsBench :: Benchmark -fromBitsBench = constantNumberTimeBenchmark "fromBits" id g - where - g int n = let !bitCount = fromEnum $ logBase2Word int - bitStream = force $ foldMap (\i -> [testBit n i]) [0 .. bitCount - 1] - in fromBits bitStream - - -fromNumberBench :: Benchmark -fromNumberBench = constantNumberTimeBenchmark "fromNumber" id g - where - g int = let !bitCount = logBase2Word int - in fromNumber bitCount - - -toSignedNumberBench :: Benchmark -toSignedNumberBench = unaryBenchmark "toSignedNumber" (toSignedNumber :: BitVector -> Natural) - - -toUnsignedNumberBench :: Benchmark -toUnsignedNumberBench = unaryBenchmark "toUnsignedNumber" (toUnsignedNumber :: BitVector -> Natural) - - -dimmensionBench :: Benchmark -dimmensionBench = constantNumberTimeBenchmark "dimmension" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - in dimension bitVector - - -isZeroVectorBench :: Benchmark -isZeroVectorBench = constantNumberTimeBenchmark "isZeroVector" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - in isZeroVector bitVector - - -zeroPopCountBench :: Benchmark -zeroPopCountBench = constantNumberTimeBenchmark "popCount is zero" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - in ((0==) . popCount) bitVector - - -subRangeBench :: Benchmark -subRangeBench = constantNumberTimeBenchmark "subRange" id g - where - g int _ = let !bitCount = logBase2Word int - !bitVector = fromNumber bitCount int - !lowerBound = bitCount `div` 4 - !upperBound = (bitCount * 3) `div` 4 - in (lowerBound, upperBound) `subRange` bitVector - - -{- -bitsBench :: Benchmark -bitsBench = bgroup "Bits" - [ binaryBenchmark "(.|.)" (.|.) - , binaryBenchmark "(.&.)" (.&.) - , binaryBenchmark "xor" xor - , unaryBenchmark "complement" complement --- , unaryBenchmark "bitSize" bitSize - , unaryBenchmark "bitSizeMaybe" bitSizeMaybe - , unaryBenchmark "isSigned" isSigned - , unaryBenchmark "popCount" popCount - , indexingBenchmark "shift" shift - , indexingBenchmark "shiftL" shiftL - , indexingBenchmark "shiftR" shiftR - , indexingBenchmark "rotate" rotate - , indexingBenchmark "rotateL" rotateL - , indexingBenchmark "rotateR" rotateR - , indexingBenchmark "setBit" setBit - , indexingBenchmark "clearBit" clearBit - , indexingBenchmark "complementBit" complementBit - , indexingBenchmark "testBit" testBit - ] --} - - -finiteBitsBench :: Benchmark -finiteBitsBench = bgroup "FiniteBits" - [ unaryBenchmark "finiteBitSize" finiteBitSize - , unaryBenchmark "countLeadingZeros" countLeadingZeros - , unaryBenchmark "countTrailingZeros" countLeadingZeros - ] - - -hashableBench :: Benchmark -hashableBench = bgroup "Hashable" - [ unaryBenchmark "hash" hash - , indexingBenchmark' "hashWithSalt" (flip hashWithSalt) - ] - - -semigroupBench :: Benchmark -semigroupBench = bgroup "Semigroup" - [ binaryBenchmark "(<>)" (<>) - ] - - -monoFoldableBench :: Benchmark -monoFoldableBench = bgroup "MonoFoldable" - [ fold1Benchmark "ofoldr1Ex" ofoldr1Ex - , fold1Benchmark "ofoldl1Ex'" ofoldl1Ex' - , mapBenchmark "omap" omap - , queryBenchmark "oall" oall - , queryBenchmark "oany" oany - ] - - -constantNumberTimeBenchmark :: (NFData a, NFData b) => String -> (Natural -> a) -> (Natural -> a -> b) -> Benchmark -constantNumberTimeBenchmark label f g = bgroup label $ generateBenchmark <$> magicNumbers - where - generateBenchmark (intLabel, intValue) = bench intLabel $ nf app target - where - !target = force $ f intValue - !app = g intValue - - -unaryBenchmark :: NFData a => String -> (BitVector -> a) -> Benchmark -unaryBenchmark label f = bgroup label $ generateBenchmark <$> magicNumbers - where - generateBenchmark (intLabel, intValue) = bench intLabel $ nf f target - where - !target = bvGen intValue - - -binaryBenchmark :: NFData a => String -> (BitVector -> BitVector -> a) -> Benchmark -binaryBenchmark label op = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel1, intValue1, intLabel2, intValue2) = bench message $ nf id target - where - message = unwords [intLabel1, "`op`", intLabel2] - !lhs = bvGen intValue1 - !rhs = bvGen intValue2 - target = lhs `op` rhs - combinations = [ (a,b,c,d) | (a,b) <- magicNumbers, (c,d) <- magicNumbers, b < d ] - - -indexingBenchmark :: NFData a => (BitVector -> Int -> a) -> [a] +indexingBenchmark :: (BitVector -> Int -> a) -> [a] indexingBenchmark op = generateBenchmark <$> combinations - where - generateBenchmark (intValue, idxValue) = app target - where - !target = bvGen intValue - app = (`op` idxValue) + where + generateBenchmark (intValue, idxValue) = app target + where + !target = bvGen intValue + app = (`op` idxValue) - combinations = do - (_, b) <- magicNumbers - let bitCount = fromEnum $ logBase2Word b - (_, d) <- nubBy (\x y -> snd x == snd y) [("first", 0), ("middle", bitCount `div` 2), ("last", bitCount - 1)] - let e = force (b,d) - [e] + combinations = do + (_, b) <- magicNumbers + let bitCount = fromEnum $ logBase2Word b + (_, d) <- nubBy + (\x y -> snd x == snd y) + [("first", 0), ("middle", bitCount `div` 2), ("last", bitCount - 1)] + let e = force (b, d) + [e] -indexingBenchmarkW :: NFData a => (BitVector -> Word -> a) -> [a] +indexingBenchmarkW :: (BitVector -> Word -> a) -> [a] indexingBenchmarkW op = generateBenchmark <$> combinations - where - generateBenchmark (intValue, idxValue) = app target - where - !target = bvGen intValue - app = (`op` idxValue) - - combinations = do - (_, b) <- magicNumbers - let bitCount = fromEnum $ logBase2Word b - (_, d) <- nubBy (\x y -> snd x == snd y) [("first", 0), ("middle", bitCount `div` 2), ("last", bitCount - 1)] - let e = force (b, toEnum d) - [e] - - -fold1Benchmark :: String -> ((Bool -> Bool -> Bool) -> BitVector -> Bool) -> Benchmark -fold1Benchmark label fold1Fun = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target - where - message = unwords ["fold1", getBinaryLogicalSymbol lOp, intLabel] - !op = getBinaryLogicalOperator lOp - !bv = bvGen intValue - target = fold1Fun op bv - combinations = [ (a,b, op) | (a,b) <- magicNumbers, op <- [minBound .. maxBound] ] - - -mapBenchmark :: String -> ((Bool -> Bool) -> BitVector -> BitVector) -> Benchmark -mapBenchmark label mapFun = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target - where - message = unwords ["map", getUnaryLogicalSymbol lOp, intLabel] - !op = getUnaryLogicalOperator lOp - !bv = bvGen intValue - target = mapFun op bv - combinations = [ (a,b, op) | (a,b) <- magicNumbers, op <- [minBound .. maxBound] ] - + where + generateBenchmark (intValue, idxValue) = app target + where + !target = bvGen intValue + app = (`op` idxValue) -queryBenchmark :: String -> ((Bool -> Bool) -> BitVector -> Bool) -> Benchmark -queryBenchmark label mapFun = bgroup label $ generateBenchmark <$> combinations - where - generateBenchmark (intLabel, intValue, lOp) = bench message $ nf id target - where - message = unwords ["query", getUnaryLogicalSymbol lOp, intLabel] - !op = getUnaryLogicalOperator lOp - !bv = bvGen intValue - target = mapFun op bv - combinations = [ (a,b, op) | (a,b) <- magicNumbers, op <- [minBound .. maxBound] ] + combinations = do + (_, b) <- magicNumbers + let bitCount = fromEnum $ logBase2Word b + (_, d) <- nubBy + (\x y -> snd x == snd y) + [("first", 0), ("middle", bitCount `div` 2), ("last", bitCount - 1)] + let e = force (b, toEnum d) + [e] bvGen :: Natural -> BitVector @@ -294,12 +96,12 @@ magicNumbers :: [(String, Natural)] magicNumbers = - [ ("zero" , 0) - , ("tiny" , tinyNumber) - , ("small" , smallNumber) - , ("medium", mediumNumber) - , ("large" , largeNumber) - , ("huge" , hugeNumber) + [ ("zero" , 0) + , ("tiny" , tinyNumber) + , ("small" , smallNumber) + , ("medium" , mediumNumber) + , ("large" , largeNumber) + , ("huge" , hugeNumber) , ("colossal", colossalNumber) ] @@ -333,7 +135,8 @@ -- -- ceiling ( log_2 (pi * 10^100) ) === 334 largeNumber :: Natural -largeNumber = 31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679 +largeNumber = + 31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679 -- | @@ -341,10 +144,12 @@ -- -- ceiling ( log_2 (√2 * 10^200) ) === 665 hugeNumber :: Natural -hugeNumber = 14142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248360558507372126441214970999358314132226659275055927557999505011527820605715 +hugeNumber = + 14142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248360558507372126441214970999358314132226659275055927557999505011527820605715 -- | -- This number is colossal. colossalNumber :: Natural -colossalNumber = 1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989380952572010654858632788659361533818279682303019520353018529689957736225994138912497217752834791315155748572424541506959508295331168617278558890750983817546374649393192550604009277016711390098488240128583616035637076601047101819429555961989467678374494482553797747268471040475346462080466842590694912933136770289891521047521620569660240580381501935112533824300355876402474964732639141992726042699227967823547816360093417216412199245863150302861829745557067498385054945885869269956909272107975093029553211653449872027559602364806654991198818347977535663698074265425278625518184175746728909777727938000816470600161452491921732172147723501414419735685481613611573525521334757418494684385233239073941433345477624168625189835694855620992192221842725502542568876717904946016534668049886272327917860857843838279679766814541009538837863609506800642251252051173929848960841284886269456042419652850222106611863067442786220391949450471237137869609563643719172874677646575739624138908658326459958133904780275900994657640789512694683983525957098258226205224894077267194782684826014769909026401363944374553050682034962524517493996514314298091906592509372216964615157098583874105978859597729754989301617539284681382686838689427741559918559252459539594310499725246808459872736446958486538367362226260991246080512438843904512441365497627807977156914359977001296160894416948685558484063534220722258284886481584560285060168427394522674676788952521385225499546667278239864565961163548862305774564980355936345681743241125150760694794510965960940252288797108931456691368672287489405601015033086179286809208747609178249385890097149096759852613655497818931297848216829989487226588048575640142704775551323796414515237462343645428584447952658678210511413547357395231134271661021359695362314429524849371871101457654035902799344037420073105785390621983874478084784896833214457138687519435064302184531910484810053706146806749192781911979399520614196634287544406437451237181921799983910159195618146751426912397489409071864942319615679452080951465502252316038819301420937621378559566389377870830390697920773467221825625996615014215030680384477345492026054146659252014974428507325186660021324340881907104863317346496514539057962685610055081066587969981635747363840525714591028970641401109712062804390397595156771577004203378699360072305587631763594218731251471205329281918261861258673215791984148488291644706095752706957220917567116722910981690915280173506712748583222871835209353965725121083579151369882091444210067510334671103141267111369908658516398315019701651511685171437657618351556508849099898599823873455283316355076479185358932261854896321329330898570642046752590709154814165498594616371802709819943099244889575712828905923233260972997120844335732654893823911932597463667305836041428138830320382490375898524374417029132765618093773444030707469211201913020330380197621101100449293215160842444859637669838952286847831235526582131449576857262433441893039686426243410773226978028073189154411010446823252716201052652272111660396665573092547110557853763466820653109896526918620564769312570586356620185581007293606598764861179104533488503461136576867532494416680396265797877185560845529654126654085306143444318586769751456614068007002378776591344017127494704205622305389945613140711270004078547332699390814546646458807972708266830634328587856983052358089330657574067954571637752542021149557615814002501262285941302164715509792592309907965473761255176567513575178296664547791745011299614890304639947132962107340437518957359614589019389713111790429782856475032031986915140287080859904801094121472213179476477726224142548545403321571853061422881375850430633217518297986622371721591607716692547487389866549494501146540628433663937900397692656721463853067360965712091807638327166416274888800786925602902284721040317211860820419000422966171196377921337575114959501566049631862947265473642523081770367515906735023507283540567040386743513622224771589150495309844489333096340878076932599397805419341447377441842631298608099888687413260472156951623965864573021631598193195167353812974167729478672422924654366800980676928238280689964004824354037014163149658979409243237896907069779422362508221688957383798623001593776471651228935786015881617557829735233446042815126272037343146531977774160319906655418763979293344195215413418994854447345673831624993419131814809277771038638773431772075456545322077709212019051660962804909263601975988281613323166636528619326686336062735676303544776280350450777235547105859548702790814356240145171806246436267945612753181340783303362542327839449753824372058353114771199260638133467768796959703098339130771098704085913374641442822772634659470474587847787201927715280731767907707157213444730605700733492436931138350493163128404251219256517980694113528013147013047816437885185290928545201165839341965621349143415956258658655705526904965209858033850722426482939728584783163057777560688876446248246857926039535277348030480290058760758251047470916439613626760449256274204208320856611906254543372131535958450687724602901618766795240616342522577195429162991930645537799140373404328752628889639958794757291746426357455254079091451357111369410911939325191076020825202618798531887705842972591677813149699009019211697173727847684726860849003377024242916513005005168323364350389517029893922334517220138128069650117844087451960121228599371623130171144484640903890644954440061986907548516026327505298349187407866808818338510228334508504860825039302133219715518430635455007668282949304137765527939751754613953984683393638304746119966538581538420568533862186725233402830871123282789212507712629463229563989898935821167456270102183564622013496715188190973038119800497340723961036854066431939509790190699639552453005450580685501956730229219139339185680344903982059551002263535361920419947455385938102343955449597783779023742161727111723643435439478221818528624085140066604433258885698670543154706965747458550332323342107301545940516553790686627333799585115625784322988273723198987571415957811196358330059408730681216028764962867446047746491599505497374256269010490377819868359381465741268049256487985561453723478673303904688383436346553794986419270563872931748723320837601123029911367938627089438799362016295154133714248928307220126901475466847653576164773794675200490757155527819653621323926406160136358155907422020203187277605277219005561484255518792530343513984425322341576233610642506390497500865627109535919465897514131034822769306247435363256916078154781811528436679570611086153315044521274739245449454236828860613408414863776700961207151249140430272538607648236341433462351897576645216413767969031495019108575984423919862916421939949072362346468441173940326591840443780513338945257423995082965912285085558215725031071257012668302402929525220118726767562204154205161841634847565169998116141010029960783869092916030288400269104140792886215078424516709087000699282120660418371806535567252532567532861291042487761825829765157959847035622262934860034158722980534989650226291748788202734209222245339856264766914905562842503912757710284027998066365825488926488025456610172967026640765590429099456815065265305371829412703369313785178609040708667114965583434347693385781711386455873678123014587687126603489139095620099393610310291616152881384379099042317473363948045759314931405297634757481193567091101377517210080315590248530906692037671922033229094334676851422144773793937517034436619910403375111735471918550464490263655128162288244625759163330391072253837421821408835086573917715096828874782656995995744906617583441375223970968340800535598491754173818839994469748676265516582765848358845314277568790029095170283529716344562129640435231176006651012412006597558512761785838292041974844236080071930457618932349229279650198751872127267507981255470958904556357921221033346697499235630254947802490114195212382815309114079073860251522742995818072471625916685451333123948049470791191532673430282441860414263639548000448002670496248201792896476697583183271314251702969234889627668440323260927524960357996469256504936818360900323809293459588970695365349406034021665443755890045632882250545255640564482465151875471196218443965825337543885690941130315095261793780029741207665147939425902989695946995565761218656196733786236256125216320862869222103274889218654364802296780705765615144632046927906821207388377814233562823608963208068222468012248261177185896381409183903673672220888321513755600372798394004152970028783076670944474560134556417254370906979396122571429894671543578468788614445812314593571984922528471605049221242470141214780573455105008019086996033027634787081081754501193071412233908663938339529425786905076431006383519834389341596131854347546495569781038293097164651438407007073604112373599843452251610507027056235266012764848308407611830130527932054274628654036036745328651057065874882256981579367897669742205750596834408697350201410206723585020072452256326513410559240190274216248439140359989535394590944070469120914093870012645600162374288021092764579310657922955249887275846101264836999892256959688159205600101655256375678566722796619885782794848855834397518744545512965634434803966420557982936804352202770984294232533022576341807039476994159791594530069752148293366555661567873640053666564165473217043903521329543529169414599041608753201868379370234888689479151071637852902345292440773659495630510074210871426134974595615138498713757047101787957310422969066670214498637464595280824369445789772330048764765241339075920434019634039114732023380715095222010682563427471646024335440051521266932493419673977041595683753555166730273900749729736354964533288869844061196496162773449518273695588220757355176651589855190986665393549481068873206859907540792342402300925900701731960362254756478940647548346647760411463233905651343306844953979070903023460461470961696886885014083470405460742958699138296682468185710318879065287036650832431974404771855678934823089431068287027228097362480939962706074726455399253994428081137369433887294063079261595995462624629707062594845569034711972996409089418059534393251236235508134949004364278527138315912568989295196427287573946914272534366941532361004537304881985517065941217352462589548730167600298865925786628561249665523533829428785425340483083307016537228563559152534784459818313411290019992059813522051173365856407826484942764411376393866924803118364453698589175442647399882284621844900877769776312795722672655562596282542765318300134070922334365779160128093179401718598599933849235495640057099558561134980252499066984233017350358044081168552653117099570899427328709258487894436460050410892266917835258707859512983441729535195378855345737426085902908176515578039059464087350612322611200937310804854852635722825768203416050484662775045003126200800799804925485346941469775164932709504934639382432227188515974054702148289711177792376122578873477188196825462981268685817050740272550263329044976277894423621674119186269439650671515779586756482399391760426017633870454990176143641204692182370764887834196896861181558158736062938603810171215855272668300823834046564758804051380801633638874216371406435495561868964112282140753302655100424104896783528588290243670904887118190909494533144218287661810310073547705498159680772009474696134360928614849417850171807793068108546900094458995279424398139213505586422196483491512639012803832001097738680662877923971801461343244572640097374257007359210031541508936793008169980536520276007277496745840028362405346037263416554259027601834840306811381855105979705664007509426087885735796037324514146786703688098806097164258497595138069309449401515422221943291302173912538355915031003330325111749156969174502714943315155885403922164097229101129035521815762823283182342548326111912800928252561902052630163911477247331485739107775874425387611746578671169414776421441111263583553871361011023267987756410246824032264834641766369806637857681349204530224081972785647198396308781543221166912246415911776732253264335686146186545222681268872684459684424161078540167681420808850280054143613146230821025941737562389942075713627516745731891894562835257044133543758575342698699472547031656613991999682628247270641336222178923903176085428943733935618891651250424404008952719837873864805847268954624388234375178852014395600571048119498842390606136957342315590796703461491434478863604103182350736502778590897578272731305048893989009923913503373250855982655867089242612429473670193907727130706869170926462548423240748550366080136046689511840093668609546325002145852930950000907151058236267293264537382104938724996699339424685516483261134146110680267446637334375340764294026682973865220935701626384648528514903629320199199688285171839536691345222444708045923966028171565515656661113598231122506289058549145097157553900243931535190902107119457300243880176615035270862602537881797519478061013715004489917210022201335013106016391541589578037117792775225978742891917915522417189585361680594741234193398420218745649256443462392531953135103311476394911995072858430658361935369329699289837914941939406085724863968836903265564364216644257607914710869984315733749648835292769328220762947282381537409961545598798259891093717126218283025848112389011968221429457667580718653806506487026133892822994972574530332838963818439447707794022843598834100358385423897354243956475556840952248445541392394100016207693636846776413017819659379971557468541946334893748439129742391433659360410035234377706588867781139498616478747140793263858738624732889645643598774667638479466504074111825658378878454858148962961273998413442726086061872455452360643153710112746809778704464094758280348769758948328241239292960582948619196670918958089833201210318430340128495116203534280144127617285830243559830032042024512072872535581195840149180969253395075778400067465526031446167050827682772223534191102634163157147406123850425845988419907611287258059113935689601431668283176323567325417073420817332230462987992804908514094790368878687894930546955703072619009502076433493359106024545086453628935456862958531315337183868265617862273637169757741830239860065914816164049449650117321313895747062088474802365371031150898427992754426853277974311395143574172219759799359685252285745263796289612691572357986620573408375766873884266405990993505000813375432454635967504844235284874701443545419576258473564216198134073468541117668831186544893776979566517279662326714810338643913751865946730024434500544995399742372328712494834706044063471606325830649829795510109541836235030309453097335834462839476304775645015008507578949548931393944899216125525597701436858943585877526379625597081677643800125436502371412783467926101995585224717220177723700417808419423948725406801556035998390548985723546745642390585850216719031395262944554391316631345308939062046784387785054239390524731362012947691874975191011472315289326772533918146607300089027768963114810902209724520759167297007850580717186381054967973100167870850694207092232908070383263453452038027860990556900134137182368370991949516489600755049341267876436746384902063964019766685592335654639138363185745698147196210841080961884605456039038455343729141446513474940784884423772175154334260306698831768331001133108690421939031080143784334151370924353013677631084913516156422698475074303297167469640666531527035325467112667522460551199581831963763707617991919203579582007595605302346267757943936307463056901080114942714100939136913810725813781357894005599500183542511841721360557275221035268037357265279224173736057511278872181908449006178013889710770822931002797665935838758909395688148560263224393726562472776037890814458837855019702843779362407825052704875816470324581290878395232453237896029841669225489649715606981192186584926770403956481278102179913217416305810554598801300484562997651121241536374515005635070127815926714241342103301566165356024733807843028655257222753049998837015348793008062601809623815161366903341111386538510919367393835229345888322550887064507539473952043968079067086806445096986548801682874343786126453815834280753061845485903798217994599681154419742536344399602902510015888272164745006820704193761584547123183460072629339550548239557137256840232268213012476794522644820910235647752723082081063518899152692889108455571126603965034397896278250016110153235160519655904211844949907789992007329476905868577878720982901352956613978884860509786085957017731298155314951681467176959760994210036183559138777817698458758104466283998806006162298486169353373865787735983361613384133853684211978938900185295691967804554482858483701170967212535338758621582310133103877668272115726949518179589754693992642197915523385766231676275475703546994148929041301863861194391962838870543677743224276809132365449485366768000001065262485473055861598999140170769838548318875014293890899506854530765116803337322265175662207526951791442252808165171667766727930354851542040238174608923283917032754257508676551178593950027933895920576682789677644531840404185540104351348389531201326378369283580827193783126549617459970567450718332065034556644034490453627560011250184335607361222765949278393706478426456763388188075656121689605041611390390639601620221536849410926053876887148379895599991120991646464411918568277004574243434021672276445589330127781586869525069499364610175685060167145354315814801054588605645501332037586454858403240298717093480910556211671546848477803944756979804263180991756422809873998766973237695737015808068229045992123661689025962730430679316531149401764737693873514093361833216142802149763399189835484875625298752423873077559555955465196394401821840998412489826236737714672260616336432964063357281070788758164043814850188411431885988276944901193212968271588841338694346828590066640806314077757725705630729400492940302420498416565479736705485580445865720227637840466823379852827105784319753541795011347273625774080213476826045022851579795797647467022840999561601569108903845824502679265942055503958792298185264800706837650418365620945554346135134152570065974881916341359556719649654032187271602648593049039787489589066127250794828276938953521753621850796297785146188432719223223810158744450528665238022532843891375273845892384422535472653098171578447834215822327020690287232330053862163479885094695472004795231120150432932266282727632177908840087861480221475376578105819702226309717495072127248479478169572961423658595782090830733233560348465318730293026659645013718375428897557971449924654038681799213893469244741985097334626793321072686870768062639919361965044099542167627840914669856925715074315740793805323925239477557441591845821562518192155233709607483329234921034514626437449805596103307994145347784574699992128599999399612281615219314888769388022281083001986016549416542616968586788372609587745676182507275992950893180521872924610867639958916145855058397274209809097817293239301067663868240401113040247007350857828724627134946368531815469690466968693925472519413992914652423857762550047485295476814795467007050347999588867695016124972282040303995463278830695976249361510102436555352230690612949388599015734661023712235478911292547696176005047974928060721268039226911027772261025441492215765045081206771735712027180242968106203776578837166909109418074487814049075517820385653909910477594141321543284406250301802757169650820964273484146957263978842560084531214065935809041271135920041975985136254796160632288736181367373244506079244117639975974619383584574915988097667447093006546342423460634237474666080431701260052055928493695941434081468529815053947178900451835755154125223590590687264878635752541911288877371766374860276606349603536794702692322971868327717393236192007774522126247518698334951510198642698878471719396649769070825217423365662725928440620430214113719922785269984698847702323823840055655517889087661360130477098438611687052310553149162517283732728676007248172987637569816335415074608838663640693470437206688651275688266149730788657015685016918647488541679154596507234287730699853713904300266530783987763850323818215535597323530686043010675760838908627049841888595138091030423595782495143988590113185835840667472370297149785084145853085781339156270760356390763947311455495832266945702494139831634332378975955680856836297253867913275055542524491943589128405045226953812179131914513500993846311774017971512283785460116035955402864405902496466930707769055481028850208085800878115773817191741776017330738554758006056014337743299012728677253043182519757916792969965041460706645712588834697979642931622965520168797300035646304579308840327480771811555330909887025505207680463034608658165394876951960044084820659673794731680864156456505300498816164905788311543454850526600698230931577765003780704661264706021457505793270962047825615247145918965223608396645624105195510522357239739512881816405978591427914816542632892004281609136937773722299983327082082969955737727375667615527113922588055201898876201141680054687365580633471603734291703907986396522961312801782679717289822936070288069087768660593252746378405397691848082041021944719713869256084162451123980620113184541244782050110798760717155683154078865439041210873032402010685341947230476666721749869868547076781205124736792479193150856444775379853799732234456122785843296846647513336573692387201464723679427870042503255589926884349592876124007558756946413705625140011797133166207153715436006876477318675587148783989081074295309410605969443158477539700943988394914432353668539209946879645066533985738887866147629443414010498889931600512076781035886116602029611936396821349607501116498327856353161451684576956871090029997698412632665023477167286573785790857466460772283415403114415294188047825438761770790430001566986776795760909966936075594965152736349811896413043311662774712338817406037317439705406703109676765748695358789670031925866259410510533584384656023391796749267844763708474978333655579007384191473198862713525954625181604342253729962863267496824058060296421146386436864224724887283434170441573482481833301640566959668866769563491416328426414974533349999480002669987588815935073578151958899005395120853510357261373640343675347141048360175464883004078464167452167371904831096767113443494819262681110739948250607394950735031690197318521195526356325843390998224986240670310768318446607291248747540316179699411397387765899868554170318847788675929026070043212666179192235209382278788809886335991160819235355570464634911320859189796132791319756490976000139962344455350143464268604644958624769094347048293294140411146540923988344435159133201077394411184074107684981066347241048239358274019449356651610884631256785297769734684303061462418035852933159734583038455410337010916767763742762102137013548544509263071901147318485749233181672072137279355679528443925481560913728128406333039373562420016045664557414588166052166608738748047243391212955877763906969037078828527753894052460758496231574369171131761347838827194168606625721036851321566478001476752310393578606896111259960281839309548709059073861351914591819510297327875571049729011487171897180046961697770017913919613791417162707018958469214343696762927459109940060084983568425201915593703701011049747339493877885989417433031785348707603221982970579751191440510994235883034546353492349826883624043327267415540301619505680654180939409982020609994140216890900708213307230896621197755306659188141191577836272927461561857103721724710095214236964830864102592887457999322374955191221951903424452307535133806856807354464995127203174487195403976107308060269906258076020292731455252078079914184290638844373499681458273372072663917670201183004648190002413083508846584152148991276106513741539435657211390328574918769094413702090517031487773461652879848235338297260136110984514841823808120540996125274580881099486972216128524897425555516076371675054896173016809613803811914361143992106380050832140987604599309324851025168294467260666138151745712559754953580239983146982203613380828499356705575524712902745397762140493182014658008021566536067765508783804304134310591804606800834591136640834887408005741272586704792258319127415739080914383138456424150940849133918096840251163991936853225557338966953749026620923261318855891580832455571948453875628786128859004106006073746501402627824027346962528217174941582331749239683530136178653673760642166778137739951006589528877427662636841830680190804609849809469763667335662282915132352788806157768278159588669180238940333076441912403412022316368577860357276941541778826435238131905028087018575047046312933353757285386605888904583111450773942935201994321971171642235005644042979892081594307167019857469273848653833436145794634175922573898588001698014757420542995801242958105456510831046297282937584161162532562516572498078492099897990620035936509934721582965174135798491047111660791587436986541222348341887722929446335178653856731962559852026072947674072616767145573649812105677716893484917660771705277187601199908144113058645577910525684304811440261938402322470939249802933550731845890355397133088446174107959162511714864874468611247605428673436709046678468670274091881014249711149657817724279347070216688295610877794405048437528443375108828264771978540006509704033021862556147332117771174413350281608840351781452541964320309576018694649088681545285621346988355444560249556668436602922195124830910605377201980218310103270417838665447181260397190688462370857518080035327047185659499476124248110999288679158969049563947624608424065930948621507690314987020673533848349550836366017848771060809804269247132410009464014373603265645184566792456669551001502298330798496079949882497061723674493612262229617908143114146609412341593593095854079139087208322733549572080757165171876599449856937956238755516175754380917805280294642004472153962807463602113294255916002570735628126387331060058910652457080244749375431841494014821199962764531068006631183823761639663180931444671298615527598201451410275600689297502463040173514891945763607893528555053173314164570504996443890936308438744847839616840518452732884032345202470568516465716477139323775517294795126132398229602394548579754586517458787713318138752959809412174227300352296508089177705068259248822322154938048371454781647213976820963320508305647920482085920475499857320388876391601995240918938945576768749730856955958010659526503036266159750662225084067428898265907510637563569968211510949669744580547288693631020367823250182323708459790111548472087618212477813266330412076216587312970811230758159821248639807212407868878114501655825136178903070860870198975889807456643955157415363193191981070575336633738038272152798849350397480015890519420879711308051233933221903466249917169150948541401871060354603794643379005890957721180804465743962806186717861017156740967662080295766577051291209907944304632892947306159510430902221439371849560634056189342513057268291465783293340524635028929175470872564842600349629611654138230077313327298305001602567240141851520418907011542885799208121984493156999059182011819733500126187728036812481995877070207532406361259313438595542547781961142935163561223496661522614735399674051584998603552953329245752388810136202347624669055816438967863097627365504724348643071218494373485300606387644566272186661701238127715621379746149861328744117714552444708997144522885662942440230184791205478498574521634696448973892062401943518310088283480249249085403077863875165911302873958787098100772718271874529013972836614842142871705531796543076504534324600536361472618180969976933486264077435199928686323835088756683595097265574815431940195576850437248001020413749831872259677387154958399718444907279141965845930083942637020875635398216962055324803212267498911402678528599673405242031091797899905718821949391320753431707980023736590985375520238911643467185582906853711897952626234492483392496342449714656846591248918556629589329909035239233333647435203707701010843880032907598342170185542283861617210417603011645918780539367447472059985023582891833692922337323999480437108419659473162654825748099482509991833006976569367159689364493348864744213500840700660883597235039532340179582557036016936990988671132109798897070517280755855191269930673099250704070245568507786790694766126298082251633136399521170984528092630375922426742575599892892783704744452189363203489415521044597261883800300677617931381399162058062701651024458869247649246891924612125310275731390840470007143561362316992371694848132554200914530410371354532966206392105479824392125172540132314902740585892063217589494345489068463993137570910346332714153162232805522972979538018801628590735729554162788676498274186164218789885741071649069191851162815285486794173638906653885764229158342500673612453849160674137340173572779956341043326883569507814931378007362354180070619180267328551191942676091221035987469241172837493126163395001239599240508454375698507957046222664619000103500490183034153545842833764378111988556318777792537201166718539541835984438305203762819440761594106820716970302285152250573126093046898423433152732131361216582808075212631547730604423774753505952287174402666389148817173086436111389069420279088143119448799417154042103412190847094080254023932942945493878640230512927119097513536000921971105412096683111516328705423028470073120658032626417116165957613272351566662536672718998534199895236884830999302757419916463841427077988708874229277053891227172486322028898425125287217826030500994510824783572905691988555467886079462805371227042466543192145281760741482403827835829719301017888345674167811398954750448339314689630763396657226727043393216745421824557062524797219978668542798977992339579057581890622525473582205236424850783407110144980478726691990186438822932305382318559732869780922253529591017341407334884761005564018242392192695062083183814546983923664613639891012102177095976704908305081854704194664371312299692358895384930136356576186106062228705599423371631021278457446463989738188566746260879482018647487672727222062676465338099801966883680994159075776852639865146253336312450536402610569605513183813174261184420189088853196356986962795036738424313011331753305329802016688817481342988681585577810343231753064784983210629718425184385534427620128234570716988530518326179641178579608888150329602290705614476220915094739035946646916235396809201394578175891088931992112260073928149169481615273842736264298098234063200244024495894456129167049508235812487391799648641133480324757775219708932772262349486015046652681439877051615317026696929704928316285504212898146706195331970269507214378230476875280287354126166391708245925170010714180854800636923259462019002278087409859771921805158532147392653251559035410209284665925299914353791825314545290598415817637058927906909896911164381187809435371521332261443625314490127454772695739393481546916311624928873574718824071503995009446731954316193855485207665738825139639163576723151005556037263394867208207808653734942440115799667507360711159351331959197120948964717553024531364770942094635696982226673775209945168450643623824211853534887989395673187806606107885440005508276570305587448541805778891719207881423351138662929667179643468760077047999537883387870348718021842437342112273940255717690819603092018240188427057046092622564178375265263358324240661253311529423457965569502506810018310900411245379015332966156970522379210325706937051090830789479999004999395322153622748476603613677697978567386584670936679588583788795625946464891376652199588286933801836011932368578558558195556042156250883650203322024513762158204618106705195330653060606501054887167245377942831338871631395596905832083416898476065607118347136218123246227258841990286142087284956879639325464285343075301105285713829643709990356948885285190402956047346131138263878897551788560424998748316382804046848618938189590542039889872650697620201995548412650005394428203930127481638158530396439925470201672759328574366661644110962566337305409219519675148328734808957477775278344221091073111351828046036347198185655572957144747682552857863349342858423118749440003229690697758315903858039353521358860079600342097547392296733310649395601812237812854584317605561733861126734780745850676063048229409653041118306671081893031108871728167519579675347188537229309616143204006381322465841111157758358581135018569047815368938137718472814751998350504781297718599084707621974605887423256995828892535041937958260616211842368768511418316068315867994601652057740529423053601780313357263267054790338401257305912339601880137825421927094767337191987287385248057421248921183470876629667207272325650565129333126059505777727542471241648312832982072361750574673870128209575544305968395555686861188397135522084452852640081252027665557677495969626612604565245684086139238265768583384698499778726706555191854468698469478495734622606294219624557085371272776523098955450193037732166649182578154677292005212667143463209637891852323215018976126034373684067194193037746880999296877582441047878123266253181845960453853543839114496775312864260925211537673258866722604042523491087026958099647595805794663973419064010036361904042033113579336542426303561457009011244800890020801478056603710154122328891465722393145076071670643556827437743965789067972687438473076346451677562103098604092717090951280863090297385044527182892749689212106670081648583395537735919136950153162018908887484210798706899114804669270650940762046502772528650728905328548561433160812693005693785417861096969202538865034577183176686885923681488475276498468821949739729707737187188400414323127636504814531122850990020742409255859252926103021067368154347015252348786351643976235860419194129697690405264832347009911154242601273438022089331096686367898694977994001260164227609260823493041180643829138347354679725399262338791582998486459271734059225620749105308531537182911681637219395188700957788181586850464507699343940987433514431626330317247747486897918209239480833143970840673084079589358108966564775859905563769525232653614424780230826811831037735887089240613031336477371011628214614661679404090518615260360092521947218890918107335871964142144478654899528582343947050079830388538860831035719306002771194558021911942899922722353458707566246926177663178855144350218287026685610665003531050216318206017609217984684936863161293727951873078972637353717150256378733579771808184878458866504335824377004147710414934927438457587107159731559439426412570270965125108115548247939403597681188117282472158250109496096625393395380922195591918188552678062149923172763163218339896938075616855911752998450132067129392404144593862398809381240452191484831646210147389182510109096773869066404158973610476436500068077105656718486281496371118832192445663945814491486165500495676982690308911185687986929470513524816091743243015383684707292898982846022237301452655679898627767968091469798378268764311598832109043715611299766521539635464420869197567370005738764978437686287681792497469438427465256316323005551304174227341646455127812784577772457520386543754282825671412885834544435132562054464241011037955464190581168623059644769587054072141985212106734332410756767575818456990693046047522770167005684543969234041711089888993416350585157887353430815520811772071880379104046983069578685473937656433631979786803671873079693924236321448450354776315670255390065423117920153464977929066241508328858395290542637687668968805033317227800185885069736232403894700471897619347344308437443759925034178807972235859134245813144049847701732361694719765715353197754997162785663119046912609182591249890367654176979903623755286526375733763526969344354400473067198868901968147428767790866979688522501636949856730217523132529265375896415171479559538784278499866456302878831962099830494519874396369070682762657485810439112232618794059941554063270131989895703761105323606298674803779153767511583043208498720920280929752649812569163425000522908872646925284666104665392171482080130502298052637836426959733707053922789153510568883938113249757071331029504430346715989448786847116438328050692507766274500122003526203709466023414648998390252588830148678162196775194583167718762757200505439794412459900771152051546199305098386982542846407255540927403132571632640792934183342147090412542533523248021932277075355546795871638358750181593387174236061551171013123525633485820365146141870049205704372018261733194715700867578539336078622739558185797587258744102542077105475361294047460100094095444959662881486915903899071865980563617137692227290764197755177720104276496949611056220592502420217704269622154958726453989227697660310524980855759471631075870133208861463266412591148633881220284440694169488261529577625325019870359870674380469821942056381255833436421949232275937221289056420943082352544084110864545369404969271494003319782861318186188811118408257865928757426384450059944229568586460481033015388911499486935436030221810943466764000022362550573631294626296096198760564259963946138692330837196265954739234624134597795748524647837980795693198650815977675350553918991151335252298736112779182748542008689539658359421963331502869561192012298889887006079992795411188269023078913107603617634779489432032102773359416908650071932804017163840644987871753756781185321328408216571107549528294974936214608215583205687232185574065161096274874375098092230211609982633033915469494644491004515280925089745074896760324090768983652940657920198315265410658136823791984090645712468948470209357761193139980246813405200394781949866202624008902150166163813538381515037735022966074627952910384068685569070157516624192987244482719429331004854824454580718897633003232525821581280327467962002814762431828622171054352898348208273451680186131719593324711074662228508710666117703465352839577625997744672185715816126411143271794347885990892808486694914139097716736900277758502686646540565950394867841110790116104008572744562938425494167594605487117235946429105850909950214958793112196135908315882620682332156153086833730838173279328196983875087083483880463884784418840031847126974543709373298362402875197920802321878744882872843727378017827008058782410749357514889978911739746129320351081432703251409030487462262942344327571260086642508333187688650756429271605525289544921537651751492196367181049435317858383453865255656640657251363575064353236508936790431702597878177190314867963840828810209461490079715137717099061954969640070867667102330048672631475510537231757114322317411411680622864206388906210192355223546711662137499693269321737043105987225039456574924616978260970253359475020913836673772894438696400028110344026084712899000746807764844088711341352503367877316797709372778682166117865344231732264637847697875144332095340001650692130546476890985050203015044880834261845208730530973189492916425322933612431514306578264070283898409841602950309241897120971601649265613413433422298827909921786042679812457285345801338260995877178113102167340256562744007296834066198480676615805021691833723680399027931606420436812079900316264449146190219458229690992122788553948783538305646864881655562294315673128274390826450611628942803501661336697824051770155219626522725455850738640585299830379180350432876703809252167907571204061237596327685674845079151147313440001832570344920909712435809447900462494313455028900680648704293534037436032625820535790118395649089354345101342969617545249573960621490288728932792520696535386396443225388327522499605986974759882329916263545973324445163755334377492928990581175786355555626937426910947117002165411718219750519831787137106051063795558588905568852887989084750915764639074693619881507814685262133252473837651192990156109189777922008705793396463827490680698769168197492365624226087154176100430608904377976678519661891404144925270480881971498801542057787006521594009289777601330756847966992955433656139847738060394368895887646054983871478968482805384701730871117761159663505039979343869339119789887109156541709133082607647406305711411098839388095481437828474528838368079418884342666222070438722887413947801017721392281911992365405516395893474263953824829609036900288359327745855060801317988407162446563997948275783650195514221551339281978226984278638391679715091262410548725700924070045488485692950448110738087996547481568913935380943474556972128919827177020766613602489581468119133614121258783895577357194986317210844398901423948496659251731388171602663261931065366535041473070804414939169363262373767777095850313255990095762731957308648042467701212327020533742667053142448208168130306397378736642483672539837487690980602182785786216512738563513290148903509883270617258932575363993979055729175160097615459044771692265806315111028038436017374742152476085152099016158582312571590733421736576267142390478279587281505095633092802668458937649649770232973641319060982740633531089792464242134583740901169391964250459128813403498810635400887596820054408364386516617880557608956896727531538081942077332597917278437625661184319891025007491829086475149794003160703845549465385946027452447466812314687943441610993338908992638411847425257044572517459325738989565185716575961481266020310797628254165590506042479114016957900338356574869252800743025623419498286467914476322774005529460903940177536335655471931000175430047504719144899841040015867946179241610016454716551337074073950260442769538553834397550548871099785205401175169747581344926079433689543783221172450687344231989878844128542064742809735625807066983106979935260693392135685881391214807354728463227784908087002467776303605551232386656295178853719673034634701222939581606792509153217489030840886516061119011498443412350124646928028805996134283511884715449771278473361766285062169778717743824362565711779450064477718370221999106695021656757644044997940765037999954845002710665987813603802314126836905783190460792765297277694043613023051787080546511542469395265127101052927070306673024447125973939950514628404767431363739978259184541176413327906460636584152927019030276017339474866960348694976541752429306040727005059039503148522921392575594845078867977925253931765156416197168443524369794447355964260633391055126826061595726217036698506473281266724521989060549880280782881429796336696744124805982192146339565745722102298677599746738126069367069134081559412016115960190237753525556300606247983261249881288192937343476862689219239777833910733106588256813777172328315329082525092733047850724977139448333892552081175608452966590553940965568541706001179857293813998258319293679100391844099286575605993598910002969864460974714718470101531283762631146774209145574041815908800064943237855839308530828305476076799524357391631221886057549673832243195650655460852881201902363644712703748634421727257879503428486312944916318475347531435041392096108796057730987201352484075057637199253650470908582513936863463863368042891767107602111159828875539940120076013947033661793715396306139863655492213741597905119083588290097656647300733879314678913181465109316761575821351424860442292445304113160652700974330088499034675405518640677342603583409608605533747362760935658853109760994238347382222087292464497684560579562516765574088410321731345627735856052358236389532038534024842273371639123973215995440828421666636023296545694703577184873442034227706653837387506169212768015766181095420097708363604361110592409117889540338021426523948929686439808926114635414571535194342850721353453018315875628275733898268898523557799295727645229391567477566676051087887648453493636068278050564622813598885879259940946446041705204470046315137975431737187756039815962647501410906658866162180038266989961965580587208639721176995219466789857011798332440601811575658074284182910615193917630059194314434605154047710570054339000182453117733718955857603607182860506356479979004139761808955363669603162193113250223851791672055180659263518036251214575926238369348222665895576994660491938112486609099798128571823494006615552196112207203092277646200999315244273589488710576623894693889446495093960330454340842102462401048723328750081749179875543879387381439894238011762700837196053094383940063756116458560943129517597713935396074322792489221267045808183313764165818269562105872892447740035947009268662659651422050630078592002488291860839743732353849083964326147000532423540647042089499210250404726781059083644007466380020870126664209457181702946752278540074508552377720890581683918446592829417018288233014971554235235911774818 +colossalNumber = + 1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989380952572010654858632788659361533818279682303019520353018529689957736225994138912497217752834791315155748572424541506959508295331168617278558890750983817546374649393192550604009277016711390098488240128583616035637076601047101819429555961989467678374494482553797747268471040475346462080466842590694912933136770289891521047521620569660240580381501935112533824300355876402474964732639141992726042699227967823547816360093417216412199245863150302861829745557067498385054945885869269956909272107975093029553211653449872027559602364806654991198818347977535663698074265425278625518184175746728909777727938000816470600161452491921732172147723501414419735685481613611573525521334757418494684385233239073941433345477624168625189835694855620992192221842725502542568876717904946016534668049886272327917860857843838279679766814541009538837863609506800642251252051173929848960841284886269456042419652850222106611863067442786220391949450471237137869609563643719172874677646575739624138908658326459958133904780275900994657640789512694683983525957098258226205224894077267194782684826014769909026401363944374553050682034962524517493996514314298091906592509372216964615157098583874105978859597729754989301617539284681382686838689427741559918559252459539594310499725246808459872736446958486538367362226260991246080512438843904512441365497627807977156914359977001296160894416948685558484063534220722258284886481584560285060168427394522674676788952521385225499546667278239864565961163548862305774564980355936345681743241125150760694794510965960940252288797108931456691368672287489405601015033086179286809208747609178249385890097149096759852613655497818931297848216829989487226588048575640142704775551323796414515237462343645428584447952658678210511413547357395231134271661021359695362314429524849371871101457654035902799344037420073105785390621983874478084784896833214457138687519435064302184531910484810053706146806749192781911979399520614196634287544406437451237181921799983910159195618146751426912397489409071864942319615679452080951465502252316038819301420937621378559566389377870830390697920773467221825625996615014215030680384477345492026054146659252014974428507325186660021324340881907104863317346496514539057962685610055081066587969981635747363840525714591028970641401109712062804390397595156771577004203378699360072305587631763594218731251471205329281918261861258673215791984148488291644706095752706957220917567116722910981690915280173506712748583222871835209353965725121083579151369882091444210067510334671103141267111369908658516398315019701651511685171437657618351556508849099898599823873455283316355076479185358932261854896321329330898570642046752590709154814165498594616371802709819943099244889575712828905923233260972997120844335732654893823911932597463667305836041428138830320382490375898524374417029132765618093773444030707469211201913020330380197621101100449293215160842444859637669838952286847831235526582131449576857262433441893039686426243410773226978028073189154411010446823252716201052652272111660396665573092547110557853763466820653109896526918620564769312570586356620185581007293606598764861179104533488503461136576867532494416680396265797877185560845529654126654085306143444318586769751456614068007002378776591344017127494704205622305389945613140711270004078547332699390814546646458807972708266830634328587856983052358089330657574067954571637752542021149557615814002501262285941302164715509792592309907965473761255176567513575178296664547791745011299614890304639947132962107340437518957359614589019389713111790429782856475032031986915140287080859904801094121472213179476477726224142548545403321571853061422881375850430633217518297986622371721591607716692547487389866549494501146540628433663937900397692656721463853067360965712091807638327166416274888800786925602902284721040317211860820419000422966171196377921337575114959501566049631862947265473642523081770367515906735023507283540567040386743513622224771589150495309844489333096340878076932599397805419341447377441842631298608099888687413260472156951623965864573021631598193195167353812974167729478672422924654366800980676928238280689964004824354037014163149658979409243237896907069779422362508221688957383798623001593776471651228935786015881617557829735233446042815126272037343146531977774160319906655418763979293344195215413418994854447345673831624993419131814809277771038638773431772075456545322077709212019051660962804909263601975988281613323166636528619326686336062735676303544776280350450777235547105859548702790814356240145171806246436267945612753181340783303362542327839449753824372058353114771199260638133467768796959703098339130771098704085913374641442822772634659470474587847787201927715280731767907707157213444730605700733492436931138350493163128404251219256517980694113528013147013047816437885185290928545201165839341965621349143415956258658655705526904965209858033850722426482939728584783163057777560688876446248246857926039535277348030480290058760758251047470916439613626760449256274204208320856611906254543372131535958450687724602901618766795240616342522577195429162991930645537799140373404328752628889639958794757291746426357455254079091451357111369410911939325191076020825202618798531887705842972591677813149699009019211697173727847684726860849003377024242916513005005168323364350389517029893922334517220138128069650117844087451960121228599371623130171144484640903890644954440061986907548516026327505298349187407866808818338510228334508504860825039302133219715518430635455007668282949304137765527939751754613953984683393638304746119966538581538420568533862186725233402830871123282789212507712629463229563989898935821167456270102183564622013496715188190973038119800497340723961036854066431939509790190699639552453005450580685501956730229219139339185680344903982059551002263535361920419947455385938102343955449597783779023742161727111723643435439478221818528624085140066604433258885698670543154706965747458550332323342107301545940516553790686627333799585115625784322988273723198987571415957811196358330059408730681216028764962867446047746491599505497374256269010490377819868359381465741268049256487985561453723478673303904688383436346553794986419270563872931748723320837601123029911367938627089438799362016295154133714248928307220126901475466847653576164773794675200490757155527819653621323926406160136358155907422020203187277605277219005561484255518792530343513984425322341576233610642506390497500865627109535919465897514131034822769306247435363256916078154781811528436679570611086153315044521274739245449454236828860613408414863776700961207151249140430272538607648236341433462351897576645216413767969031495019108575984423919862916421939949072362346468441173940326591840443780513338945257423995082965912285085558215725031071257012668302402929525220118726767562204154205161841634847565169998116141010029960783869092916030288400269104140792886215078424516709087000699282120660418371806535567252532567532861291042487761825829765157959847035622262934860034158722980534989650226291748788202734209222245339856264766914905562842503912757710284027998066365825488926488025456610172967026640765590429099456815065265305371829412703369313785178609040708667114965583434347693385781711386455873678123014587687126603489139095620099393610310291616152881384379099042317473363948045759314931405297634757481193567091101377517210080315590248530906692037671922033229094334676851422144773793937517034436619910403375111735471918550464490263655128162288244625759163330391072253837421821408835086573917715096828874782656995995744906617583441375223970968340800535598491754173818839994469748676265516582765848358845314277568790029095170283529716344562129640435231176006651012412006597558512761785838292041974844236080071930457618932349229279650198751872127267507981255470958904556357921221033346697499235630254947802490114195212382815309114079073860251522742995818072471625916685451333123948049470791191532673430282441860414263639548000448002670496248201792896476697583183271314251702969234889627668440323260927524960357996469256504936818360900323809293459588970695365349406034021665443755890045632882250545255640564482465151875471196218443965825337543885690941130315095261793780029741207665147939425902989695946995565761218656196733786236256125216320862869222103274889218654364802296780705765615144632046927906821207388377814233562823608963208068222468012248261177185896381409183903673672220888321513755600372798394004152970028783076670944474560134556417254370906979396122571429894671543578468788614445812314593571984922528471605049221242470141214780573455105008019086996033027634787081081754501193071412233908663938339529425786905076431006383519834389341596131854347546495569781038293097164651438407007073604112373599843452251610507027056235266012764848308407611830130527932054274628654036036745328651057065874882256981579367897669742205750596834408697350201410206723585020072452256326513410559240190274216248439140359989535394590944070469120914093870012645600162374288021092764579310657922955249887275846101264836999892256959688159205600101655256375678566722796619885782794848855834397518744545512965634434803966420557982936804352202770984294232533022576341807039476994159791594530069752148293366555661567873640053666564165473217043903521329543529169414599041608753201868379370234888689479151071637852902345292440773659495630510074210871426134974595615138498713757047101787957310422969066670214498637464595280824369445789772330048764765241339075920434019634039114732023380715095222010682563427471646024335440051521266932493419673977041595683753555166730273900749729736354964533288869844061196496162773449518273695588220757355176651589855190986665393549481068873206859907540792342402300925900701731960362254756478940647548346647760411463233905651343306844953979070903023460461470961696886885014083470405460742958699138296682468185710318879065287036650832431974404771855678934823089431068287027228097362480939962706074726455399253994428081137369433887294063079261595995462624629707062594845569034711972996409089418059534393251236235508134949004364278527138315912568989295196427287573946914272534366941532361004537304881985517065941217352462589548730167600298865925786628561249665523533829428785425340483083307016537228563559152534784459818313411290019992059813522051173365856407826484942764411376393866924803118364453698589175442647399882284621844900877769776312795722672655562596282542765318300134070922334365779160128093179401718598599933849235495640057099558561134980252499066984233017350358044081168552653117099570899427328709258487894436460050410892266917835258707859512983441729535195378855345737426085902908176515578039059464087350612322611200937310804854852635722825768203416050484662775045003126200800799804925485346941469775164932709504934639382432227188515974054702148289711177792376122578873477188196825462981268685817050740272550263329044976277894423621674119186269439650671515779586756482399391760426017633870454990176143641204692182370764887834196896861181558158736062938603810171215855272668300823834046564758804051380801633638874216371406435495561868964112282140753302655100424104896783528588290243670904887118190909494533144218287661810310073547705498159680772009474696134360928614849417850171807793068108546900094458995279424398139213505586422196483491512639012803832001097738680662877923971801461343244572640097374257007359210031541508936793008169980536520276007277496745840028362405346037263416554259027601834840306811381855105979705664007509426087885735796037324514146786703688098806097164258497595138069309449401515422221943291302173912538355915031003330325111749156969174502714943315155885403922164097229101129035521815762823283182342548326111912800928252561902052630163911477247331485739107775874425387611746578671169414776421441111263583553871361011023267987756410246824032264834641766369806637857681349204530224081972785647198396308781543221166912246415911776732253264335686146186545222681268872684459684424161078540167681420808850280054143613146230821025941737562389942075713627516745731891894562835257044133543758575342698699472547031656613991999682628247270641336222178923903176085428943733935618891651250424404008952719837873864805847268954624388234375178852014395600571048119498842390606136957342315590796703461491434478863604103182350736502778590897578272731305048893989009923913503373250855982655867089242612429473670193907727130706869170926462548423240748550366080136046689511840093668609546325002145852930950000907151058236267293264537382104938724996699339424685516483261134146110680267446637334375340764294026682973865220935701626384648528514903629320199199688285171839536691345222444708045923966028171565515656661113598231122506289058549145097157553900243931535190902107119457300243880176615035270862602537881797519478061013715004489917210022201335013106016391541589578037117792775225978742891917915522417189585361680594741234193398420218745649256443462392531953135103311476394911995072858430658361935369329699289837914941939406085724863968836903265564364216644257607914710869984315733749648835292769328220762947282381537409961545598798259891093717126218283025848112389011968221429457667580718653806506487026133892822994972574530332838963818439447707794022843598834100358385423897354243956475556840952248445541392394100016207693636846776413017819659379971557468541946334893748439129742391433659360410035234377706588867781139498616478747140793263858738624732889645643598774667638479466504074111825658378878454858148962961273998413442726086061872455452360643153710112746809778704464094758280348769758948328241239292960582948619196670918958089833201210318430340128495116203534280144127617285830243559830032042024512072872535581195840149180969253395075778400067465526031446167050827682772223534191102634163157147406123850425845988419907611287258059113935689601431668283176323567325417073420817332230462987992804908514094790368878687894930546955703072619009502076433493359106024545086453628935456862958531315337183868265617862273637169757741830239860065914816164049449650117321313895747062088474802365371031150898427992754426853277974311395143574172219759799359685252285745263796289612691572357986620573408375766873884266405990993505000813375432454635967504844235284874701443545419576258473564216198134073468541117668831186544893776979566517279662326714810338643913751865946730024434500544995399742372328712494834706044063471606325830649829795510109541836235030309453097335834462839476304775645015008507578949548931393944899216125525597701436858943585877526379625597081677643800125436502371412783467926101995585224717220177723700417808419423948725406801556035998390548985723546745642390585850216719031395262944554391316631345308939062046784387785054239390524731362012947691874975191011472315289326772533918146607300089027768963114810902209724520759167297007850580717186381054967973100167870850694207092232908070383263453452038027860990556900134137182368370991949516489600755049341267876436746384902063964019766685592335654639138363185745698147196210841080961884605456039038455343729141446513474940784884423772175154334260306698831768331001133108690421939031080143784334151370924353013677631084913516156422698475074303297167469640666531527035325467112667522460551199581831963763707617991919203579582007595605302346267757943936307463056901080114942714100939136913810725813781357894005599500183542511841721360557275221035268037357265279224173736057511278872181908449006178013889710770822931002797665935838758909395688148560263224393726562472776037890814458837855019702843779362407825052704875816470324581290878395232453237896029841669225489649715606981192186584926770403956481278102179913217416305810554598801300484562997651121241536374515005635070127815926714241342103301566165356024733807843028655257222753049998837015348793008062601809623815161366903341111386538510919367393835229345888322550887064507539473952043968079067086806445096986548801682874343786126453815834280753061845485903798217994599681154419742536344399602902510015888272164745006820704193761584547123183460072629339550548239557137256840232268213012476794522644820910235647752723082081063518899152692889108455571126603965034397896278250016110153235160519655904211844949907789992007329476905868577878720982901352956613978884860509786085957017731298155314951681467176959760994210036183559138777817698458758104466283998806006162298486169353373865787735983361613384133853684211978938900185295691967804554482858483701170967212535338758621582310133103877668272115726949518179589754693992642197915523385766231676275475703546994148929041301863861194391962838870543677743224276809132365449485366768000001065262485473055861598999140170769838548318875014293890899506854530765116803337322265175662207526951791442252808165171667766727930354851542040238174608923283917032754257508676551178593950027933895920576682789677644531840404185540104351348389531201326378369283580827193783126549617459970567450718332065034556644034490453627560011250184335607361222765949278393706478426456763388188075656121689605041611390390639601620221536849410926053876887148379895599991120991646464411918568277004574243434021672276445589330127781586869525069499364610175685060167145354315814801054588605645501332037586454858403240298717093480910556211671546848477803944756979804263180991756422809873998766973237695737015808068229045992123661689025962730430679316531149401764737693873514093361833216142802149763399189835484875625298752423873077559555955465196394401821840998412489826236737714672260616336432964063357281070788758164043814850188411431885988276944901193212968271588841338694346828590066640806314077757725705630729400492940302420498416565479736705485580445865720227637840466823379852827105784319753541795011347273625774080213476826045022851579795797647467022840999561601569108903845824502679265942055503958792298185264800706837650418365620945554346135134152570065974881916341359556719649654032187271602648593049039787489589066127250794828276938953521753621850796297785146188432719223223810158744450528665238022532843891375273845892384422535472653098171578447834215822327020690287232330053862163479885094695472004795231120150432932266282727632177908840087861480221475376578105819702226309717495072127248479478169572961423658595782090830733233560348465318730293026659645013718375428897557971449924654038681799213893469244741985097334626793321072686870768062639919361965044099542167627840914669856925715074315740793805323925239477557441591845821562518192155233709607483329234921034514626437449805596103307994145347784574699992128599999399612281615219314888769388022281083001986016549416542616968586788372609587745676182507275992950893180521872924610867639958916145855058397274209809097817293239301067663868240401113040247007350857828724627134946368531815469690466968693925472519413992914652423857762550047485295476814795467007050347999588867695016124972282040303995463278830695976249361510102436555352230690612949388599015734661023712235478911292547696176005047974928060721268039226911027772261025441492215765045081206771735712027180242968106203776578837166909109418074487814049075517820385653909910477594141321543284406250301802757169650820964273484146957263978842560084531214065935809041271135920041975985136254796160632288736181367373244506079244117639975974619383584574915988097667447093006546342423460634237474666080431701260052055928493695941434081468529815053947178900451835755154125223590590687264878635752541911288877371766374860276606349603536794702692322971868327717393236192007774522126247518698334951510198642698878471719396649769070825217423365662725928440620430214113719922785269984698847702323823840055655517889087661360130477098438611687052310553149162517283732728676007248172987637569816335415074608838663640693470437206688651275688266149730788657015685016918647488541679154596507234287730699853713904300266530783987763850323818215535597323530686043010675760838908627049841888595138091030423595782495143988590113185835840667472370297149785084145853085781339156270760356390763947311455495832266945702494139831634332378975955680856836297253867913275055542524491943589128405045226953812179131914513500993846311774017971512283785460116035955402864405902496466930707769055481028850208085800878115773817191741776017330738554758006056014337743299012728677253043182519757916792969965041460706645712588834697979642931622965520168797300035646304579308840327480771811555330909887025505207680463034608658165394876951960044084820659673794731680864156456505300498816164905788311543454850526600698230931577765003780704661264706021457505793270962047825615247145918965223608396645624105195510522357239739512881816405978591427914816542632892004281609136937773722299983327082082969955737727375667615527113922588055201898876201141680054687365580633471603734291703907986396522961312801782679717289822936070288069087768660593252746378405397691848082041021944719713869256084162451123980620113184541244782050110798760717155683154078865439041210873032402010685341947230476666721749869868547076781205124736792479193150856444775379853799732234456122785843296846647513336573692387201464723679427870042503255589926884349592876124007558756946413705625140011797133166207153715436006876477318675587148783989081074295309410605969443158477539700943988394914432353668539209946879645066533985738887866147629443414010498889931600512076781035886116602029611936396821349607501116498327856353161451684576956871090029997698412632665023477167286573785790857466460772283415403114415294188047825438761770790430001566986776795760909966936075594965152736349811896413043311662774712338817406037317439705406703109676765748695358789670031925866259410510533584384656023391796749267844763708474978333655579007384191473198862713525954625181604342253729962863267496824058060296421146386436864224724887283434170441573482481833301640566959668866769563491416328426414974533349999480002669987588815935073578151958899005395120853510357261373640343675347141048360175464883004078464167452167371904831096767113443494819262681110739948250607394950735031690197318521195526356325843390998224986240670310768318446607291248747540316179699411397387765899868554170318847788675929026070043212666179192235209382278788809886335991160819235355570464634911320859189796132791319756490976000139962344455350143464268604644958624769094347048293294140411146540923988344435159133201077394411184074107684981066347241048239358274019449356651610884631256785297769734684303061462418035852933159734583038455410337010916767763742762102137013548544509263071901147318485749233181672072137279355679528443925481560913728128406333039373562420016045664557414588166052166608738748047243391212955877763906969037078828527753894052460758496231574369171131761347838827194168606625721036851321566478001476752310393578606896111259960281839309548709059073861351914591819510297327875571049729011487171897180046961697770017913919613791417162707018958469214343696762927459109940060084983568425201915593703701011049747339493877885989417433031785348707603221982970579751191440510994235883034546353492349826883624043327267415540301619505680654180939409982020609994140216890900708213307230896621197755306659188141191577836272927461561857103721724710095214236964830864102592887457999322374955191221951903424452307535133806856807354464995127203174487195403976107308060269906258076020292731455252078079914184290638844373499681458273372072663917670201183004648190002413083508846584152148991276106513741539435657211390328574918769094413702090517031487773461652879848235338297260136110984514841823808120540996125274580881099486972216128524897425555516076371675054896173016809613803811914361143992106380050832140987604599309324851025168294467260666138151745712559754953580239983146982203613380828499356705575524712902745397762140493182014658008021566536067765508783804304134310591804606800834591136640834887408005741272586704792258319127415739080914383138456424150940849133918096840251163991936853225557338966953749026620923261318855891580832455571948453875628786128859004106006073746501402627824027346962528217174941582331749239683530136178653673760642166778137739951006589528877427662636841830680190804609849809469763667335662282915132352788806157768278159588669180238940333076441912403412022316368577860357276941541778826435238131905028087018575047046312933353757285386605888904583111450773942935201994321971171642235005644042979892081594307167019857469273848653833436145794634175922573898588001698014757420542995801242958105456510831046297282937584161162532562516572498078492099897990620035936509934721582965174135798491047111660791587436986541222348341887722929446335178653856731962559852026072947674072616767145573649812105677716893484917660771705277187601199908144113058645577910525684304811440261938402322470939249802933550731845890355397133088446174107959162511714864874468611247605428673436709046678468670274091881014249711149657817724279347070216688295610877794405048437528443375108828264771978540006509704033021862556147332117771174413350281608840351781452541964320309576018694649088681545285621346988355444560249556668436602922195124830910605377201980218310103270417838665447181260397190688462370857518080035327047185659499476124248110999288679158969049563947624608424065930948621507690314987020673533848349550836366017848771060809804269247132410009464014373603265645184566792456669551001502298330798496079949882497061723674493612262229617908143114146609412341593593095854079139087208322733549572080757165171876599449856937956238755516175754380917805280294642004472153962807463602113294255916002570735628126387331060058910652457080244749375431841494014821199962764531068006631183823761639663180931444671298615527598201451410275600689297502463040173514891945763607893528555053173314164570504996443890936308438744847839616840518452732884032345202470568516465716477139323775517294795126132398229602394548579754586517458787713318138752959809412174227300352296508089177705068259248822322154938048371454781647213976820963320508305647920482085920475499857320388876391601995240918938945576768749730856955958010659526503036266159750662225084067428898265907510637563569968211510949669744580547288693631020367823250182323708459790111548472087618212477813266330412076216587312970811230758159821248639807212407868878114501655825136178903070860870198975889807456643955157415363193191981070575336633738038272152798849350397480015890519420879711308051233933221903466249917169150948541401871060354603794643379005890957721180804465743962806186717861017156740967662080295766577051291209907944304632892947306159510430902221439371849560634056189342513057268291465783293340524635028929175470872564842600349629611654138230077313327298305001602567240141851520418907011542885799208121984493156999059182011819733500126187728036812481995877070207532406361259313438595542547781961142935163561223496661522614735399674051584998603552953329245752388810136202347624669055816438967863097627365504724348643071218494373485300606387644566272186661701238127715621379746149861328744117714552444708997144522885662942440230184791205478498574521634696448973892062401943518310088283480249249085403077863875165911302873958787098100772718271874529013972836614842142871705531796543076504534324600536361472618180969976933486264077435199928686323835088756683595097265574815431940195576850437248001020413749831872259677387154958399718444907279141965845930083942637020875635398216962055324803212267498911402678528599673405242031091797899905718821949391320753431707980023736590985375520238911643467185582906853711897952626234492483392496342449714656846591248918556629589329909035239233333647435203707701010843880032907598342170185542283861617210417603011645918780539367447472059985023582891833692922337323999480437108419659473162654825748099482509991833006976569367159689364493348864744213500840700660883597235039532340179582557036016936990988671132109798897070517280755855191269930673099250704070245568507786790694766126298082251633136399521170984528092630375922426742575599892892783704744452189363203489415521044597261883800300677617931381399162058062701651024458869247649246891924612125310275731390840470007143561362316992371694848132554200914530410371354532966206392105479824392125172540132314902740585892063217589494345489068463993137570910346332714153162232805522972979538018801628590735729554162788676498274186164218789885741071649069191851162815285486794173638906653885764229158342500673612453849160674137340173572779956341043326883569507814931378007362354180070619180267328551191942676091221035987469241172837493126163395001239599240508454375698507957046222664619000103500490183034153545842833764378111988556318777792537201166718539541835984438305203762819440761594106820716970302285152250573126093046898423433152732131361216582808075212631547730604423774753505952287174402666389148817173086436111389069420279088143119448799417154042103412190847094080254023932942945493878640230512927119097513536000921971105412096683111516328705423028470073120658032626417116165957613272351566662536672718998534199895236884830999302757419916463841427077988708874229277053891227172486322028898425125287217826030500994510824783572905691988555467886079462805371227042466543192145281760741482403827835829719301017888345674167811398954750448339314689630763396657226727043393216745421824557062524797219978668542798977992339579057581890622525473582205236424850783407110144980478726691990186438822932305382318559732869780922253529591017341407334884761005564018242392192695062083183814546983923664613639891012102177095976704908305081854704194664371312299692358895384930136356576186106062228705599423371631021278457446463989738188566746260879482018647487672727222062676465338099801966883680994159075776852639865146253336312450536402610569605513183813174261184420189088853196356986962795036738424313011331753305329802016688817481342988681585577810343231753064784983210629718425184385534427620128234570716988530518326179641178579608888150329602290705614476220915094739035946646916235396809201394578175891088931992112260073928149169481615273842736264298098234063200244024495894456129167049508235812487391799648641133480324757775219708932772262349486015046652681439877051615317026696929704928316285504212898146706195331970269507214378230476875280287354126166391708245925170010714180854800636923259462019002278087409859771921805158532147392653251559035410209284665925299914353791825314545290598415817637058927906909896911164381187809435371521332261443625314490127454772695739393481546916311624928873574718824071503995009446731954316193855485207665738825139639163576723151005556037263394867208207808653734942440115799667507360711159351331959197120948964717553024531364770942094635696982226673775209945168450643623824211853534887989395673187806606107885440005508276570305587448541805778891719207881423351138662929667179643468760077047999537883387870348718021842437342112273940255717690819603092018240188427057046092622564178375265263358324240661253311529423457965569502506810018310900411245379015332966156970522379210325706937051090830789479999004999395322153622748476603613677697978567386584670936679588583788795625946464891376652199588286933801836011932368578558558195556042156250883650203322024513762158204618106705195330653060606501054887167245377942831338871631395596905832083416898476065607118347136218123246227258841990286142087284956879639325464285343075301105285713829643709990356948885285190402956047346131138263878897551788560424998748316382804046848618938189590542039889872650697620201995548412650005394428203930127481638158530396439925470201672759328574366661644110962566337305409219519675148328734808957477775278344221091073111351828046036347198185655572957144747682552857863349342858423118749440003229690697758315903858039353521358860079600342097547392296733310649395601812237812854584317605561733861126734780745850676063048229409653041118306671081893031108871728167519579675347188537229309616143204006381322465841111157758358581135018569047815368938137718472814751998350504781297718599084707621974605887423256995828892535041937958260616211842368768511418316068315867994601652057740529423053601780313357263267054790338401257305912339601880137825421927094767337191987287385248057421248921183470876629667207272325650565129333126059505777727542471241648312832982072361750574673870128209575544305968395555686861188397135522084452852640081252027665557677495969626612604565245684086139238265768583384698499778726706555191854468698469478495734622606294219624557085371272776523098955450193037732166649182578154677292005212667143463209637891852323215018976126034373684067194193037746880999296877582441047878123266253181845960453853543839114496775312864260925211537673258866722604042523491087026958099647595805794663973419064010036361904042033113579336542426303561457009011244800890020801478056603710154122328891465722393145076071670643556827437743965789067972687438473076346451677562103098604092717090951280863090297385044527182892749689212106670081648583395537735919136950153162018908887484210798706899114804669270650940762046502772528650728905328548561433160812693005693785417861096969202538865034577183176686885923681488475276498468821949739729707737187188400414323127636504814531122850990020742409255859252926103021067368154347015252348786351643976235860419194129697690405264832347009911154242601273438022089331096686367898694977994001260164227609260823493041180643829138347354679725399262338791582998486459271734059225620749105308531537182911681637219395188700957788181586850464507699343940987433514431626330317247747486897918209239480833143970840673084079589358108966564775859905563769525232653614424780230826811831037735887089240613031336477371011628214614661679404090518615260360092521947218890918107335871964142144478654899528582343947050079830388538860831035719306002771194558021911942899922722353458707566246926177663178855144350218287026685610665003531050216318206017609217984684936863161293727951873078972637353717150256378733579771808184878458866504335824377004147710414934927438457587107159731559439426412570270965125108115548247939403597681188117282472158250109496096625393395380922195591918188552678062149923172763163218339896938075616855911752998450132067129392404144593862398809381240452191484831646210147389182510109096773869066404158973610476436500068077105656718486281496371118832192445663945814491486165500495676982690308911185687986929470513524816091743243015383684707292898982846022237301452655679898627767968091469798378268764311598832109043715611299766521539635464420869197567370005738764978437686287681792497469438427465256316323005551304174227341646455127812784577772457520386543754282825671412885834544435132562054464241011037955464190581168623059644769587054072141985212106734332410756767575818456990693046047522770167005684543969234041711089888993416350585157887353430815520811772071880379104046983069578685473937656433631979786803671873079693924236321448450354776315670255390065423117920153464977929066241508328858395290542637687668968805033317227800185885069736232403894700471897619347344308437443759925034178807972235859134245813144049847701732361694719765715353197754997162785663119046912609182591249890367654176979903623755286526375733763526969344354400473067198868901968147428767790866979688522501636949856730217523132529265375896415171479559538784278499866456302878831962099830494519874396369070682762657485810439112232618794059941554063270131989895703761105323606298674803779153767511583043208498720920280929752649812569163425000522908872646925284666104665392171482080130502298052637836426959733707053922789153510568883938113249757071331029504430346715989448786847116438328050692507766274500122003526203709466023414648998390252588830148678162196775194583167718762757200505439794412459900771152051546199305098386982542846407255540927403132571632640792934183342147090412542533523248021932277075355546795871638358750181593387174236061551171013123525633485820365146141870049205704372018261733194715700867578539336078622739558185797587258744102542077105475361294047460100094095444959662881486915903899071865980563617137692227290764197755177720104276496949611056220592502420217704269622154958726453989227697660310524980855759471631075870133208861463266412591148633881220284440694169488261529577625325019870359870674380469821942056381255833436421949232275937221289056420943082352544084110864545369404969271494003319782861318186188811118408257865928757426384450059944229568586460481033015388911499486935436030221810943466764000022362550573631294626296096198760564259963946138692330837196265954739234624134597795748524647837980795693198650815977675350553918991151335252298736112779182748542008689539658359421963331502869561192012298889887006079992795411188269023078913107603617634779489432032102773359416908650071932804017163840644987871753756781185321328408216571107549528294974936214608215583205687232185574065161096274874375098092230211609982633033915469494644491004515280925089745074896760324090768983652940657920198315265410658136823791984090645712468948470209357761193139980246813405200394781949866202624008902150166163813538381515037735022966074627952910384068685569070157516624192987244482719429331004854824454580718897633003232525821581280327467962002814762431828622171054352898348208273451680186131719593324711074662228508710666117703465352839577625997744672185715816126411143271794347885990892808486694914139097716736900277758502686646540565950394867841110790116104008572744562938425494167594605487117235946429105850909950214958793112196135908315882620682332156153086833730838173279328196983875087083483880463884784418840031847126974543709373298362402875197920802321878744882872843727378017827008058782410749357514889978911739746129320351081432703251409030487462262942344327571260086642508333187688650756429271605525289544921537651751492196367181049435317858383453865255656640657251363575064353236508936790431702597878177190314867963840828810209461490079715137717099061954969640070867667102330048672631475510537231757114322317411411680622864206388906210192355223546711662137499693269321737043105987225039456574924616978260970253359475020913836673772894438696400028110344026084712899000746807764844088711341352503367877316797709372778682166117865344231732264637847697875144332095340001650692130546476890985050203015044880834261845208730530973189492916425322933612431514306578264070283898409841602950309241897120971601649265613413433422298827909921786042679812457285345801338260995877178113102167340256562744007296834066198480676615805021691833723680399027931606420436812079900316264449146190219458229690992122788553948783538305646864881655562294315673128274390826450611628942803501661336697824051770155219626522725455850738640585299830379180350432876703809252167907571204061237596327685674845079151147313440001832570344920909712435809447900462494313455028900680648704293534037436032625820535790118395649089354345101342969617545249573960621490288728932792520696535386396443225388327522499605986974759882329916263545973324445163755334377492928990581175786355555626937426910947117002165411718219750519831787137106051063795558588905568852887989084750915764639074693619881507814685262133252473837651192990156109189777922008705793396463827490680698769168197492365624226087154176100430608904377976678519661891404144925270480881971498801542057787006521594009289777601330756847966992955433656139847738060394368895887646054983871478968482805384701730871117761159663505039979343869339119789887109156541709133082607647406305711411098839388095481437828474528838368079418884342666222070438722887413947801017721392281911992365405516395893474263953824829609036900288359327745855060801317988407162446563997948275783650195514221551339281978226984278638391679715091262410548725700924070045488485692950448110738087996547481568913935380943474556972128919827177020766613602489581468119133614121258783895577357194986317210844398901423948496659251731388171602663261931065366535041473070804414939169363262373767777095850313255990095762731957308648042467701212327020533742667053142448208168130306397378736642483672539837487690980602182785786216512738563513290148903509883270617258932575363993979055729175160097615459044771692265806315111028038436017374742152476085152099016158582312571590733421736576267142390478279587281505095633092802668458937649649770232973641319060982740633531089792464242134583740901169391964250459128813403498810635400887596820054408364386516617880557608956896727531538081942077332597917278437625661184319891025007491829086475149794003160703845549465385946027452447466812314687943441610993338908992638411847425257044572517459325738989565185716575961481266020310797628254165590506042479114016957900338356574869252800743025623419498286467914476322774005529460903940177536335655471931000175430047504719144899841040015867946179241610016454716551337074073950260442769538553834397550548871099785205401175169747581344926079433689543783221172450687344231989878844128542064742809735625807066983106979935260693392135685881391214807354728463227784908087002467776303605551232386656295178853719673034634701222939581606792509153217489030840886516061119011498443412350124646928028805996134283511884715449771278473361766285062169778717743824362565711779450064477718370221999106695021656757644044997940765037999954845002710665987813603802314126836905783190460792765297277694043613023051787080546511542469395265127101052927070306673024447125973939950514628404767431363739978259184541176413327906460636584152927019030276017339474866960348694976541752429306040727005059039503148522921392575594845078867977925253931765156416197168443524369794447355964260633391055126826061595726217036698506473281266724521989060549880280782881429796336696744124805982192146339565745722102298677599746738126069367069134081559412016115960190237753525556300606247983261249881288192937343476862689219239777833910733106588256813777172328315329082525092733047850724977139448333892552081175608452966590553940965568541706001179857293813998258319293679100391844099286575605993598910002969864460974714718470101531283762631146774209145574041815908800064943237855839308530828305476076799524357391631221886057549673832243195650655460852881201902363644712703748634421727257879503428486312944916318475347531435041392096108796057730987201352484075057637199253650470908582513936863463863368042891767107602111159828875539940120076013947033661793715396306139863655492213741597905119083588290097656647300733879314678913181465109316761575821351424860442292445304113160652700974330088499034675405518640677342603583409608605533747362760935658853109760994238347382222087292464497684560579562516765574088410321731345627735856052358236389532038534024842273371639123973215995440828421666636023296545694703577184873442034227706653837387506169212768015766181095420097708363604361110592409117889540338021426523948929686439808926114635414571535194342850721353453018315875628275733898268898523557799295727645229391567477566676051087887648453493636068278050564622813598885879259940946446041705204470046315137975431737187756039815962647501410906658866162180038266989961965580587208639721176995219466789857011798332440601811575658074284182910615193917630059194314434605154047710570054339000182453117733718955857603607182860506356479979004139761808955363669603162193113250223851791672055180659263518036251214575926238369348222665895576994660491938112486609099798128571823494006615552196112207203092277646200999315244273589488710576623894693889446495093960330454340842102462401048723328750081749179875543879387381439894238011762700837196053094383940063756116458560943129517597713935396074322792489221267045808183313764165818269562105872892447740035947009268662659651422050630078592002488291860839743732353849083964326147000532423540647042089499210250404726781059083644007466380020870126664209457181702946752278540074508552377720890581683918446592829417018288233014971554235235911774818 diff --git a/bv-little.cabal b/bv-little.cabal --- a/bv-little.cabal +++ b/bv-little.cabal @@ -1,15 +1,26 @@ -name: bv-little -version: 1.1.1 -synopsis: Efficient little-endian bit vector library -category: Data, Bit Vectors -license: BSD3 -license-file: LICENSE -author: Alex Washburn -maintainer: hackage@recursion.ninja -homepage: https://github.com/recursion-ninja/bv-little -bug-reports: https://github.com/recursion-ninja/bv-little/issues -copyright: (c) Alex Washburn 2018 -description: +Cabal-Version: 3.0 +Name: bv-little +Version: 1.3.0 +Stability: Stable +Build-Type: Simple +Tested-With: + GHC == 9.6.2 + GHC == 9.4.5 + GHC == 9.2.8 + GHC == 9.2.3 + +Author: Alex Washburn +Copyright: (c) Alex Washburn 2020 +License: BSD-3-Clause +License-File: LICENSE + +Maintainer: hackage@recursion.ninja +Homepage: https://github.com/recursion-ninja/bv-little +Bug-Reports: https://github.com/recursion-ninja/bv-little/issues + +Synopsis: Efficient little-endian bit vector library +Category: Data, Bit Vectors +Description: . This package contains a time- and space- efficient implementation of /little-endian, immutable/ bit vectors. Provides implementations of applicable typeclasses and numeric conversions. . @@ -19,211 +30,325 @@ . For an implementation of /little-endian, mutable/ bit vectors, use the package. -build-type: Simple -cabal-version: >= 1.22 - -tested-with: GHC == 8.8.1 - GHC == 8.6.5 - GHC == 8.4.4 - GHC == 8.2.2 - GHC == 8.0.2 - GHC == 7.10.3 +Extra-Source-Files: + stack.yaml -extra-source-files: changelog.md - README.md - stack.yaml +Extra-Doc-Files: + changelog.md + README.md -source-repository head +Source-repository head type: git location: https://github.com/recursion-ninja/bv-little +Common language -library + default-extensions: + NoGeneralizedNewtypeDeriving + + default-language: + GHC2021 - build-depends: base >= 4.5.1 && < 5 - , deepseq >= 1.4.1.1 - , hashable >= 1.2.3.2 - , integer-gmp >= 1.0 - , keys >= 3.10.1 - , mono-traversable >= 1.0.5.0 - , mono-traversable-keys >= 0.1.0 - , primitive >= 0.6.4.0 - , QuickCheck >= 2.8 - , text-show >= 3.2.1 - if !impl(ghc >= 8.0) +Library - build-depends: semigroups >= 0.18 && < 1.0 + import: + language - default-language: Haskell2010 + build-depends: + base >= 4.16.1 && < 5, + bv-little:core - exposed-modules: Data.BitVector.LittleEndian + exposed-modules: + Data.BitVector.LittleEndian - ghc-options: -O2 + hs-source-dirs: + src - -- Sanity check warnings - -Wall - -fwarn-dodgy-foreign-imports - -fwarn-incomplete-record-updates - -fwarn-incomplete-uni-patterns - -fwarn-overlapping-patterns - -fwarn-duplicate-exports - -fwarn-identities - -fwarn-incomplete-patterns - -fwarn-incomplete-record-updates - -fwarn-incomplete-uni-patterns - -fwarn-missing-fields - -fwarn-missing-signatures - -fwarn-overlapping-patterns - -fwarn-tabs - -fwarn-unused-binds - -fwarn-unused-do-bind - -fwarn-unused-imports - -fwarn-unused-matches - -fwarn-wrong-do-bind +Library core - if impl(ghc >= 7.8) + import: + language - ghc-options: -fwarn-empty-enumerations - -fwarn-overflowed-literals + build-depends: + base >= 4.16.1 && < 5, + deepseq >= 1.4.6 && ^>= 1.4, + hashable >= 1.3 && ^>= 1.4, + integer-gmp ^>= 1.1, + primitive ^>= 0.7.2, - if impl(ghc >= 8.0) + exposed-modules: + Data.BitVector.LittleEndian.Internal - ghc-options: -Wcompat - -fwarn-noncanonical-monoid-instances - -fwarn-redundant-constraints - -fwarn-semigroup - -fwarn-unrecognised-warning-flags - -fwarn-unused-foralls + hs-source-dirs: + src/core - hs-source-dirs: src + visibility: + private -Test-Suite test-suite +Library instances - type: exitcode-stdio-1.0 + import: + language - main-is: TestSuite.hs + build-depends: + bv-little:instances-binary, + bv-little:instances-mono-traversable, + bv-little:instances-mono-traversable-keys, + bv-little:instances-quickcheck, + bv-little:instances-text-show, - build-depends: base >= 4.5.1 && < 5 - , bv-little - , deepseq >= 1.4.1.1 - , hashable >= 1.2.3.2 - , mono-traversable >= 1.0.5.0 - , mono-traversable-keys >= 0.1.0 - , QuickCheck >= 2.8 - , smallcheck >= 1.1.5 - , tasty - , tasty-hunit - , tasty-quickcheck - , tasty-smallcheck - , text-show >= 3.2.1 + exposed-modules: + Data.BitVector.LittleEndian.Instances - if !impl(ghc >= 8.0) + hs-source-dirs: + src/full - build-depends: semigroups >= 0.18 && < 1.0 - , transformers + visibility: + public - default-language: Haskell2010 - hs-source-dirs: test, util +Library instances-binary - other-modules: Data.BitVector.Visual - Operator.Binary.Comparison - Operator.Binary.Logical - Operator.Unary.Logical - + import: + language -benchmark benchmark-suite + build-depends: + base >= 4.16.1 && < 5, + binary ^>= 0.8, + bv-little, + bv-little:core, - type: exitcode-stdio-1.0 + exposed-modules: + Data.BitVector.LittleEndian.Binary - main-is: Benchmarks.hs + hs-source-dirs: + src/libs - build-depends: base >= 4.5.1 && < 5 - , bv-little - , criterion - , deepseq >= 1.4.1.1 - , hashable >= 1.2.3.2 - , mono-traversable >= 1.0.5.0 - , QuickCheck >= 2.8 - , smallcheck >= 1.1.5 + visibility: + public - if !impl(ghc >= 8.0) - build-depends: semigroups >= 0.18 && < 1.0 +Library instances-mono-traversable - default-language: Haskell2010 + import: + language - ghc-options: -O2 - -threaded - -fdicts-cheap - -fmax-simplifier-iterations=10 - -fno-full-laziness - -fspec-constr-count=6 + build-depends: + base >= 4.16.1 && < 5, + bv-little, + bv-little:core, + mono-traversable >= 1.0.5.0 && ^>= 1.0 - -- Sanity check warnings - -Wall - -fwarn-dodgy-foreign-imports - -fwarn-incomplete-record-updates - -fwarn-incomplete-uni-patterns - -fwarn-overlapping-patterns + exposed-modules: + Data.BitVector.LittleEndian.MonoTraversable - -- Turn off type default warnings - -fno-warn-type-defaults + hs-source-dirs: + src/libs - hs-source-dirs: bench, util + visibility: + public - other-modules: Operator.Binary.Comparison - Operator.Binary.Logical - Operator.Unary.Logical - +Library instances-mono-traversable-keys -benchmark benchmark-heap-stack + import: + language - type: exitcode-stdio-1.0 + build-depends: + base >= 4.16.1 && < 5, + bv-little, + bv-little:core, + bv-little:instances-mono-traversable, + keys ^>= 3.12, + mono-traversable >= 1.0.5.0 && ^>= 1.0, + mono-traversable-keys >= 0.2 && ^>= 0.3, - main-is: HeapStack.hs + exposed-modules: + Data.BitVector.LittleEndian.MonoKeyed - build-depends: base >= 4.5.1 && < 5 - , bv-little - , criterion - , deepseq >= 1.4.1.1 - , hashable >= 1.2.3.2 - , mono-traversable >= 1.0.5.0 - , QuickCheck >= 2.8 - , smallcheck >= 1.1.5 + hs-source-dirs: + src/keys - if !impl(ghc >= 8.0) + visibility: + public - build-depends: semigroups >= 0.18 && < 1.0 - default-language: Haskell2010 +Library instances-quickcheck - ghc-options: -O2 --- -ddump-simpl-stats - -threaded - -fdicts-cheap - -fmax-simplifier-iterations=10 - -fno-full-laziness - -fspec-constr-count=6 - -rtsopts --- -prof + import: + language - -- Sanity check warnings - -Wall - -fwarn-dodgy-foreign-imports - -fwarn-incomplete-record-updates - -fwarn-incomplete-uni-patterns - -fwarn-overlapping-patterns + build-depends: + base >= 4.16.1 && < 5, + bv-little, + bv-little:core, + QuickCheck >= 2.14.2 && ^>= 2.14 - -- Turn off type default warnings - -fno-warn-type-defaults + exposed-modules: + Data.BitVector.LittleEndian.QuickCheck - hs-source-dirs: bench, util + hs-source-dirs: + src/libs - other-modules: Operator.Binary.Comparison - Operator.Binary.Logical - Operator.Unary.Logical + visibility: + public + + +Library instances-text-show + + import: + language + + build-depends: + base >= 4.16.1 && < 5, + bv-little, + bv-little:core, + text-show >= 3.9 && ^>= 3.10, + + exposed-modules: + Data.BitVector.LittleEndian.TextShow + + hs-source-dirs: + src/libs + + visibility: + public + + +Test-Suite Test-Suite + + import: + language + + type: + exitcode-stdio-1.0 + + main-is: + TestSuite.hs + + build-depends: + base >= 4.16.1 && < 5, + bv-little, + bv-little:instances, + deepseq >= 1.4.6 && ^>= 1.4, + hashable >= 1.3 && ^>= 1.4, + mono-traversable >= 1.0.5.0 && ^>= 1.0, + mono-traversable-keys >= 0.2 && ^>= 0.3, + QuickCheck >= 2.14.2 && ^>= 2.14.2, + smallcheck >= 1.1.5 && ^>= 1.2, + tasty, + tasty-hunit, + tasty-quickcheck, + tasty-smallcheck, + text-show >= 3.9 && ^>= 3.10, + + hs-source-dirs: + test, + util + + other-modules: + Data.BitVector.Visual + Operator.Binary.Comparison + Operator.Binary.Logical + Operator.Unary.Logical + + +Benchmark Benchmark-suite + + import: + language + + type: + exitcode-stdio-1.0 + + main-is: + Benchmarks.hs + + build-depends: + base >= 4.16.1 && < 5, + bv-little, + bv-little:instances, + criterion ^>= 1.6, + deepseq >= 1.4.6 && ^>= 1.4, + hashable >= 1.3 && ^>= 1.4, + mono-traversable >= 1.0.5.0 && ^>= 1.0, + QuickCheck >= 2.14.2 && ^>= 2.14.2, + smallcheck >= 1.1.5 && ^>= 1.2, + tasty ^>= 1.4, + tasty-hunit ^>= 0.10, + tasty-quickcheck ^>= 0.10, + tasty-smallcheck ^>= 0.8, + text-show >= 3.9 && ^>= 3.10, + + ghc-options: + -threaded + -fdicts-cheap + -fmax-simplifier-iterations=10 + -fno-full-laziness + -fspec-constr-count=6 + -fwarn-dodgy-foreign-imports + -fwarn-incomplete-record-updates + -fwarn-incomplete-uni-patterns + -fwarn-overlapping-patterns + -fno-warn-type-defaults + + hs-source-dirs: + bench, + util + + other-modules: + Operator.Binary.Comparison + Operator.Binary.Logical + Operator.Unary.Logical + + +Benchmark Benchmark-heap-stack + + import: + language + + type: + exitcode-stdio-1.0 + + main-is: + HeapStack.hs + + build-depends: + base >= 4.16.1 && < 5, + bv-little, + bv-little:instances, +-- criterion ^>= 1.6, + deepseq >= 1.4.6 && ^>= 1.4, +-- hashable >=1.2.3.2, +-- mono-traversable >=1.0.5.0, + QuickCheck >= 2.14.2 && ^>= 2.14.2, + smallcheck >= 1.1.5 && ^>= 1.2, + + if !impl(ghc >=8.0) + build-depends: + semigroups >=0.18 && <1.0 + + ghc-options: + -threaded + -fdicts-cheap + -fmax-simplifier-iterations=10 + -fno-full-laziness + -fspec-constr-count=6 + -rtsopts + -fwarn-dodgy-foreign-imports + -fwarn-incomplete-record-updates + -fwarn-incomplete-uni-patterns + -fwarn-overlapping-patterns + -fno-warn-type-defaults + + hs-source-dirs: + bench, + util + + other-modules: + Operator.Binary.Comparison + Operator.Binary.Logical + Operator.Unary.Logical diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,26 +1,45 @@ -### Unreleased Changes +`bv-little` *follows semantic versioning [(SemVer)](https://semver.org/).* - * None -### [v1.1.1][6] +## [v1.3.0][7] + * Added back `TextShow` instance + + * Added specializations + + * Dropping support for GHC < 9.2.3 + + +## v1.2.0 + + * Restructuring library to expose instances in a refined, "opt-in" manner + + * Dropped support for GHC < 8.8.1 + + * Added `Binary` instance + + * Added `Read` instance + + +## [v1.1.1][6] + * Added more benchmarks * Updated test suite to be more reliable -### [v1.1.0][5] +## [v1.1.0][5] * Added `rank` and `select` functions -### [v1.0.1][4] +## [v1.0.1][4] * Correcting Eq instance to test for value equality and not construction equality * Updated unit tests do not fail when the antecedent of logical implication cannot be satisfied -### [v1.0.0][3] +## [v1.0.0][3] * Added explicit recursion to monomorphic folds to improve time and space performance @@ -47,12 +66,12 @@ * `ozipWith` -### [v0.1.2][2] +## [v0.1.2][2] * Updating to base bounds for GHC 8.6.1 -### [v0.1.1][1] +## [v0.1.1][1] * Updated to well-typed internal representation @@ -67,7 +86,7 @@ * Increased test suite coverage -### [v0.1.0][0] +## [v0.1.0][0] * Created instances of applicable typeclass instances @@ -84,4 +103,5 @@ [3]: https://github.com/recursion-ninja/bv-little/tree/v1.0.0 [4]: https://github.com/recursion-ninja/bv-little/tree/v1.0.1 [5]: https://github.com/recursion-ninja/bv-little/tree/v1.1.0 -[5]: https://github.com/recursion-ninja/bv-little/tree/v1.1.1 +[6]: https://github.com/recursion-ninja/bv-little/tree/v1.1.1 +[7]: https://github.com/recursion-ninja/bv-little/tree/v1.3.0 diff --git a/src/Data/BitVector/LittleEndian.hs b/src/Data/BitVector/LittleEndian.hs --- a/src/Data/BitVector/LittleEndian.hs +++ b/src/Data/BitVector/LittleEndian.hs @@ -1,1341 +1,54 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.BitVector.LittleEndian --- Copyright : (c) Alex Washburn 2018 --- License : BSD-style --- --- Maintainer : github@recursion.ninja --- Stability : provisional --- Portability : portable --- --- A bit vector similar to @Data.BitVector@ from the --- , however the endianness is --- reversed. This module defines /little-endian/ pseudo–size-polymorphic --- bit vectors. --- --- Little-endian bit vectors are isomorphic to a @[Bool]@ with the /least/ --- significant bit at the head of the list and the /most/ significant bit at the --- end of the list. Consequently, the endianness of a bit vector affects the semantics of the --- following typeclasses: --- --- * 'Bits' --- * 'FiniteBits' --- * 'Semigroup' --- * 'Monoid' --- * 'MonoAdjustable' --- * 'MonoIndexable' --- * 'MonoKeyed' --- * 'MonoLookup' --- * 'MonoFoldable' --- * 'MonoFoldableWithKey' --- * 'MonoTraversable' --- * 'MonoTraversableWithKey' --- * 'MonoZipWithKey' --- --- For an implementation of bit vectors which are isomorphic to a @[Bool]@ with the /most/ --- significant bit at the head of the list and the /least/ significant bit at the --- end of the list, use the --- package. --- --- This module does /not/ define numeric instances for 'BitVector'. This is --- intentional! To interact with a bit vector as an 'Integral' value, --- convert the 'BitVector' using either 'toSignedNumber' or 'toUnsignedNumber'. --- --- This module defines 'rank' and 'select' operations for 'BitVector' as a --- . --- These operations are not /o(1)/ so 'BitVector' is not a /true/ succinct data --- structure. However, it could potentially be extend to support this in the --- future. ------------------------------------------------------------------------------ - -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeFamilies #-} - -module Data.BitVector.LittleEndian - ( BitVector() - -- * Bit-stream conversion - , fromBits - , toBits - -- * Numeric conversion - , fromNumber - , toSignedNumber - , toUnsignedNumber - -- * Queries - , dimension - , isZeroVector - , subRange - -- * Rank / Select - , rank - , select - ) where - - -import Control.DeepSeq -import Data.Bits -import Data.Data -import Data.Foldable -import Data.Hashable -import Data.Key -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Maybe -import Data.Monoid () -import Data.MonoTraversable -import Data.MonoTraversable.Keys -import Data.Ord -import Data.Primitive.ByteArray -import Data.Semigroup -import GHC.Exts -import GHC.Generics -import GHC.Integer.GMP.Internals -import GHC.Integer.Logarithms -import GHC.Natural -import Test.QuickCheck (Arbitrary(..), CoArbitrary(..), NonNegative(..), choose, suchThat, variant) -import TextShow (TextShow(showb)) - - --- | --- A little-endian bit vector of non-negative dimension. -data BitVector - = BV - { dim :: {-# UNPACK #-} !Word -- ^ The /dimension/ of a bit vector. - , nat :: !Natural -- ^ The value of a bit vector, as a natural number. - } deriving -#ifdef MIN_VERSION_GLASGOW_HASKELL -#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0) - ( Data -- ^ @since 0.1.0 - , Generic -- ^ @since 0.1.0 - , Typeable -- ^ @since 0.1.0 - ) -#else - ( Data - , Generic - , Typeable - ) -#endif -#endif - - --- | --- @since 0.1.0 -type instance Element BitVector = Bool - - --- | --- @since 1.0.0 -type instance MonoKey BitVector = Word - - --- | --- @since 0.1.0 -instance Arbitrary BitVector where - - -- Arbitrary instance distribution weighting: - -- - 2% = (maxBound :: Word) - -- - 2% = (maxBound :: Word) + 1 - -- - 8% = all bits on - -- - 8% = all bits off - -- - 80% = any bit configuration - arbitrary = do - -- 1/25 chance of generating the boundary value at which the natural number - -- must use different Natural constructors: NatS# & NatJ# - n <- choose (0, 25 :: Word) - case n of - 0 -> boundaryValue - 1 -> allBitsOn - 2 -> allBitsOn - 3 -> allBitsOff - 4 -> allBitsOff - _ -> anyBitValue - where - allBitsOn = genBitVector $ Just True - allBitsOff = genBitVector $ Just False - anyBitValue = genBitVector Nothing - - boundaryValue = do - let wrdVal = maxBound :: Word - let dimVal = toEnum $ popCount wrdVal - let numVal = wordToNatural wrdVal - -- 50/50 change to generate above or below the constructor boundary - underBoundary <- arbitrary - let (lowerBound, naturalVal) - | underBoundary = (dimVal , numVal ) - | otherwise = (dimVal + 1, numVal + 1) - widthVal <- (getNonNegative <$> arbitrary) `suchThat` (>= lowerBound) - pure $ BV widthVal naturalVal - - genBitVector spec = do - dimVal <- getNonNegative <$> arbitrary - let upperBound = shiftL 1 dimVal - -- 1/5 chance all bits on or all bits off - natVal <- case spec of - Just False -> pure $ intToNat 0 - Just True -> pure . intToNat $ upperBound - 1 - Nothing -> fmap intToNat $ - (getNonNegative <$> arbitrary) `suchThat` (< upperBound) - pure $ BV (toEnum dimVal) natVal - - --- | --- @since 0.1.0 -instance Bits BitVector where - - {-# INLINE (.&.) #-} - (BV w1 a) .&. (BV w2 b) = BV (max w1 w2) $ a .&. b - - {-# INLINE (.|.) #-} - (BV w1 a) .|. (BV w2 b) = BV (max w1 w2) $ a .|. b - - {-# INLINE xor #-} - (BV w1 a) `xor` (BV w2 b) = BV (max w1 w2) $ a `xor` b - - {-# INLINE complement #-} - complement (BV w n) = BV w $ shiftL 1 (fromEnum w) - 1 - n - - {-# INLINE zeroBits #-} - zeroBits = BV 0 0 - - {-# INLINE bit #-} - bit i = BV (succ $ toEnum i) (shiftL 1 i) - - {-# INLINE clearBit #-} - -- We do this more complicated operation rather than call 'clearBit' - -- because it is undefined for Natural in base < 4.10.0.0 - clearBit bv@(BV w n) i - | i < 0 || toEnum i >= w = bv - | otherwise = - let !allBits = pred . shiftL 1 $ fromEnum w - !mask = bit i `xor` allBits - in BV w $ n .&. mask - - {-# INLINE setBit #-} - setBit bv@(BV w n) i - | i < 0 = bv - | otherwise = BV (max w j) $ n `setBit` i - where - !j = toEnum i + 1 - - {-# INLINE testBit #-} - testBit (BV w n) i = i >= 0 && toEnum i < w && n `testBit` i - - bitSize (BV w _) = fromEnum w - - {-# INLINE bitSizeMaybe #-} - bitSizeMaybe (BV w _) = Just $ fromEnum w - - {-# INLINE isSigned #-} - isSigned = const False - - {-# INLINE shiftL #-} - shiftL (BV w n) k - | toEnum k > w = BV w 0 - | otherwise = BV w $ shiftL n k .&. pred (shiftL 1 (fromEnum w)) - - {-# INLINE shiftR #-} - shiftR (BV w n) k - | toEnum k > w = BV w 0 - | otherwise = BV w $ shiftR n k - - {-# INLINE rotateL #-} - rotateL bv 0 = bv - rotateL bv@(BV 0 _) _ = bv - rotateL bv@(BV 1 _) _ = bv - rotateL bv@(BV w n) k - | k < 0 = bv - | j >= w = go . fromEnum $ j `mod` w - | otherwise = go k - where - !j = toEnum k - go 0 = bv - go !i = BV w $ h + l - where - !v = fromEnum w - !d = v - i - !m = pred $ shiftL 1 d - !l = n `shiftR` d - !h = (n .&. m) `shiftL` i - - {-# INLINE rotateR #-} - rotateR bv 0 = bv - rotateR bv@(BV 0 _) _ = bv - rotateR bv@(BV 1 _) _ = bv - rotateR bv@(BV w n) k - | k < 0 = bv - | j >= w = go . fromEnum $ j `mod` w - | otherwise = go k - where - !j = toEnum k - go 0 = bv - go !i = BV w $ h + l - where - !v = fromEnum w - !d = v - i - !m = pred $ shiftL 1 i - !l = n `shiftR` i - !h = (n .&. m) `shiftL` d - - {-# INLINE popCount #-} - popCount = popCount . nat - - --- | --- @since 0.1.0 -instance CoArbitrary BitVector where - - coarbitrary bv = variant (dimension bv) - - --- | --- @since 0.1.0 -instance Eq BitVector where - - {-# INLINE (==) #-} - (==) (BV w1 m) (BV w2 n) = w1 == w2 && naturalToBigNat m == naturalToBigNat n - where - naturalToBigNat (NatS# w ) = wordToBigNat w - naturalToBigNat (NatJ# bn) = bn - - --- | --- @since 0.1.0 -instance FiniteBits BitVector where - - {-# INLINE finiteBitSize #-} - finiteBitSize = fromEnum . dim - - {-# INLINE countTrailingZeros #-} - countTrailingZeros (BV w n) = max 0 $ fromEnum w - lastSetBit - 1 - where - lastSetBit = I# (integerLog2# (toInteger n)) - - {-# INLINE countLeadingZeros #-} - countLeadingZeros (BV w 0) = fromEnum w - countLeadingZeros (BV w natVal) = - case natVal of - NatS# v -> countTrailingZeros $ iMask .|. W# v - NatJ# (BN# v) -> f $ ByteArray v - where - iMask = complement zeroBits `xor` (2 ^ w - 1) - !x = fromEnum w - - f :: ByteArray -> Int - f byteArr = g 0 - where - (q, r) = x `quotRem` fromEnum bitsInWord - wMask = complement zeroBits `xor` (2 ^ r - 1) :: Word - - g :: Int -> Int - g !i - | i >= q = countTrailingZeros $ wMask .|. value - | otherwise = - let !v = countTrailingZeros value - in if v == fromEnum bitsInWord - then v + g (i+1) - else v - where - value :: Word - value = byteArr `indexByteArray` i - - --- | --- @since 0.1.0 -instance Hashable BitVector where - - hash (BV w n) = fromEnum w `hashWithSalt` hash n - - hashWithSalt salt bv = salt `hashWithSalt` hash bv - - --- | --- @since 0.1.0 -instance Monoid BitVector where - - {-# INLINE mappend #-} - mappend = (<>) - - {-# INLINE mconcat #-} - mconcat bs = - case bs of - [] -> mempty - x:xs -> sconcat $ x:|xs - - {-# INLINE mempty #-} - mempty = BV 0 0 - - --- | --- @since 1.0.0 -instance MonoAdjustable BitVector where - - -- | /O(1)/ - {-# INLINE oadjust #-} - oadjust f k bv@(BV w n) - | k >= w = bv - | v == b = bv - | otherwise = bv `complementBit` i - where - !i = fromEnum k - !v = n `testBit` i - !b = f v - - -- | /O(1)/ - {-# INLINE oreplace #-} - oreplace k v bv@(BV w _) - | k >= w = bv - | v = bv `setBit` i - | otherwise = bv `clearBit` i - where - !i = fromEnum k - - --- | --- @since 0.1.0 -instance MonoFoldable BitVector where - - {-# INLINE ofoldMap #-} - ofoldMap f (BV w n) = go m - where - !m = fromEnum w - go 0 = mempty - go !c = let !i = m - c - !j = c - 1 - !b = n `testBit` i - in f b `mappend` go j - - {-# INLINE ofoldr #-} - ofoldr f e (BV w n) = - let !m = fromEnum w - go 0 acc = acc - go !c acc = let !i = m - c - !j = c - 1 - !b = n `testBit` i - in f b $ go j acc - in go m e - - {-# INLINE ofoldl' #-} - ofoldl' f e (BV w n) = go m e - where - !m = fromEnum w - go 0 acc = acc - go !c acc = let !i = m - c - !j = c - 1 - !b = n `testBit` i - !a = f acc b - in go j a - - {-# INLINE otoList #-} - otoList = toBits - - -- | /O(1)/ - {-# INLINE oall #-} - oall _ (BV 0 _) = True - oall f (BV w n) = - case (f False, f True) of - (False, False) -> False - (True , True ) -> True - (False, True ) -> n == bit (fromEnum w) - 1 - (True , False) -> n == 0 - - -- | /O(1)/ - {-# INLINE oany #-} - oany _ (BV 0 _) = False - oany f (BV w n) = - case (f False, f True) of - (False, False) -> False - (True , True ) -> True - (False, True ) -> n > 0 - (True , False) -> n < bit (fromEnum w) - 1 - - -- | /O(1)/ - {-# INLINE onull #-} - onull = (== 0) . dim - - -- | /O(1)/ - {-# INLINE olength #-} - olength = fromEnum . dim - - -- | /O(1)/ - {-# INLINE olength64 #-} - olength64 = toEnum . olength - - {-# INLINE otraverse_ #-} - otraverse_ f (BV w n) = go (fromEnum w) - where - go 0 = pure () - go !c = let !j = c - 1 - !a = f (n `testBit` j) - in a *> go j - - - {-# INLINE ofoldlM #-} - ofoldlM f e (BV w n) = go (fromEnum w) e - where - go 0 acc = pure acc - go !c acc = let !j = c - 1 - !x = f acc (n `testBit` j) - in x >>= go j - - {-# INLINE ofoldMap1Ex #-} - ofoldMap1Ex _ (BV 0 _) = Prelude.error "Data.MonoTraversable.ofoldMap1Ex on an empty BitVector!" - ofoldMap1Ex f (BV w n) = go 0 - where - !m = fromEnum w - go !c - | c >= m - 1 = f $ n `testBit` c - | otherwise = let !j = c + 1 - !b = n `testBit` c - in f b <> go j - - -- | /O(1)/ - {-# INLINE ofoldr1Ex #-} - ofoldr1Ex _ (BV 0 _) = Prelude.error "Data.MonoTraversable.ofoldr1Ex on an empty BitVector!" - ofoldr1Ex _ (BV 1 n) = n > 0 - ofoldr1Ex f bv@(BV w n) = - -- See the following entry for explanation: - -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators - -- - -- cases of f p q - case (f True True, f True False, f False True, f False False) of - -- Contradiction (Const False) - (False, False, False, False) -> False - -- Logical NOR - (False, False, False, True ) -> let !lzs = toEnum $ countLeadingZeros bv - in if (w - lzs) == 1 || n == 0 - then even lzs - else odd lzs - -- Converse non-implication - -- Only True when of the form <0+1> - (False, False, True , False) -> n == bit (fromEnum w - 1) - -- NOT p - (False, False, True , True ) -> not (n `testBit` 0) - -- Logical non-implication - -- Only True when the number of leading ones is even - (False, True , False, False) -> let !los = countLeadingZeros $ complement bv - in odd los - -- NOT q - (False, True , False, True ) -> let !v = n `testBit` (fromEnum w - 1) - in if even w then not v else v - -- Logical XOR - (False, True , True , False) -> odd $ popCount n - -- Logical NAND - (False, True , True , True ) -> let !los = countLeadingZeros $ complement bv - !x = bit (fromEnum w - 1) - 1 - !y = bit (fromEnum w ) - 1 - in if n == x || n == y - then odd los - else even los - -- Logical AND - (True , False, False, False) -> n == bit (fromEnum w) - 1 - -- Logical XNOR - (True , False, False, True ) -> let !pc = popCount n - in if even w - then even pc - else odd pc - -- Const q - (True , False, True , False) -> n `testBit` (fromEnum w - 1) - -- Logical implication - -- only False when of the form <1+0> - (True , False, True , True ) -> let !i = fromEnum w - 1 - in n /= bit i - 1 - -- Const p - (True , True , False, False) -> n `testBit` 0 - -- Converse implication - (True , True , False, True ) -> even $ countLeadingZeros bv - -- Logical OR - (True , True , True , False) -> n > 0 - -- Constant True - (True , True , True , True ) -> True - - -- | /O(n)/ - {-# INLINE ofoldl1Ex' #-} - ofoldl1Ex' _ (BV 0 _) = Prelude.error "Data.MonoTraversable.ofoldl1Ex' on an empty BitVector!" - ofoldl1Ex' _ (BV 1 n) = n > 0 - ofoldl1Ex' f bv@(BV w n) = - -- See the following entry for explanation: - -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators - -- - -- cases of f p q - case (f True True, f True False, f False True, f False False) of - -- Contradiction (Const False) - (False, False, False, False) -> False - -- Logical NOR - (False, False, False, True ) -> let !tzs = toEnum $ countTrailingZeros bv - in if (w - tzs) == 1 || n == 0 - then even tzs - else odd tzs - -- Converse non-implication - (False, False, True , False) -> let !tzs = countTrailingZeros $ complement bv - in odd tzs - -- NOT p - (False, False, True , True ) -> even w == even n - -- Logical non-implication - (False, True , False, False) -> n == 1 - -- NOT q - (False, True , False, True ) -> not $ n `testBit` (fromEnum w - 1) - -- Logical XOR - (False, True , True , False) -> odd $ popCount n - -- Logical NAND - (False, True , True , True ) -> let !tos = countTrailingZeros $ complement bv - !x = bit (fromEnum w) - 1 - !y = bit (fromEnum w) - 2 - in if n == x || n == y - then odd tos - else even tos - -- Logical AND - (True , False, False, False) -> n == bit (fromEnum w) - 1 - -- Logical XNOR - (True , False, False, True ) -> let !pc = popCount n - in if even w - then even pc - else odd pc - -- Const q - (True , False, True , False) -> n `testBit` (fromEnum w - 1) - -- Logical implication - (True , False, True , True ) -> even $ countTrailingZeros bv - -- Const p - (True , True , False, False) -> n `testBit` 0 - -- Converse implication - -- only False when of the form <01+> - (True , True , False, True ) -> n /= bit (fromEnum w) - 2 - -- Logical OR - (True , True , True , False) -> n > 0 - -- Constant True - (True , True , True , True ) -> True - - -- | /O(1)/ - {-# INLINE headEx #-} - headEx (BV 0 _) = error "Call to Data.MonoFoldable.headEx on an empty BitVector!" - headEx (BV _ n) = n `testBit` 0 - - -- | /O(1)/ - {-# INLINE lastEx #-} - lastEx (BV 0 _) = error "Call to Data.MonoFoldable.lastEx on an empty BitVector!" - lastEx (BV w n) = n `testBit` (fromEnum w - 1) - - -- | /O(n)/ - {-# INLINE maximumByEx #-} - maximumByEx _ (BV 0 _) = error "Call to Data.MonoFoldable.maximumByEx on an empty BitVector!" - maximumByEx _ (BV 1 n) = n /= 0 - maximumByEx f bv = maximumBy f $ toBits bv - - -- | /O(n)/ - {-# INLINE minimumByEx #-} - minimumByEx _ (BV 0 _) = error "Call to Data.MonoFoldable.minimumByEx on an empty BitVector!" - minimumByEx _ (BV 1 n) = n /= 0 - minimumByEx f bv = minimumBy f $ toBits bv - - -- | /O(1)/ - {-# INLINE oelem #-} - oelem _ (BV 0 _) = False - oelem True (BV _ n) = n > 0 - oelem False (BV w n) = n < bit (fromEnum w) - 1 - - -- | /O(1)/ - {-# INLINE onotElem #-} - onotElem e = not . oelem e - - --- | --- @since 1.0.0 -instance MonoFoldableWithKey BitVector where - - -- | /O(n)/ - {-# INLINE otoKeyedList #-} - otoKeyedList (BV w n) = - let go 0 = [] - go !c = let !k = w - c - !v = n `testBit` fromEnum k - !i = c - 1 - in (k, v) : go i - in go w - - -- | /O(n)/ - {-# INLINE ofoldMapWithKey #-} - ofoldMapWithKey f (BV w n) = - let go 0 = mempty - go !c = let !k = w - c - !v = n `testBit` fromEnum k - !i = c - 1 - !m = f k v - in m `mappend` go i - in go w - - -- | /O(n)/ - {-# INLINE ofoldrWithKey #-} - ofoldrWithKey f e (BV w n) = - let go 0 acc = acc - go !c acc = let !k = w - c - !i = c - 1 - !b = n `testBit` fromEnum k - in f k b $ go i acc - in go w e - - -- | /O(n)/ - {-# INLINE ofoldlWithKey #-} - ofoldlWithKey f e (BV w n) = go w e - where - go 0 acc = acc - go !c acc = let !k = w - c - !i = c - 1 - !b = n `testBit` fromEnum k - !a = f acc k b - in go i a - - --- | --- @since 0.1.0 -instance MonoFunctor BitVector where - - -- | /O(1)/ - {-# INLINE omap #-} - omap f bv@(BV w n) = - case (f False, f True) of - (False, False) -> BV w 0 - (True , True ) -> BV w $ bit (fromEnum w) - 1 - (False, True ) -> bv - (True , False) -> let !allOnes = bit (fromEnum w) - 1 - in BV w $ n `xor` allOnes - - --- | --- @since 1.0.0 -instance MonoIndexable BitVector where - - -- | /O(1)/ - {-# INLINE oindex #-} - oindex bv@(BV w _) i = fromMaybe errorMessage $ i `olookup` bv - where - errorMessage = error $ mconcat - [ "Data.BitVector.LittleEndian.oindex: " - , "The index " - , show i - , " was greater than or equal to the length of the bit vector " - , show w - ] - - --- | --- @since 1.0.0 -instance MonoKeyed BitVector where - - -- | /O(n)/ - {-# INLINE omapWithKey #-} - omapWithKey f (BV w n) = - let go 0 acc = acc - go !c acc = let !k = w - c - !i = fromEnum k - !j = c - 1 - !b = n `testBit` i - !a | f k b = acc `setBit` i - | otherwise = acc - in go j a - in go w $ BV w 0 - - --- | --- @since 1.0.0 -instance MonoLookup BitVector where - - -- | /O(1)/ - {-# INLINE olookup #-} - olookup k (BV w n) - | k <= w = Nothing - | otherwise = Just $ n `testBit` fromEnum k - - --- | --- @since 0.1.0 -instance MonoTraversable BitVector where - - -- | /O(n)/ - {-# INLINE otraverse #-} - otraverse f = fmap fromBits . traverse f . toBits - - -- | /O(n)/ - {-# INLINE omapM #-} - omapM = otraverse - - --- | --- @since 1.0.0 -instance MonoTraversableWithKey BitVector where - - -- | /O(n)/ - {-# INLINE otraverseWithKey #-} - otraverseWithKey f = fmap fromBits . traverseWithKey (f . toEnum) . toBits - - --- | --- @since 1.0.0 -instance MonoZip BitVector where - - -- | /O(1)/ - {-# INLINE ozipWith #-} - ozipWith f lhs@(BV w1 p) rhs@(BV w2 q) = - let !w0 = min w1 w2 - !mask = bit (fromEnum w0) - 1 - bv = BV w0 . (mask .&.) - not' = nat . complement - -- See the following entry for explanation: - -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators - -- - -- cases of f p q - in case (f True True, f True False, f False True, f False False) of - -- Contradiction (Const False) - (False, False, False, False) -> bv 0 - -- Logical NOR - (False, False, False, True ) -> bv $ not' lhs .&. not' rhs - -- Converse non-implication - (False, False, True , False) -> bv $ not' lhs .&. q - -- NOT p - (False, False, True , True ) -> bv $ not' lhs - -- Logical non-implication - (False, True , False, False) -> bv $ p .&. not' rhs - -- NOT q - (False, True , False, True ) -> bv $ not' rhs - -- Logical XOR - (False, True , True , False) -> bv $ p `xor` q - -- Logical NAND - (False, True , True , True ) -> bv $ not' lhs .|. not' rhs - -- Logical AND - (True , False, False, False) -> bv $ p .&. q - -- Logical XNOR - (True , False, False, True ) -> bv $ (p .&. q) .|. (not' lhs .&. not' rhs) - -- Const q - (True , False, True , False) -> bv q - -- Logical implication - (True , False, True , True ) -> bv $ not' lhs .|. q - -- Const p - (True , True , False, False) -> bv p - -- Converse implication - (True , True , False, True ) -> bv $ p .|. not' rhs - -- Logical OR - (True , True , True , False) -> bv $ p .|. q - -- Constant True - (True , True , True , True ) -> bv $ bit (fromEnum w0) - 1 - - --- | --- @since 1.0.0 -instance MonoZipWithKey BitVector where - - {-# INLINE ozipWithKey #-} - ozipWithKey f (BV w1 n) (BV w2 m) = - let w0 = min w1 w2 - go 0 _ = 0 - go c e = let !k = w0 - c - !i = fromEnum k - !j = c - 1 - !b = f k (n `testBit` i) (m `testBit` i) - !a = e `shiftL` 1 - !v = if b then e else 0 - in v + go j a - in BV w0 $ go w0 1 - - --- | --- @since 0.1.0 -instance NFData BitVector where - - -- Already a strict data type, - -- always in normal form. - {-# INLINE rnf #-} - rnf = const () - - --- | --- @since 0.1.0 -instance Ord BitVector where - - {-# INLINE compare #-} - compare lhs rhs = - case comparing dim lhs rhs of - EQ -> comparing nat lhs rhs - v -> v - - --- | --- @since 0.1.0 -instance Semigroup BitVector where - - {-# INLINE (<>) #-} - (<>) (BV x m) (BV y n) = BV (x + y) $ (n `shiftL` fromEnum x) + m - - {-# INLINABLE sconcat #-} - sconcat xs = BV w' n' - where - (w', _, n') = foldl' f (0, 0, 0) xs - f (bitCountW, bitCountI, natVal) (BV w n) = - (bitCountW + w, bitCountI + fromEnum w, natVal + (n `shiftL` bitCountI)) - - {-# INLINE stimes #-} - stimes 0 _ = mempty - stimes e (BV w n) = BV limit $ go start n - where - !x = fromEnum w - !start = fromEnum $ limit - w - !limit = (toEnum . fromEnum) e * w - go 0 !acc = acc - go !k !acc = go (k-x) $ (n `shiftL` k) + acc - - --- | --- @since 0.1.0 -instance Show BitVector where - - show (BV w n) = mconcat [ "[", show w, "]", show n ] - - --- | --- @since 1.0.0 -instance TextShow BitVector where - - showb (BV w n) = mconcat [ "[", showb w, "]", showb n ] - - --- | --- Create a bit vector from a /little-endian/ list of bits. --- --- The following will hold: --- --- > length . takeWhile not === countLeadingZeros . fromBits --- > length . takeWhile not . reverse === countTrailingZeros . fromBits --- --- /Time:/ \(\, \mathcal{O} \left( n \right) \) --- --- /Since: 0.1.0/ --- --- ==== __Examples__ --- --- >>> fromBits [True, False, False] --- [3]1 -{-# INLINE fromBits #-} -fromBits :: Foldable f => f Bool -> BitVector -fromBits bs = BV (toEnum n) k - -- NB: 'setBit' is a GMP function, faster than regular addition. - where - (!n, !k) = foldl' go (0, 0) bs - go (!i, !v) b - | b = (i+1, v `setBit` i) - | otherwise = (i+1, v) - - --- | --- Create a /little-endian/ list of bits from a bit vector. --- --- The following will hold: --- --- > length . takeWhile not . toBits === countLeadingZeros --- > length . takeWhile not . reverse . toBits === countTrailingZeros --- --- /Time:/ \(\, \mathcal{O} \left( n \right) \) --- --- /Since:/ 0.1.0 --- --- ==== __Examples__ --- --- >>> toBits [4]11 --- [True, True, False, True] -{-# INLINE toBits #-} -toBits :: BitVector -> [Bool] -toBits (BV w n) = go (fromEnum w) [] - where - go 0 bs = bs - go i bs = let !j = i - 1 - in go j $ n `testBit` j : bs - - --- | --- Create a bit vector of non-negative dimension from an integral value. --- --- The integral value will be treated as an /signed/ number and the resulting --- bit vector will contain the two's complement bit representation of the number. --- --- The integral value will be interpreted as /little-endian/ so that the least --- significant bit of the integral value will be the value of the 0th index of --- the resulting bit vector and the most significant bit of the integral value --- will be at index @dimension − 1@. --- --- Note that if the bit representation of the integral value exceeds the --- supplied dimension, then the most significant bits will be truncated in the --- resulting bit vector. --- --- /Time:/ \(\, \mathcal{O} \left( 1 \right) \) --- --- /Since: 0.1.0/ --- --- ==== __Examples__ --- --- >>> fromNumber 8 96 --- [8]96 --- --- >>> fromNumber 8 -96 --- [8]160 --- --- >>> fromNumber 6 96 --- [6]32 -{-# INLINE[1] fromNumber #-} -fromNumber - :: Integral v - => Word -- ^ dimension of bit vector - -> v -- ^ /signed, little-endian/ integral value - -> BitVector -fromNumber !dimValue !intValue = BV dimValue . intToNat $ mask .&. v - where - !v | signum int < 0 = negate $ shiftL 1 intBits - int - | otherwise = int - - !int = toInteger intValue - !intBits = I# (integerLog2# int) - !mask = 2 ^ dimValue - 1 - - -{-# RULES -"fromNumber/Natural" forall w (n :: Natural). fromNumber w n = BV w n -"fromNumber/Word" forall w (v :: Word ). fromNumber w v = BV w (wordToNatural v) - #-} - - --- | --- Two's complement value of a bit vector. --- --- /Time:/ \(\, \mathcal{O} \left( 1 \right) \) --- --- /Since: 0.1.0/ --- --- ==== __Examples__ --- --- >>> toSignedNumber [4]0 --- 0 --- --- >>> toSignedNumber [4]3 --- 3 --- --- >>> toSignedNumber [4]7 --- 7 --- --- >>> toSignedNumber [4]8 --- -8 --- --- >>> toSignedNumber [4]12 --- -4 --- --- >>> toSignedNumber [4]15 --- -1 -{-# INLINE toSignedNumber #-} -toSignedNumber :: Num a => BitVector -> a -toSignedNumber (BV w n) = fromInteger v - where - !i = toInteger n - !v | n `testBit` (fromEnum w - 1) = negate $ shiftL 1 (fromEnum w) - i - | otherwise = i - - --- | --- Unsigned value of a bit vector. --- --- /Time:/ \(\, \mathcal{O} \left( 1 \right) \) --- --- /Since: 0.1.0/ --- --- ==== __Examples__ --- --- >>> toSignedNumber [4]0 --- 0 --- --- >>> toSignedNumber [4]3 --- 3 --- --- >>> toSignedNumber [4]7 --- 7 --- --- >>> toSignedNumber [4]8 --- 8 --- --- >>> toSignedNumber [4]12 --- 12 --- --- >>> toSignedNumber [4]15 --- 15 -{-# INLINE[1] toUnsignedNumber #-} -toUnsignedNumber :: Num a => BitVector -> a -toUnsignedNumber = fromInteger . toInteger . nat - - -{-# RULES -"toUnsignedNumber/Natural" toUnsignedNumber = nat - #-} - - --- | --- Get the dimension of a 'BitVector'. Preferable to 'finiteBitSize' as it --- returns a type which cannot represent a non-negative value and a 'BitVector' --- must have a non-negative dimension. --- --- /Time:/ \(\, \mathcal{O} \left( 1 \right) \) --- --- /Since: 0.1.0/ --- --- ==== __Examples__ --- --- >>> dimension [2]3 --- 2 --- --- >>> dimension [4]12 --- 4 -{-# INLINE dimension #-} -dimension :: BitVector -> Word -dimension = dim - - --- | --- Determine if /any/ bits are set in the 'BitVector'. --- Faster than @(0 ==) . popCount@. --- --- /Time:/ \(\, \mathcal{O} \left( 1 \right) \) --- --- /Since: 0.1.0/ --- --- ==== __Examples__ --- --- >>> isZeroVector [2]3 --- False --- --- >>> isZeroVector [4]0 --- True -{-# INLINE isZeroVector #-} -isZeroVector :: BitVector -> Bool -isZeroVector = (0 ==) . nat - - --- | --- Get the /inclusive/ range of bits in 'BitVector' as a new 'BitVector'. --- --- If either of the bounds of the subrange exceed the bit vector's dimension, --- the resulting subrange will append an infinite number of zeroes to the end --- of the bit vector in order to satisfy the subrange request. --- --- /Time:/ \(\, \mathcal{O} \left( 1 \right) \) --- --- /Since: 0.1.0/ --- --- ==== __Examples__ --- --- >>> subRange (0,2) [4]7 --- [3]7 --- --- >>> subRange (1, 3) [4]7 --- [3]3 --- --- >>> subRange (2, 4) [4]7 --- [3]1 --- --- >>> subRange (3, 5) [4]7 --- [3]0 --- --- >>> subRange (10, 20) [4]7 --- [10]0 -{-# INLINE subRange #-} -subRange :: (Word, Word) -> BitVector -> BitVector -subRange (!lower, !upper) (BV _ n) - | lower > upper = zeroBits - | otherwise = - case toInt lower of - Nothing -> zeroBits - Just i -> - let b = n `shiftR` i - in case toInt upper of - Nothing -> - let m = toEnum $ maxBound - i + 1 - in BV m $ n `shiftR` i - Just j -> - let x = j - i - m | x == maxBound = x - | otherwise = x + 1 - in BV (toEnum m) $ b .&. pred (1 `shiftL` m) - - - --- | --- Determine the number of /set/ bits in the 'BitVector' up to, /but not including/, index @k@. --- --- To determine the number of /unset/ bits in the 'BitVector`, use @k - rank bv k@. --- --- Uses "broadword programming." Efficient on small 'BitVector's (10^3). --- --- /Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'. --- --- /Since: 1.1.0/ --- --- ==== __Examples__ --- --- >>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65 --- --- >>> rank bv 0 -- Count how many ones in the first 0 bits (always returns 0) --- 0 --- --- >>> rank bv 1 -- Count how many ones in the first 1 bits --- 1 --- --- >>> rank bv 2 -- Count how many ones in the first 2 bits --- 1 --- --- >>> rank bv 65 -- Count how many ones in the first 65 bits --- 1 --- --- >>> rank bv 66 -- Count how many ones in the first 66 bits --- 1 --- --- >>> rank bv 128 -- Count how many ones in all 128 bits --- 2 --- --- >>> rank bv 129 -- Out-of-bounds, fails gracefully --- 2 -rank - :: BitVector - -> Word -- ^ \(k\), the rank index - -> Word -- ^ Set bits within the rank index -rank _ 0 = 0 -- There can be no set bits /before/ the 0-th bit -rank (BV 0 _) _ = 0 -- There can be no set bits in a bit-vector of length 0 -rank (BV w natVal) k = - let j = min k w - in case natVal of - NatS# v -> wordRank (W# v) j - NatJ# (BN# v) -> f (ByteArray v) j - where - f :: ByteArray -> Word -> Word - f byteArr x = g x 0 - where - g :: Word -> Int -> Word - g !j !i - | j < bitsInWord = wordRank value j - | otherwise = let !v = toEnum $ popCount value - in v + g (j - bitsInWord) (i+1) - where - value :: Word - value = byteArr `indexByteArray` i - - --- | --- Find the index of the k-th set bit in the 'BitVector'. --- --- To find the index of the k-th /unset/ bit in the 'BitVector`, use @select (complement bv) k@. --- --- Uses "broadword programming." Efficient on small 'BitVector's (10^3). --- --- /Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'. --- --- /Since: 1.1.0/ --- --- ==== __Examples__ --- --- >>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65 --- --- >>> select bv 0 -- Find the 0-indexed position of the first one bit --- Just 0 --- --- >>> select bv 1 -- Find the 0-indexed position of the second one bit --- Just 65 --- --- >>> select bv 2 -- There is no 3rd set bit, `select` fails --- Nothing -select - :: BitVector - -> Word -- ^ \(k\), the select index - -> Maybe Word -- ^ index of the k-th set bit -select (BV 0 _) _ = Nothing -- There can be no set bits in a bit-vector of length 0 -select (BV w natVal) k = - case natVal of - NatS# v -> let !u = W# v - in if toEnum (popCount u) <= k - then Nothing - else Just $ wordSelect u k - NatJ# (BN# v) -> f (ByteArray v) k - where - f :: ByteArray -> Word -> Maybe Word - f byteArr x = g x 0 - where - g :: Word -> Int -> Maybe Word - g !j !i - | toEnum i * bitsInWord >= w = Nothing - | j < ones = Just $ wordSelect value j - | otherwise = (bitsInWord +) <$> g (j - ones) (i+1) - where - ones = toEnum $ popCount value - value :: Word - value = byteArr `indexByteArray` i - - --- | --- Number of bits in a 'Word'. --- --- Used for "broadword programming." -{-# INLINE bitsInWord #-} -bitsInWord :: Word -bitsInWord = toEnum $ finiteBitSize (undefined :: Word) - - --- | --- Clever use of 'popCount' and masking to get the number of set bits up to, --- /but not including/, index "k." -wordRank - :: Word -- ^ Input 'Word' - -> Word -- ^ Index k, upt to which we count all set bits, k in range [ 0, finiteBitCount - 1 ] - -> Word -- ^ THe number of bits set within index "k." -wordRank v x = toEnum . popCount $ suffixOnes .&. v - where - suffixOnes = (1 `shiftL` fromEnum x) - 1 - - --- | --- Perform binary search with 'popCount' to locate the k-th set bit -wordSelect - :: Word -- ^ Input 'Word' - -> Word -- ^ Find the k-th set bit, k in range [ 0, finiteBitCount - 1 ] - -> Word -- ^ The index of the k-th set bit -wordSelect v = go 0 63 - where - go :: Word -> Word -> Word -> Word - go lb ub x - | lb + 1 == ub = if x == 0 && v `testBit` fromEnum lb then lb else ub - | otherwise = - let !lowOnes = toEnum . popCount $ lowMask .&. v - in if lowOnes > x - then go lb mb x - else go (mb + 1) ub (x - lowOnes) - where - mb = ((ub - lb) `div` 2) + lb - lowMask = makeMask lb mb - - makeMask i j = wideMask `xor` thinMask - where - thinMask = (1 `shiftL` fromEnum i) - 1 - wideMask - | j == bitsInWord - 1 = maxBound :: Word - | otherwise = (1 `shiftL` (fromEnum j + 1)) - 1 - - -toInt :: Word -> Maybe Int -toInt w - | w > maxInt = Nothing - | otherwise = Just $ fromEnum w - where - maxInt = toEnum (maxBound :: Int) - - --- | --- While similar to the function 'naturalFromInteger' exported from GHC.Natural, --- this function does not throw an exception when an negative valued 'Integer' --- is supplied and is also compatible with base < 4.10.0.0. -{-# INLINE intToNat #-} --- {-# NOINLINE intToNat #-} -intToNat :: Integer -> Natural -intToNat (S# i#) | isTrue# (i# >=# 0#) = NatS# (int2Word# i#) -intToNat (Jp# bn) | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn) - | otherwise = NatJ# bn -intToNat _ = NatS# (int2Word# 0#) +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +A bit vector similar to @Data.BitVector@ from the +, however the endianness is +reversed. This module defines /little-endian/ pseudo–size-polymorphic +bit vectors. + +Little-endian bit vectors are isomorphic to a @[Bool]@ with the /least/ +significant bit at the head of the list and the /most/ significant bit at the +end of the list. Consequently, the endianness of a bit vector affects the semantics +of many type-classes that have a linear ordering. + +For an implementation of bit vectors which are isomorphic to a @[Bool]@ with the /most/ +significant bit at the head of the list and the /least/ significant bit at the +end of the list, use the + package. + +This module does /not/ define numeric instances for 'BitVector'. This is +intentional! To interact with a bit vector as an 'Integral' value, +convert the 'BitVector' using either 'toSignedNumber' or 'toUnsignedNumber'. + +This module defines 'rank' and 'select' operations for 'BitVector' as a +. +These operations are not /o(1)/ so 'BitVector' is not a /true/ succinct data +structure. However, it could potentially be extend to support this in the +future. +-} + +{-# Language Safe #-} + +module Data.BitVector.LittleEndian + ( BitVector () + -- * Bit-stream conversion + , fromBits + , toBits + -- * Numeric conversion + , fromNumber + , toSignedNumber + , toUnsignedNumber + -- * Queries + , dimension + , isZeroVector + , subRange + -- * Rank / Select + , rank + , select + ) where + +import Data.BitVector.LittleEndian.Internal diff --git a/src/core/Data/BitVector/LittleEndian/Internal.hs b/src/core/Data/BitVector/LittleEndian/Internal.hs new file mode 100644 --- /dev/null +++ b/src/core/Data/BitVector/LittleEndian/Internal.hs @@ -0,0 +1,831 @@ +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +Little-endian bit vectors are isomorphic to a @[Bool]@ with the /least/ +significant bit at the head of the list and the /most/ significant bit at the +end of the list. Consequently, the endianness of a bit vector affects the semantics of the +following typeclasses: + + * Bits + * FiniteBits + * Semigroup + * Monoid + * MonoAdjustable + * MonoIndexable + * MonoKeyed + * MonoLookup + * MonoFoldable + * MonoFoldableWithKey + * MonoTraversable + * MonoTraversableWithKey + * MonoZipWithKey + +-} + +{-# Language BangPatterns #-} +{-# Language CPP #-} +{-# Language DeriveAnyClass #-} +{-# Language DeriveDataTypeable #-} +{-# Language DeriveGeneric #-} +{-# Language DerivingStrategies #-} +{-# Language MagicHash #-} +{-# Language OverloadedStrings #-} +{-# Language Trustworthy #-} +{-# Language TypeFamilies #-} +{-# Language UnicodeSyntax #-} + +module Data.BitVector.LittleEndian.Internal + ( BitVector (..) + , dimension + , fromBits + , fromNumber + , isZeroVector + , rank + , select + , subRange + , toBits + , toSignedNumber + , toUnsignedNumber + ) where + +import Control.DeepSeq +import Control.Monad (when) +import Data.Bits +import Data.Data +import Data.Foldable +import Data.Hashable +import Data.Int +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Monoid () +import Data.Ord +import Data.Primitive.ByteArray +import Data.Semigroup +import Data.Word +import Foreign.C.Types +import GHC.Exts +import GHC.Generics (Generic) +import GHC.Integer.GMP.Internals +import GHC.Integer.Logarithms +import GHC.Natural +import Text.Read + + +{-| +A little-endian bit vector of non-negative dimension. +-} +data BitVector + = BV + { dim :: {-# UNPACK #-} !Word + -- ^ The /dimension/ of a bit vector. + , nat :: !Natural + -- ^ The value of a bit vector, as a natural number. + } + + +{-| @since 0.1.0 -} +deriving stock instance Data BitVector + + +{-| @since 0.1.0 -} +deriving stock instance Generic BitVector + + +{-| @since 0.1.0 -} +deriving anyclass instance NFData BitVector + + +{-| @since 0.1.0 -} +instance Bits BitVector where + + {-# INLINE (.&.) #-} + (BV w1 a) .&. (BV w2 b) = BV (max w1 w2) $ a .&. b + + {-# INLINE (.|.) #-} + (BV w1 a) .|. (BV w2 b) = BV (max w1 w2) $ a .|. b + + {-# INLINE xor #-} + (BV w1 a) `xor` (BV w2 b) = BV (max w1 w2) $ a `xor` b + + {-# INLINE complement #-} + complement (BV w n) = BV w $ shiftL 1 (fromEnum w) - 1 - n + + {-# INLINE zeroBits #-} + zeroBits = BV 0 0 + + {-# INLINE bit #-} + bit i = BV (succ $ toEnum i) (shiftL 1 i) + + {-# INLINE clearBit #-} + -- We do this more complicated operation rather than call 'clearBit' + -- because it is undefined for Natural in base < 4.10.0.0 + clearBit bv@(BV w n) i + | i < 0 || toEnum i >= w + = bv + | otherwise + = let + !allBits = pred . shiftL 1 $ fromEnum w + !mask = bit i `xor` allBits + in BV w $ n .&. mask + + {-# INLINE setBit #-} + setBit bv@(BV w n) i + | i < 0 = bv + | otherwise = BV (max w j) $ n `setBit` i + where !j = toEnum i + 1 + + {-# INLINE testBit #-} + testBit (BV w n) i = i >= 0 && toEnum i < w && n `testBit` i + + bitSize (BV w _) = fromEnum w + + {-# INLINE bitSizeMaybe #-} + bitSizeMaybe (BV w _) = Just $ fromEnum w + + {-# INLINE isSigned #-} + isSigned = const False + + {-# INLINE shiftL #-} + shiftL (BV w n) k + | toEnum k > w = BV w 0 + | otherwise = BV w $ shiftL n k .&. pred (shiftL 1 (fromEnum w)) + + {-# INLINE shiftR #-} + shiftR (BV w n) k + | toEnum k > w = BV w 0 + | otherwise = BV w $ shiftR n k + + {-# INLINE rotateL #-} + rotateL bv 0 = bv + rotateL bv@(BV 0 _) _ = bv + rotateL bv@(BV 1 _) _ = bv + rotateL bv@(BV w n) k + | k < 0 = bv + | j >= w = go . fromEnum $ j `mod` w + | otherwise = go k + where + !j = toEnum k + go 0 = bv + go i = BV w $ h + l + where + !v = fromEnum w + !d = v - i + !m = pred $ shiftL 1 d + !l = n `shiftR` d + !h = (n .&. m) `shiftL` i + + {-# INLINE rotateR #-} + rotateR bv 0 = bv + rotateR bv@(BV 0 _) _ = bv + rotateR bv@(BV 1 _) _ = bv + rotateR bv@(BV w n) k + | k < 0 = bv + | j >= w = go . fromEnum $ j `mod` w + | otherwise = go k + where + !j = toEnum k + go 0 = bv + go i = BV w $ h + l + where + !v = fromEnum w + !d = v - i + !m = pred $ shiftL 1 i + !l = n `shiftR` i + !h = (n .&. m) `shiftL` d + + {-# INLINE popCount #-} + popCount = popCount . nat + + +{-| @since 0.1.0 -} +instance Eq BitVector where + + {-# INLINE (==) #-} + (==) (BV w1 m) (BV w2 n) = w1 == w2 && naturalToBigNat m == naturalToBigNat n + where + naturalToBigNat (NatS# w ) = wordToBigNat w + naturalToBigNat (NatJ# bn) = bn + + +{-| @since 0.1.0 -} +instance FiniteBits BitVector where + + {-# INLINE finiteBitSize #-} + finiteBitSize = fromEnum . dim + + {-# INLINE countTrailingZeros #-} + countTrailingZeros (BV w 0) = fromEnum w + countTrailingZeros (BV w n) = + let lastSetBit = I# (integerLog2# (toInteger n)) in max 0 $ fromEnum w - lastSetBit - 1 + + {-# INLINE countLeadingZeros #-} + countLeadingZeros (BV w natVal) = case natVal of + NatS# 0## -> fromEnum w + NatS# v -> let iMask = complement zeroBits `xor` (2 ^ w - 1) in countTrailingZeros $ iMask .|. W# v + NatJ# (BN# arr) -> + let byteArr = ByteArray arr + !x = fromEnum w + (q, r) = x `quotRem` fromEnum bitsInWord + wMask = complement zeroBits `xor` (2 ^ r - 1) :: Word + + g :: Int -> Int + g !i = + let value :: Word + value = byteArr `indexByteArray` i + in if i >= q + then countTrailingZeros $ wMask .|. value + else + let !v = countTrailingZeros value + in if v == fromEnum bitsInWord then v + g (i + 1) else v + in g 0 + + +{-| @since 0.1.0 -} +instance Hashable BitVector where + + hash (BV w n) = fromEnum w `hashWithSalt` hash n + + hashWithSalt salt bv = salt `hashWithSalt` hash bv + + +{-| @since 0.1.0 -} +instance Monoid BitVector where + + {-# INLINE mappend #-} + mappend = (<>) + + {-# INLINE mconcat #-} + mconcat bs = case bs of + [] -> mempty + x : xs -> sconcat $ x :| xs + + {-# INLINE mempty #-} + mempty = BV 0 0 + + +{-| @since 0.1.0 -} +instance Ord BitVector where + + {-# INLINE compare #-} + compare lhs rhs = case comparing dim lhs rhs of + EQ -> comparing nat lhs rhs + v -> v + + +{-| @since 1.2.0 -} +instance Read BitVector where + + {-# INLINABLE readPrec #-} + readPrec = do + Punc "[" <- lexP + w <- step readPrec + Punc "]" <- lexP + n <- step readPrec + -- Check if n exceeds the bit vector's width + when (n >= 1 `shiftL` fromEnum w) pfail + pure $ BV w n + + readListPrec = readListPrecDefault + + +{-| @since 0.1.0 -} +instance Semigroup BitVector where + + {-# INLINE (<>) #-} + (<>) (BV x m) (BV y n) = BV (x + y) $ (n `shiftL` fromEnum x) + m + + {-# INLINABLE sconcat #-} + sconcat xs = BV w' n' + where + (w', _, n') = foldl' f (0, 0, 0) xs + f (bitCountW, bitCountI, natVal) (BV w n) = + (bitCountW + w, bitCountI + fromEnum w, natVal + (n `shiftL` bitCountI)) + + {-# INLINE stimes #-} + stimes 0 _ = mempty + stimes e (BV w n) = BV limit $ go start n + where + !x = fromEnum w + !start = fromEnum $ limit - w + !limit = (toEnum . fromEnum) e * w + go 0 !acc = acc + go k !acc = go (k - x) $ (n `shiftL` k) + acc + + +{-| @since 0.1.0 -} +instance Show BitVector where + + show (BV w n) = fold ["[", show w, "]", show n] + + +{-| +Create a bit vector from a /little-endian/ list of bits. + +The following will hold: + +> length . takeWhile not === countLeadingZeros . fromBits +> length . takeWhile not . reverse === countTrailingZeros . fromBits + +/Time:/ \(\, \mathcal{O} \left( n \right) \) + +/Since: 0.1.0/ + +==== __Examples__ + +>>> fromBits [True, False, False] +[3]1 +-} +{-# INLINABLE fromBits #-} +fromBits :: Foldable f => f Bool -> BitVector +fromBits bs = BV (toEnum n) k + -- NB: 'setBit' is a GMP function, faster than regular addition. + where + (!n, !k) = foldl' go (0, 0) bs + go :: Bits b => (Int, b) -> Bool -> (Int, b) + go (!i, !v) b + | b = (i + 1, v `setBit` i) + | otherwise = (i + 1, v) + + +{-| +Create a /little-endian/ list of bits from a bit vector. + +The following will hold: + +> length . takeWhile not . toBits === countLeadingZeros +> length . takeWhile not . reverse . toBits === countTrailingZeros + +/Time:/ \(\, \mathcal{O} \left( n \right) \) + +/Since:/ 0.1.0 + +==== __Examples__ + +>>> toBits [4]11 +[True, True, False, True] +-} +{-# INLINABLE toBits #-} +toBits :: BitVector -> [Bool] +toBits (BV w n) = go (fromEnum w) [] + where + go 0 bs = bs + go i bs = let !j = i - 1 in go j $ n `testBit` j : bs + + +{-| +Create a bit vector of non-negative dimension from an integral value. + +The integral value will be treated as an /signed/ number and the resulting +bit vector will contain the two's complement bit representation of the number. + +The integral value will be interpreted as /little-endian/ so that the least +significant bit of the integral value will be the value of the 0th index of +the resulting bit vector and the most significant bit of the integral value +will be at index @dimension − 1@. + +Note that if the bit representation of the integral value exceeds the +supplied dimension, then the most significant bits will be truncated in the +resulting bit vector. + +/Time:/ \(\, \mathcal{O} \left( 1 \right) \) + +/Since: 0.1.0/ + +==== __Examples__ + +>>> fromNumber 8 96 +[8]96 + +>>> fromNumber 8 -96 +[8]160 + +>>> fromNumber 6 96 +[6]32 +-} +{-# INLINE [1] fromNumber #-} +{-# SPECIALISE fromNumber :: Word -> CBool -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CChar -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CInt -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CIntMax -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CIntPtr -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CLLong -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CLong -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CPtrdiff -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CSChar -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CShort -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CSigAtomic -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CSize -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CUChar -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CUInt -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CUIntMax -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CUIntPtr -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CULLong -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CULong -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CUShort -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> CWchar -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Int -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Int8 -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Int16 -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Int32 -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Int64 -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Integer -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Word8 -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Word16 -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Word32 -> BitVector #-} +{-# SPECIALISE fromNumber :: Word -> Word64 -> BitVector #-} +fromNumber + :: Integral v + => Word -- ^ dimension of bit vector + -> v -- ^ /signed, little-endian/ integral value + -> BitVector +fromNumber !dimValue !intValue = BV dimValue . intToNat $ mask .&. v + where + !v + | signum int < 0 = negate $ shiftL 1 intBits - int + | otherwise = int + + !int = toInteger intValue + !intBits = I# (integerLog2# int) + !mask = 2 ^ dimValue - 1 + + +{-# RULES +"fromNumber/Natural" forall w (n :: Natural). fromNumber w n = BV w n +"fromNumber/Word" forall w (v :: Word ). fromNumber w v = BV w (wordToNatural v) + #-} + + +{-| +Two's complement value of a bit vector. + +/Time:/ \(\, \mathcal{O} \left( 1 \right) \) + +/Since: 0.1.0/ + +==== __Examples__ + +>>> toSignedNumber [4]0 +0 + +>>> toSignedNumber [4]3 +3 + +>>> toSignedNumber [4]7 +7 + +>>> toSignedNumber [4]8 +-8 + +>>> toSignedNumber [4]12 +-4 + +>>> toSignedNumber [4]15 +-1 +-} +{-# INLINE toSignedNumber #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CBool #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CChar #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CInt #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CIntMax #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CIntPtr #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CLLong #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CLong #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CPtrdiff #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CSChar #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CShort #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CSigAtomic #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CSize #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CUChar #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CUInt #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CUIntMax #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CUIntPtr #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CULLong #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CULong #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CUShort #-} +{-# SPECIALISE toSignedNumber :: BitVector -> CWchar #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Int #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Int8 #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Int16 #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Int32 #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Int64 #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Integer #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Natural #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Word #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Word8 #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Word16 #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Word32 #-} +{-# SPECIALISE toSignedNumber :: BitVector -> Word64 #-} +toSignedNumber :: Num a => BitVector -> a +toSignedNumber (BV w n) = fromInteger v + where + !i = toInteger n + !v + | n `testBit` (fromEnum w - 1) = (+ 1) . negate $ shiftL 1 (fromEnum w) - i + | otherwise = i + + +{-| +Unsigned value of a bit vector. + +/Time:/ \(\, \mathcal{O} \left( 1 \right) \) + +/Since: 0.1.0/ + +==== __Examples__ + +>>> toUnsignedNumber [4]0 +0 + +>>> toUnsignedNumber [4]3 +3 + +>>> toUnsignedNumber [4]7 +7 + +>>> toUnsignedNumber [4]8 +8 + +>>> toUnsignedNumber [4]12 +12 + +>>> toUnsignedNumber [4]15 +15 +-} +{-# INLINE [1] toUnsignedNumber #-} +toUnsignedNumber :: Num a => BitVector -> a +toUnsignedNumber = fromInteger . toInteger . nat + + +{-# RULES +"toUnsignedNumber/Natural" toUnsignedNumber = nat + #-} + + +{-| +Get the dimension of a 'BitVector'. Preferable to 'finiteBitSize' as it +returns a type which cannot represent a non-negative value and a 'BitVector' +must have a non-negative dimension. + +/Time:/ \(\, \mathcal{O} \left( 1 \right) \) + +/Since: 0.1.0/ + +==== __Examples__ + +>>> dimension [2]3 +2 + +>>> dimension [4]12 +4 +-} +{-# INLINE dimension #-} +dimension :: BitVector -> Word +dimension = dim + + +{-| +Determine if /any/ bits are set in the 'BitVector'. +Faster than @(0 ==) . popCount@. + +/Time:/ \(\, \mathcal{O} \left( 1 \right) \) + +/Since: 0.1.0/ + +==== __Examples__ + +>>> isZeroVector [2]3 +False + +>>> isZeroVector [4]0 +True +-} +{-# INLINE isZeroVector #-} +isZeroVector :: BitVector -> Bool +isZeroVector = (0 ==) . nat + + +{-| +Get the /inclusive/ range of bits in 'BitVector' as a new 'BitVector'. + +If either of the bounds of the subrange exceed the bit vector's dimension, +the resulting subrange will append an infinite number of zeroes to the end +of the bit vector in order to satisfy the subrange request. + +/Time:/ \(\, \mathcal{O} \left( 1 \right) \) + +/Since: 0.1.0/ + +==== __Examples__ + +>>> subRange (0,2) [4]7 +[3]7 + +>>> subRange (1, 3) [4]7 +[3]3 + +>>> subRange (2, 4) [4]7 +[3]1 + +>>> subRange (3, 5) [4]7 +[3]0 + +>>> subRange (10, 20) [4]7 +[10]0 +-} +{-# INLINE subRange #-} +subRange :: (Word, Word) -> BitVector -> BitVector +subRange (!lower, !upper) (BV _ n) + | lower > upper = zeroBits + | otherwise = case toInt lower of + Nothing -> zeroBits + Just i -> + let b = n `shiftR` i + in case toInt upper of + Nothing -> let m = toEnum $ maxBound - i + 1 in BV m $ n `shiftR` i + Just j -> + let x = j - i + m + | x == maxBound = x + | otherwise = x + 1 + in BV (toEnum m) $ b .&. pred (1 `shiftL` m) + + +{-| +Determine the number of /set/ bits in the 'BitVector' up to, /but not including/, index @k@. + +To determine the number of /unset/ bits in the 'BitVector`, use @k - rank bv k@. + +Uses "broadword programming." Efficient on small 'BitVector's (10^3). + +/Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'. + +/Since: 1.1.0/ + +==== __Examples__ + +>>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65 + +>>> rank bv 0 -- Count how many ones in the first 0 bits (always returns 0) +0 + +>>> rank bv 1 -- Count how many ones in the first 1 bits +1 + +>>> rank bv 2 -- Count how many ones in the first 2 bits +1 + +>>> rank bv 65 -- Count how many ones in the first 65 bits +1 + +>>> rank bv 66 -- Count how many ones in the first 66 bits +1 + +>>> rank bv 128 -- Count how many ones in all 128 bits +2 + +>>> rank bv 129 -- Out-of-bounds, fails gracefully +2 +-} +rank + :: BitVector + -> Word -- ^ \(k\), the rank index + -> Word -- ^ Set bits within the rank index +rank _ 0 = 0 -- There can be no set bits /before/ the 0-th bit +rank (BV 0 _) _ = 0 -- There can be no set bits in a bit-vector of length 0 +rank (BV w natVal) k = + let j = min k w + in case natVal of + NatS# v -> wordRank (W# v) j + NatJ# (BN# v) -> f (ByteArray v) j + where + f :: ByteArray -> Word -> Word + f byteArr x = g x 0 + where + g :: Word -> Int -> Word + g !j !i + | j < bitsInWord = wordRank value j + | otherwise = let !v = toEnum $ popCount value in v + g (j - bitsInWord) (i + 1) + where + value :: Word + value = byteArr `indexByteArray` i + + +{-| +Find the index of the k-th set bit in the 'BitVector'. + +To find the index of the k-th /unset/ bit in the 'BitVector`, use @select (complement bv) k@. + +Uses "broadword programming." Efficient on small 'BitVector's (10^3). + +/Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'. + +/Since: 1.1.0/ + +==== __Examples__ + +>>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65 + +>>> select bv 0 -- Find the 0-indexed position of the first one bit +Just 0 + +>>> select bv 1 -- Find the 0-indexed position of the second one bit +Just 65 + +>>> select bv 2 -- There is no 3rd set bit, `select` fails +Nothing +-} +select + :: BitVector + -> Word -- ^ \(k\), the select index + -> Maybe Word -- ^ index of the k-th set bit +select (BV 0 _ ) _ = Nothing -- There can be no set bits in a bit-vector of length 0 +select (BV w natVal) k = case natVal of + NatS# v -> let !u = W# v in if toEnum (popCount u) <= k then Nothing else Just $ wordSelect u k + NatJ# (BN# v) -> f (ByteArray v) k + where + f :: ByteArray -> Word -> Maybe Word + f byteArr x = g x 0 + where + g :: Word -> Int -> Maybe Word + g !j !i + | toEnum i * bitsInWord >= w = Nothing + | j < ones = Just $ wordSelect value j + | otherwise = (bitsInWord +) <$> g (j - ones) (i + 1) + where + ones = toEnum $ popCount value + value :: Word + value = byteArr `indexByteArray` i + + +{-| +Number of bits in a 'Word'. + +Used for "broadword programming." +-} +{-# INLINE bitsInWord #-} +bitsInWord :: Word +bitsInWord = toEnum $ finiteBitSize (undefined :: Word) + + +{-| +Clever use of 'popCount' and masking to get the number of set bits up to, +/but not including/, index "k." +-} +wordRank + :: Word -- ^ Input 'Word' + -> Word -- ^ Index k, up to which we count all set bits, k in range [ 0, finiteBitCount - 1 ] + -> Word -- ^ THe number of bits set within index "k." +wordRank v x = toEnum . popCount $ suffixOnes .&. v where suffixOnes = (1 `shiftL` fromEnum x) - 1 + + +{-| +Perform binary search with 'popCount' to locate the k-th set bit +-} +wordSelect + :: Word -- ^ Input 'Word' + -> Word -- ^ Find the k-th set bit, k in range [ 0, finiteBitCount - 1 ] + -> Word -- ^ The index of the k-th set bit +wordSelect v = go 0 63 + where + go :: Word -> Word -> Word -> Word + go lb ub x + | lb + 1 == ub + = if x == 0 && v `testBit` fromEnum lb then lb else ub + | otherwise + = let !lowOnes = toEnum . popCount $ lowMask .&. v + in if lowOnes > x then go lb mb x else go (mb + 1) ub (x - lowOnes) + where + mb = ((ub - lb) `div` 2) + lb + lowMask = makeMask lb mb + + makeMask :: Enum a => a -> Word -> Word + makeMask i j = wideMask `xor` thinMask + where + thinMask = (1 `shiftL` fromEnum i) - 1 + wideMask + | j == bitsInWord - 1 = maxBound :: Word + | otherwise = (1 `shiftL` (fromEnum j + 1)) - 1 + + +{-| +Convert a 'Word' to an 'Int', but only if the 'Word' value is small enough. +-} +toInt :: Word -> Maybe Int +toInt w + | w > maxInt = Nothing + | otherwise = Just $ fromEnum w + where maxInt = toEnum (maxBound :: Int) + + +{-| +While similar to the function 'naturalFromInteger' exported from GHC.Natural, +this function does not throw an exception when an negative valued 'Integer' +is supplied and is also compatible with base < 4.10.0.0. +-} +{-# INLINE intToNat #-} +-- {-# NOINLINE intToNat #-} +intToNat :: Integer -> Natural +intToNat = naturalFromInteger diff --git a/src/full/Data/BitVector/LittleEndian/Instances.hs b/src/full/Data/BitVector/LittleEndian/Instances.hs new file mode 100644 --- /dev/null +++ b/src/full/Data/BitVector/LittleEndian/Instances.hs @@ -0,0 +1,22 @@ +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +Exposes the all the instances for 'Data.BitVector.LittleEndian.BitVector'. + +-} + +{-# Language NoImplicitPrelude #-} + +module Data.BitVector.LittleEndian.Instances + ( + ) where + +import Data.BitVector.LittleEndian.Binary () +import Data.BitVector.LittleEndian.MonoKeyed () +import Data.BitVector.LittleEndian.MonoTraversable () +import Data.BitVector.LittleEndian.QuickCheck () +import Data.BitVector.LittleEndian.TextShow () diff --git a/src/keys/Data/BitVector/LittleEndian/MonoKeyed.hs b/src/keys/Data/BitVector/LittleEndian/MonoKeyed.hs new file mode 100644 --- /dev/null +++ b/src/keys/Data/BitVector/LittleEndian/MonoKeyed.hs @@ -0,0 +1,236 @@ +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +Exposes the following instances for 'BitVector': + + * 'MonoAdjustable' + * 'MonoFoldableWithKey' + * 'MonoIndexable' + * 'MonoKeyed' + * 'MonoLookup' + * 'MonoTraversableWithKey' + * 'MonoZip' + * 'MonoZipWithKey' + +-} + +{-# Language BangPatterns #-} +{-# Language TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.BitVector.LittleEndian.MonoKeyed + ( + ) where + +import Data.BitVector.LittleEndian (BitVector) +import Data.BitVector.LittleEndian.Internal hiding (BitVector) +import Data.BitVector.LittleEndian.MonoTraversable () +import Data.Bits +import Data.Foldable (fold) +import Data.Key +import Data.Maybe (fromMaybe) +import Data.MonoTraversable () +import Data.MonoTraversable.Keys + + +{-| @since 1.0.0 -} +type instance MonoKey BitVector + = Word + + +{-| @since 1.0.0 -} +instance MonoAdjustable BitVector where + + -- | /O(1)/ + {-# INLINE oadjust #-} + oadjust f k bv@(BV w n) + | k >= w = bv + | v == b = bv + | otherwise = bv `complementBit` i + where + !i = fromEnum k + !v = n `testBit` i + !b = f v + + -- | /O(1)/ + {-# INLINE oreplace #-} + oreplace k v bv@(BV w _) + | k >= w = bv + | v = bv `setBit` i + | otherwise = bv `clearBit` i + where !i = fromEnum k + + +{-| @since 1.0.0 -} +instance MonoFoldableWithKey BitVector where + + -- | /O(n)/ + {-# INLINE otoKeyedList #-} + otoKeyedList (BV w n) = + let go 0 = [] + go c = + let !k = w - c + !v = n `testBit` fromEnum k + !i = c - 1 + in (k, v) : go i + in go w + + -- | /O(n)/ + {-# INLINE ofoldMapWithKey #-} + ofoldMapWithKey f (BV w n) = + let go 0 = mempty + go c = + let !k = w - c + !v = n `testBit` fromEnum k + !i = c - 1 + !m = f k v + in m `mappend` go i + in go w + + -- | /O(n)/ + {-# INLINE ofoldrWithKey #-} + ofoldrWithKey f e (BV w n) = + let go 0 acc = acc + go c acc = + let !k = w - c + !i = c - 1 + !b = n `testBit` fromEnum k + in f k b $ go i acc + in go w e + + -- | /O(n)/ + {-# INLINE ofoldlWithKey #-} + ofoldlWithKey f e (BV w n) = go w e + where + go 0 acc = acc + go c acc = + let !k = w - c + !i = c - 1 + !b = n `testBit` fromEnum k + !a = f acc k b + in go i a + + +{-| @since 1.0.0 -} +instance MonoIndexable BitVector where + + -- | /O(1)/ + {-# INLINE oindex #-} + oindex bv@(BV w _) i = fromMaybe errorMessage $ i `olookup` bv + where + errorMessage = error $ fold + [ "Data.BitVector.LittleEndian.oindex: " + , "The index " + , show i + , " was greater than or equal to the length of the bit vector " + , show w + ] + + +{-| @since 1.0.0 -} +instance MonoKeyed BitVector where + + -- | /O(n)/ + {-# INLINE omapWithKey #-} + omapWithKey f (BV w n) = + let go 0 acc = acc + go c acc = + let !k = w - c + !i = fromEnum k + !j = c - 1 + !b = n `testBit` i + !a + | f k b = acc `setBit` i + | otherwise = acc + in go j a + in go w $ BV w 0 + + +{-| @since 1.0.0 -} +instance MonoLookup BitVector where + + -- | /O(1)/ + {-# INLINE olookup #-} + olookup k (BV w n) + | k <= w = Nothing + | otherwise = Just $ n `testBit` fromEnum k + + +{-| @since 1.0.0 -} +instance MonoTraversableWithKey BitVector where + + -- | /O(n)/ + {-# INLINE otraverseWithKey #-} + otraverseWithKey f = fmap fromBits . traverseWithKey (f . toEnum) . toBits + + +{-| @since 1.0.0 -} +instance MonoZip BitVector where + + -- | /O(1)/ + {-# INLINE ozipWith #-} + ozipWith f lhs@(BV w1 p) rhs@(BV w2 q) = + let !w0 = min w1 w2 + !mask = bit (fromEnum w0) - 1 + bv = BV w0 . (mask .&.) + not' = nat . complement + in case (f True True, f True False, f False True, f False False) of + -- Contradiction (Const False) + (False, False, False, False) -> bv 0 + -- Logical NOR + (False, False, False, True ) -> bv $ not' lhs .&. not' rhs + -- Converse non-implication + (False, False, True , False) -> bv $ not' lhs .&. q + -- NOT p + (False, False, True , True ) -> bv $ not' lhs + -- Logical non-implication + (False, True , False, False) -> bv $ p .&. not' rhs + -- NOT q + (False, True , False, True ) -> bv $ not' rhs + -- Logical XOR + (False, True , True , False) -> bv $ p `xor` q + -- Logical NAND + (False, True , True , True ) -> bv $ not' lhs .|. not' rhs + -- Logical AND + (True , False, False, False) -> bv $ p .&. q + -- Logical XNOR + (True , False, False, True ) -> bv $ (p .&. q) .|. (not' lhs .&. not' rhs) + -- Const q + (True , False, True , False) -> bv q + -- Logical implication + (True , False, True , True ) -> bv $ not' lhs .|. q + -- Const p + (True , True , False, False) -> bv p + -- Converse implication + (True , True , False, True ) -> bv $ p .|. not' rhs + -- Logical OR + (True , True , True , False) -> bv $ p .|. q + -- Constant True + (True , True , True , True ) -> bv $ bit (fromEnum w0) - 1 + -- See the following entry for explanation: + -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators + -- + -- cases of f p q + + +{-| @since 1.0.0 -} +instance MonoZipWithKey BitVector where + + {-# INLINE ozipWithKey #-} + ozipWithKey f (BV w1 n) (BV w2 m) = + let w0 = min w1 w2 + go 0 _ = 0 + go c e = + let !k = w0 - c + !i = fromEnum k + !j = c - 1 + !b = f k (n `testBit` i) (m `testBit` i) + !a = e `shiftL` 1 + !v = if b then e else 0 + in v + go j a + in BV w0 $ go w0 1 diff --git a/src/libs/Data/BitVector/LittleEndian/Binary.hs b/src/libs/Data/BitVector/LittleEndian/Binary.hs new file mode 100644 --- /dev/null +++ b/src/libs/Data/BitVector/LittleEndian/Binary.hs @@ -0,0 +1,33 @@ +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +Exposes the 'Binary' instance for 'BitVector'. + +-} + +{-# Language CPP #-} +{-# Language Safe #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.BitVector.LittleEndian.Binary + ( + ) where + +import Control.Applicative (Applicative(liftA2)) +import Data.Binary +import Data.BitVector.LittleEndian (BitVector) +import Data.BitVector.LittleEndian.Internal hiding (BitVector) +#if MIN_VERSION_base(4,18,0) +import Prelude hiding (liftA2) +#endif + +{- | @since 1.2.0 -} +instance Binary BitVector where + + put (BV w n) = put w <> put n + + get = liftA2 BV get get diff --git a/src/libs/Data/BitVector/LittleEndian/MonoTraversable.hs b/src/libs/Data/BitVector/LittleEndian/MonoTraversable.hs new file mode 100644 --- /dev/null +++ b/src/libs/Data/BitVector/LittleEndian/MonoTraversable.hs @@ -0,0 +1,296 @@ +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +Exposes the following instances for 'BitVector': + + * 'MonoFoldable' + * 'MonoFunctor' + * 'MonoTraversable' + +-} + +{-# Language BangPatterns #-} +{-# Language TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.BitVector.LittleEndian.MonoTraversable + ( + ) where + +import Data.BitVector.LittleEndian (BitVector) +import Data.BitVector.LittleEndian.Internal hiding (BitVector) +import Data.Bits +import Data.Foldable +import Data.MonoTraversable +import Data.Monoid () + + +{-| @since 0.1.0 -} +type instance Element BitVector + = Bool + + +{-| @since 0.1.0 -} +instance MonoFoldable BitVector where + + {-# INLINE ofoldMap #-} + ofoldMap f (BV w n) = go m + where + !m = fromEnum w + go 0 = mempty + go c = + let !i = m - c + !j = c - 1 + !b = n `testBit` i + in f b `mappend` go j + + {-# INLINE ofoldr #-} + ofoldr f e (BV w n) = + let !m = fromEnum w + go 0 acc = acc + go c acc = + let !i = m - c + !j = c - 1 + !b = n `testBit` i + in f b $ go j acc + in go m e + + {-# INLINE ofoldl' #-} + ofoldl' f e (BV w n) = go m e + where + !m = fromEnum w + go 0 acc = acc + go c acc = + let !i = m - c + !j = c - 1 + !b = n `testBit` i + !a = f acc b + in go j a + + {-# INLINE otoList #-} + otoList = toBits + + -- | /O(1)/ + {-# INLINE oall #-} + oall _ (BV 0 _) = True + oall f (BV w n) = case (f False, f True) of + (False, False) -> False + (True , True ) -> True + (False, True ) -> n == bit (fromEnum w) - 1 + (True , False) -> n == 0 + + -- | /O(1)/ + {-# INLINE oany #-} + oany _ (BV 0 _) = False + oany f (BV w n) = case (f False, f True) of + (False, False) -> False + (True , True ) -> True + (False, True ) -> n > 0 + (True , False) -> n < bit (fromEnum w) - 1 + + -- | /O(1)/ + {-# INLINE onull #-} + onull = (== 0) . dim + + -- | /O(1)/ + {-# INLINE olength #-} + olength = fromEnum . dim + + -- | /O(1)/ + {-# INLINE olength64 #-} + olength64 = toEnum . olength + + {-# INLINE otraverse_ #-} + otraverse_ f (BV w n) = go (fromEnum w) + where + go 0 = pure () + go c = + let !j = c - 1 + !a = f (n `testBit` j) + in a *> go j + + {-# INLINE ofoldlM #-} + ofoldlM f e (BV w n) = go (fromEnum w) e + where + go 0 acc = pure acc + go c acc = + let !j = c - 1 + !x = f acc (n `testBit` j) + in x >>= go j + + {-# INLINE ofoldMap1Ex #-} + ofoldMap1Ex _ (BV 0 _) = Prelude.error "Data.MonoTraversable.ofoldMap1Ex on an empty BitVector!" + ofoldMap1Ex f (BV w n) = go 0 + where + !m = fromEnum w + go !c + | c >= m - 1 + = f $ n `testBit` c + | otherwise + = let + !j = c + 1 + !b = n `testBit` c + in f b <> go j + + -- | /O(1)/ + {-# INLINE ofoldr1Ex #-} + ofoldr1Ex _ ( BV 0 _) = Prelude.error "Data.MonoTraversable.ofoldr1Ex on an empty BitVector!" + ofoldr1Ex _ ( BV 1 n) = n > 0 + ofoldr1Ex f bv@(BV w n) = + -- See the following entry for explanation: + -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators + -- + -- cases of f p q + case (f True True, f True False, f False True, f False False) of + -- Contradiction (Const False) + (False, False, False, False) -> False + -- Logical NOR + (False, False, False, True) -> + let !zeros = toEnum $ countLeadingZeros bv + in if (w - zeros) == 1 || n == 0 then even zeros else odd zeros + -- Converse non-implication + -- Only True when of the form <0+1> + (False, False, True , False) -> n == bit (fromEnum w - 1) + -- NOT p + (False, False, True , True ) -> not (n `testBit` 0) + -- Logical non-implication + -- Only True when the number of leading ones is even + (False, True , False, False) -> let !los = countLeadingZeros $ complement bv in odd los + -- NOT q + (False, True , False, True ) -> let !v = n `testBit` (fromEnum w - 1) in if even w then not v else v + -- Logical XOR + (False, True , True , False) -> odd $ popCount n + -- Logical NAND + (False, True, True, True) -> + let !los = countLeadingZeros $ complement bv + !x = bit (fromEnum w - 1) - 1 + !y = bit (fromEnum w) - 1 + in if n == x || n == y then odd los else even los + -- Logical AND + (True, False, False, False) -> n == bit (fromEnum w) - 1 + -- Logical XNOR + (True, False, False, True ) -> let !pc = popCount n in if even w then even pc else odd pc + -- Const q + (True, False, True , False) -> n `testBit` (fromEnum w - 1) + -- Logical implication + -- only False when of the form <1+0> + (True, False, True , True ) -> let !i = fromEnum w - 1 in n /= bit i - 1 + -- Const p + (True, True , False, False) -> n `testBit` 0 + -- Converse implication + (True, True , False, True ) -> even $ countLeadingZeros bv + -- Logical OR + (True, True , True , False) -> n > 0 + -- Constant True + (True, True , True , True ) -> True + + -- | /O(n)/ + {-# INLINE ofoldl1Ex' #-} + ofoldl1Ex' _ ( BV 0 _) = Prelude.error "Data.MonoTraversable.ofoldl1Ex' on an empty BitVector!" + ofoldl1Ex' _ ( BV 1 n) = n > 0 + ofoldl1Ex' f bv@(BV w n) = + -- See the following entry for explanation: + -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators + -- + -- cases of f p q + case (f True True, f True False, f False True, f False False) of + -- Contradiction (Const False) + (False, False, False, False) -> False + -- Logical NOR + (False, False, False, True) -> + let !zeros = toEnum $ countTrailingZeros bv + in if (w - zeros) == 1 || n == 0 then even zeros else odd zeros + -- Converse non-implication + (False, False, True , False) -> let !zeros = countTrailingZeros $ complement bv in odd zeros + -- NOT p + (False, False, True , True ) -> even w == even n + -- Logical non-implication + (False, True , False, False) -> n == 1 + -- NOT q + (False, True , False, True ) -> not $ n `testBit` (fromEnum w - 1) + -- Logical XOR + (False, True , True , False) -> odd $ popCount n + -- Logical NAND + (False, True, True, True) -> + let !zeros = countTrailingZeros $ complement bv + !x = bit (fromEnum w) - 1 + !y = bit (fromEnum w) - 2 + in if n == x || n == y then odd zeros else even zeros + -- Logical AND + (True, False, False, False) -> n == bit (fromEnum w) - 1 + -- Logical XNOR + (True, False, False, True ) -> let !count = popCount n in if even w then even count else odd count + -- Const q + (True, False, True , False) -> n `testBit` (fromEnum w - 1) + -- Logical implication + (True, False, True , True ) -> even $ countTrailingZeros bv + -- Const p + (True, True , False, False) -> n `testBit` 0 + -- Converse implication + -- only False when of the form <01+> + (True, True , False, True ) -> n /= bit (fromEnum w) - 2 + -- Logical OR + (True, True , True , False) -> n > 0 + -- Constant True + (True, True , True , True ) -> True + + -- | /O(1)/ + {-# INLINE headEx #-} + headEx (BV 0 _) = error "Call to Data.MonoFoldable.headEx on an empty BitVector!" + headEx (BV _ n) = n `testBit` 0 + + -- | /O(1)/ + {-# INLINE lastEx #-} + lastEx (BV 0 _) = error "Call to Data.MonoFoldable.lastEx on an empty BitVector!" + lastEx (BV w n) = n `testBit` (fromEnum w - 1) + + -- | /O(n)/ + {-# INLINE maximumByEx #-} + maximumByEx _ (BV 0 _) = error "Call to Data.MonoFoldable.maximumByEx on an empty BitVector!" + maximumByEx _ (BV 1 n) = n /= 0 + maximumByEx f bv = maximumBy f $ toBits bv + + -- | /O(n)/ + {-# INLINE minimumByEx #-} + minimumByEx _ (BV 0 _) = error "Call to Data.MonoFoldable.minimumByEx on an empty BitVector!" + minimumByEx _ (BV 1 n) = n /= 0 + minimumByEx f bv = minimumBy f $ toBits bv + + -- | /O(1)/ + {-# INLINE oelem #-} + oelem _ (BV 0 _) = False + oelem True (BV _ n) = n > 0 + oelem False (BV w n) = n < bit (fromEnum w) - 1 + + -- | /O(1)/ + {-# INLINE onotElem #-} + onotElem e = not . oelem e + + +{-| @since 0.1.0 -} +instance MonoFunctor BitVector where + + -- | /O(1)/ + {-# INLINE omap #-} + omap f bv@(BV w n) = case (f False, f True) of + (False, False) -> BV w 0 + (True , True ) -> BV w $ bit (fromEnum w) - 1 + (False, True ) -> bv + (True , False) -> let !allOnes = bit (fromEnum w) - 1 in BV w $ n `xor` allOnes + + +{-| @since 0.1.0 -} +instance MonoTraversable BitVector where + + -- | /O(n)/ + {-# INLINE otraverse #-} + otraverse f = fmap fromBits . traverse f . toBits + + -- | /O(n)/ + {-# INLINE omapM #-} + omapM = otraverse diff --git a/src/libs/Data/BitVector/LittleEndian/QuickCheck.hs b/src/libs/Data/BitVector/LittleEndian/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/src/libs/Data/BitVector/LittleEndian/QuickCheck.hs @@ -0,0 +1,80 @@ +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +Exposes the 'Arbitrary' and 'CoArbitrary' instances for 'BitVector'. + +-} + +{-# Language Safe #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.BitVector.LittleEndian.QuickCheck + ( + ) where + +import Data.BitVector.LittleEndian (BitVector) +import Data.BitVector.LittleEndian.Internal hiding (BitVector) +import Data.Bits +import Data.Monoid () +import GHC.Natural +import Test.QuickCheck (Arbitrary(..), CoArbitrary(..), NonNegative(..), choose, suchThat, variant) + + +{-| @since 0.1.0 -} +instance Arbitrary BitVector where + + -- Arbitrary instance distribution weighting: + -- - 2% = (maxBound :: Word) + -- - 2% = (maxBound :: Word) + 1 + -- - 8% = all bits on + -- - 8% = all bits off + -- - 80% = any bit configuration + arbitrary = do + -- 1/25 chance of generating the boundary value at which the natural number + -- must use different Natural constructors: NatS# & NatJ# + n <- choose (0, 25 :: Word) + case n of + 0 -> boundaryValue + 1 -> allBitsOn + 2 -> allBitsOn + 3 -> allBitsOff + 4 -> allBitsOff + _ -> anyBitValue + where + allBitsOn = genBitVector $ Just True + allBitsOff = genBitVector $ Just False + anyBitValue = genBitVector Nothing + + boundaryValue = do + let numVal = maxBound :: Word + let dimVal = toEnum $ popCount numVal + let natVal = wordToNatural numVal + -- 50/50 change to generate above or below the constructor boundary + underBoundary <- arbitrary + let (lowerBound, naturalVal) + | underBoundary = (dimVal, natVal) + | otherwise = (dimVal + 1, natVal + 1) + widthVal <- (getNonNegative <$> arbitrary) `suchThat` (>= lowerBound) + pure $ BV widthVal naturalVal + + genBitVector spec = do + dimVal <- getNonNegative <$> arbitrary + let upperBound = shiftL 1 dimVal + -- 1/5 chance all bits on or all bits off + natVal <- case spec of + Just False -> pure $ naturalFromInteger 0 + Just True -> pure . naturalFromInteger $ upperBound - 1 + Nothing -> + fmap naturalFromInteger $ (getNonNegative <$> arbitrary) `suchThat` (< upperBound) + pure $ BV (toEnum dimVal) natVal + + +{-| @since 0.1.0 -} +instance CoArbitrary BitVector where + + coarbitrary bv = variant (dimension bv) diff --git a/src/libs/Data/BitVector/LittleEndian/TextShow.hs b/src/libs/Data/BitVector/LittleEndian/TextShow.hs new file mode 100644 --- /dev/null +++ b/src/libs/Data/BitVector/LittleEndian/TextShow.hs @@ -0,0 +1,29 @@ +{-| + +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +Exposes the 'TextShow' instance for 'BitVector'. + +-} + +{-# Language OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.BitVector.LittleEndian.TextShow + ( + ) where + +import Data.BitVector.LittleEndian (BitVector) +import Data.BitVector.LittleEndian.Internal hiding (BitVector) +import Data.Foldable (fold) +import TextShow (TextShow(showb)) + + +{-| @since 1.0.0 -} +instance TextShow BitVector where + + showb (BV w n) = fold ["[", showb w, "]", showb n] diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,11 @@ -allow-newer: true +compiler: + ghc-9.2.2 extra-deps: - - mono-traversable-keys-0.1.0 + - base-compat-0.12.1 + - base-compat-batteries-0.12.1 -resolver: lts-13.28 +resolver: + lts-19.5 + +require-stack-version: ">= 2.7" diff --git a/test/Data/BitVector/Visual.hs b/test/Data/BitVector/Visual.hs --- a/test/Data/BitVector/Visual.hs +++ b/test/Data/BitVector/Visual.hs @@ -1,40 +1,65 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-| +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +-} + +{-# Language DeriveDataTypeable #-} +{-# Language DeriveGeneric #-} +{-# Language DerivingStrategies #-} +{-# Language FlexibleInstances #-} +{-# Language GeneralizedNewtypeDeriving #-} +{-# Language MultiParamTypeClasses #-} + module Data.BitVector.Visual - ( VisualBitVector() - , VisualBitVectorSmall() - , HasBitVector(..) - )where + ( HasBitVector (..) + , VisualBitVector () + , VisualBitVectorSmall () + ) where import Control.DeepSeq -import Data.Bits import Data.BitVector.LittleEndian +import Data.Bits import Data.Data -import Data.Functor.Compose -import Data.Functor.Identity -import Data.Hashable -import Data.List.NonEmpty (NonEmpty(..)) +import Data.Foldable (fold) import Data.Monoid () -import Data.MonoTraversable -import Data.Semigroup import GHC.Generics import GHC.Natural -import Test.QuickCheck hiding (generate) +import Test.QuickCheck hiding (generate) import Test.SmallCheck.Series -newtype VisualBitVector = VBV BitVector - deriving (Data, Eq, Ord, Generic, NFData, Typeable) +{-| +New-typed 'BitVector' with special instances of: + * 'Bounded' constraining the *length ≤ 8.* + * 'Show' providing a more detailed rendering suitable for use with testing frameworks which display counterexamples. +-} +newtype VisualBitVector + = VBV BitVector + deriving newtype (Eq, NFData, Ord) + deriving stock (Data, Generic) -newtype VisualBitVectorSmall = VBVS BitVector - deriving (Data, Eq, Ord, Generic, NFData, Typeable) +{-| +New-typed 'BitVector' with special instances of: + * 'Bounded' constraining the *length ≤ 3.* + * 'Show' providing a more detailed rendering suitable for use with testing frameworks which display counterexamples. +-} +newtype VisualBitVectorSmall + = VBVS BitVector + deriving newtype (Eq, NFData, Ord) + deriving stock (Data, Generic) + + +{-| +Type-class for accessing 'BitVector' from structures. +Intended to facilitate generic testing code operating on either 'BitVector', 'VisualBitVector', or 'VisualBitVectorSmall' types. +-} class HasBitVector a where getBitVector :: a -> BitVector @@ -89,78 +114,63 @@ instance Enum VisualBitVector where toEnum n = go $ n `mod` (bit 9 - 1) - where - go i = VBV $ fromNumber (toEnum dim) num - where - (num, off, dim) = getEnumContext i + where + go :: (Integral v, FiniteBits v) => v -> VisualBitVector + go i = VBV $ fromNumber (toEnum dim) num where (num, _, dim) = getEnumContext i - fromEnum (VBV bv) = - case dim of - 0 -> 0 - n -> num + 2^dim - 1 - where - num = toUnsignedNumber bv - dim = dimension bv + fromEnum (VBV bv) = case dim of + 0 -> 0 + n -> num + 2 ^ n - 1 + where + num = toUnsignedNumber bv + dim = dimension bv instance Enum VisualBitVectorSmall where toEnum n = go $ n `mod` (bit 4 - 1) - where - go i = VBVS $ fromNumber (toEnum dim) num - where - (num, off, dim) = getEnumContext i + where + go :: (Integral v, FiniteBits v) => v -> VisualBitVectorSmall + go i = VBVS $ fromNumber (toEnum dim) num where (num, _, dim) = getEnumContext i - fromEnum (VBVS bv) = - case dim of - 0 -> 0 - n -> num + 2^dim - 1 - where - num = toUnsignedNumber bv - dim = dimension bv + fromEnum (VBVS bv) = case dim of + 0 -> 0 + n -> num + 2 ^ n - 1 + where + num = toUnsignedNumber bv + dim = dimension bv instance Monad m => Serial m VisualBitVector where series = generate $ const allVBVs - where - allVBVs = toEnum <$> [0 .. fromEnum (maxBound :: VisualBitVector)] + where allVBVs = toEnum <$> [0 .. fromEnum (maxBound :: VisualBitVector)] instance Monad m => Serial m VisualBitVectorSmall where series = generate $ const allVBVs - where - allVBVs = toEnum <$> [0 .. fromEnum (maxBound :: VisualBitVectorSmall)] + where allVBVs = toEnum <$> [0 .. fromEnum (maxBound :: VisualBitVectorSmall)] instance Show VisualBitVector where - show (VBV bv) = mconcat - [ "[" - , show $ dimension bv - , "]" - , "<" - , foldMap (\b -> if b then "1" else "0") $ toBits bv - , ">" - ] + show (VBV bv) = + fold ["[", show $ dimension bv, "]", "<", foldMap (\b -> if b then "1" else "0") $ toBits bv, ">"] + instance Show VisualBitVectorSmall where - show (VBVS bv) = mconcat - [ "[" - , show $ dimension bv - , "]" - , "<" - , foldMap (\b -> if b then "1" else "0") $ toBits bv - , ">" - ] + show (VBVS bv) = + fold ["[", show $ dimension bv, "]", "<", foldMap (\b -> if b then "1" else "0") $ toBits bv, ">"] +getEnumContext :: (FiniteBits b, Num b) => b -> (b, b, Int) getEnumContext i = (num, off, dim) - where - num = i - off - off = bit dim - 1 - dim = logBase2 $ i + 1 - logBase2 x = finiteBitSize x - 1 - countLeadingZeros x + where + num = i - off + off = bit dim - 1 + dim = logBase2 $ i + 1 + logBase2 :: FiniteBits b => b -> Int + logBase2 x = finiteBitSize x - 1 - countLeadingZeros x diff --git a/test/TestSuite.hs b/test/TestSuite.hs --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,49 +1,66 @@ -{-# LANGUAGE FlexibleInstances #-} +{-| --- We apply this to suppress the deprecated warning cause by calls to 'bitSize' --- If there is a more fine-grained way to supress this warning without suppressing --- deprecated warnings for the whole module, we should do that instead. +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +-} + +{-# Language FlexibleInstances #-} +{-# Language ImportQualifiedPost #-} + + -- We apply this to suppress the deprecated warning cause by calls to 'bitSize' + -- If there is a more fine-grained way to suppress this warning without suppressing + -- deprecated warnings for the whole module, that should be done instead. {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -module Main ( main ) where +module Main + ( main + ) where -import Control.DeepSeq -import Data.Bits -import Data.BitVector.LittleEndian -import Data.BitVector.Visual -import Data.Foldable -import Data.Functor.Compose -import Data.Functor.Identity -import Data.Hashable -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Maybe -import Data.Monoid () -import Data.MonoTraversable -import Data.MonoTraversable.Keys -import Data.Semigroup -import Operator.Binary.Comparison -import Operator.Binary.Logical -import Operator.Unary.Logical -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.QuickCheck hiding ((.&.), forAll, testProperty) -import qualified Test.Tasty.QuickCheck as QC -import Test.Tasty.SmallCheck hiding ((===), (==>), Property, testProperty) -import qualified Test.Tasty.SmallCheck as SC -import TextShow (TextShow(showb), toString) +import Control.DeepSeq +import Data.BitVector.LittleEndian +import Data.BitVector.LittleEndian.Instances () +import Data.BitVector.Visual +import Data.Bits +import Data.Foldable +import Data.Functor.Compose +import Data.Functor.Identity +import Data.Hashable +import Data.Maybe +import Data.MonoTraversable +import Data.MonoTraversable.Keys +import Data.Monoid () +import Data.Semigroup +import GHC.Exts (IsList(..)) +import Operator.Binary.Comparison +import Operator.Binary.Logical +import Operator.Unary.Logical +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck hiding (forAll, testProperty, (.&.)) +import Test.Tasty.QuickCheck qualified as QC +import Test.Tasty.SmallCheck hiding (Property, testProperty, (==>)) +import Test.Tasty.SmallCheck qualified as SC +import TextShow (TextShow(showb), toString) infix 0 -=> -(-=>) :: QC.Testable p => Bool -> p -> Property +(-=>) :: QC.Testable p => Bool -> p -> Property (-=>) p q = not p .||. q +{-| +Complete test suite for the 'BitVector' type. +-} main :: IO () main = defaultMain testSuite testSuite :: TestTree -testSuite = testGroup "BitVector tests" +testSuite = testGroup + "BitVector tests" [ bitsTests , finiteBitsTests , hashableTests @@ -64,18 +81,19 @@ , textshowProperties , bitVectorProperties , bitVectorRankSelect - , monoFunctorEquivelence - , monoFoldableEquivelence - , monoZipEquivelence + , monoFunctorEquivalence + , monoFoldableEquivalence + , monoZipEquivalence ] bitsTests :: TestTree -bitsTests = testGroup "Properties of Bits" +bitsTests = testGroup + "Properties of Bits" [ QC.testProperty "∀ i ≥ 0, clearBit zeroBits i === zeroBits" zeroBitsAndClearBit , QC.testProperty "∀ i ≥ 0, setBit zeroBits i === bit i" zeroBitsAndSetBit , QC.testProperty "∀ i ≥ 0, testBit zeroBits i === False" zeroBitsAndTestBit - , testCase " popCount zeroBits === 0" zeroBitsAndPopCount + , testCase " popCount zeroBits === 0" zeroBitsAndPopCount , QC.testProperty "complement === omap not" complementOmapNot , QC.testProperty "(`setBit` i) === (.|. bit i)" setBitDefinition , QC.testProperty "(`clearBit` i) === (.&. complement (bit i))" clearBitDefinition @@ -89,190 +107,170 @@ , QC.testProperty "(`rotateR` i) . (`rotateL` i) === id" leftRightRotateIdentity , QC.testProperty "(`rotateL` i) . (`rotateR` i) === id" rightLeftRotateIdentity ] - where - zeroBitsAndClearBit :: NonNegative Int -> Property - zeroBitsAndClearBit (NonNegative i) = - clearBit (zeroBits :: BitVector) i === zeroBits + where + zeroBitsAndClearBit :: NonNegative Int -> Property + zeroBitsAndClearBit (NonNegative i) = clearBit (zeroBits :: BitVector) i === zeroBits - zeroBitsAndSetBit :: NonNegative Int -> Property - zeroBitsAndSetBit (NonNegative i) = - setBit (zeroBits :: BitVector) i === bit i + zeroBitsAndSetBit :: NonNegative Int -> Property + zeroBitsAndSetBit (NonNegative i) = setBit (zeroBits :: BitVector) i === bit i - zeroBitsAndTestBit :: NonNegative Int -> Property - zeroBitsAndTestBit (NonNegative i) = - testBit (zeroBits :: BitVector) i === False + zeroBitsAndTestBit :: NonNegative Int -> Property + zeroBitsAndTestBit (NonNegative i) = testBit (zeroBits :: BitVector) i === False - zeroBitsAndPopCount :: Assertion - zeroBitsAndPopCount = - popCount (zeroBits :: BitVector) @?= 0 + zeroBitsAndPopCount :: Assertion + zeroBitsAndPopCount = popCount (zeroBits :: BitVector) @?= 0 - complementOmapNot :: BitVector -> Property - complementOmapNot bv = - complement bv === omap not bv + complementOmapNot :: BitVector -> Property + complementOmapNot bv = complement bv === omap not bv - setBitDefinition :: NonNegative Int -> BitVector -> Property - setBitDefinition (NonNegative i) bv = - bv `setBit` i === bv .|. bit i + setBitDefinition :: NonNegative Int -> BitVector -> Property + setBitDefinition (NonNegative i) bv = bv `setBit` i === bv .|. bit i - clearBitDefinition :: NonNegative Int -> BitVector -> Property - clearBitDefinition (NonNegative i) bv = - i < (fromEnum . dimension) bv -=> - (bv `clearBit` i === bv .&. complement (zed .|. bit i)) - where - zed = fromNumber (dimension bv) (0 :: Integer) + clearBitDefinition :: NonNegative Int -> BitVector -> Property + clearBitDefinition (NonNegative i) bv = + i < (fromEnum . dimension) bv -=> (bv `clearBit` i === bv .&. complement (zed .|. bit i)) + where zed = fromNumber (dimension bv) (0 :: Integer) - complementBitDefinition :: NonNegative Int -> BitVector -> Property - complementBitDefinition (NonNegative i) bv = - bv `complementBit` i === bv `xor` bit i + complementBitDefinition :: NonNegative Int -> BitVector -> Property + complementBitDefinition (NonNegative i) bv = bv `complementBit` i === bv `xor` bit i - testBitAndSetBit :: NonNegative Int -> BitVector -> Bool - testBitAndSetBit (NonNegative i) = - (`testBit` i) . (`setBit` i) + testBitAndSetBit :: NonNegative Int -> BitVector -> Bool + testBitAndSetBit (NonNegative i) = (`testBit` i) . (`setBit` i) - testBitAndClearBit :: NonNegative Int -> BitVector -> Bool - testBitAndClearBit (NonNegative i) = - not . (`testBit` i) . (`clearBit` i) + testBitAndClearBit :: NonNegative Int -> BitVector -> Bool + testBitAndClearBit (NonNegative i) = not . (`testBit` i) . (`clearBit` i) - leftShiftPositiveShift :: NonNegative Int -> BitVector -> Property - leftShiftPositiveShift (NonNegative i) bv = - bv `shiftL` i === bv `shift` i - - rightShiftNegativeShift :: NonNegative Int -> BitVector -> Property - rightShiftNegativeShift (NonNegative i) bv = - bv `shiftR` i === bv `shift` (-i) - - leftRotatePositiveRotate :: NonNegative Int -> BitVector -> Property - leftRotatePositiveRotate (NonNegative i) bv = - bv `rotateL` i === bv `rotate` i + leftShiftPositiveShift :: NonNegative Int -> BitVector -> Property + leftShiftPositiveShift (NonNegative i) bv = bv `shiftL` i === bv `shift` i - rightRotateNegativeRotate :: NonNegative Int -> BitVector -> Property - rightRotateNegativeRotate (NonNegative i) bv = - bv `rotateR` i === bv `rotate` (-i) - - leftRightRotateIdentity :: NonNegative Int -> BitVector -> Property - leftRightRotateIdentity (NonNegative i) bv = - ((`rotateR` i) . (`rotateL` i)) bv === bv + rightShiftNegativeShift :: NonNegative Int -> BitVector -> Property + rightShiftNegativeShift (NonNegative i) bv = bv `shiftR` i === bv `shift` (-i) - rightLeftRotateIdentity :: NonNegative Int -> BitVector -> Property - rightLeftRotateIdentity (NonNegative i) bv = - ((`rotateL` i) . (`rotateR` i)) bv === bv + leftRotatePositiveRotate :: NonNegative Int -> BitVector -> Property + leftRotatePositiveRotate (NonNegative i) bv = bv `rotateL` i === bv `rotate` i + rightRotateNegativeRotate :: NonNegative Int -> BitVector -> Property + rightRotateNegativeRotate (NonNegative i) bv = bv `rotateR` i === bv `rotate` (-i) + leftRightRotateIdentity :: NonNegative Int -> BitVector -> Property + leftRightRotateIdentity (NonNegative i) bv = ((`rotateR` i) . (`rotateL` i)) bv === bv + + rightLeftRotateIdentity :: NonNegative Int -> BitVector -> Property + rightLeftRotateIdentity (NonNegative i) bv = ((`rotateL` i) . (`rotateR` i)) bv === bv + + finiteBitsTests :: TestTree -finiteBitsTests = testGroup "Properties of FiniteBits" +finiteBitsTests = testGroup + "Properties of FiniteBits" [ QC.testProperty "bitSize === finiteBitSize" finiteBitSizeIsBitSize , QC.testProperty "bitSizeMaybe === Just . finiteBitSize" finiteBitSizeIsBitSizeMaybe + , QC.testProperty "dimension === finiteBitSize" finiteBitSizeIsDimension , QC.testProperty "countLeadingZeros <= finiteBitSize" finiteBitSizeIsGreaterThanLeadingZeros , QC.testProperty "countTrailingZeros <= finiteBitSize" finiteBitSizeIsGreaterThanTrailingZeros , QC.testProperty "length . toBits === finiteBitSize" finiteBitSizeIsBitLength , QC.testProperty "length . takeWhile not === countLeadingZeros . fromBits" countLeadingZeroAndFromBits , QC.testProperty "length . takeWhile not . toBits === countLeadingZeros" countLeadingZeroAndToBits - , QC.testProperty "length . takeWhile not . reverse === countTrailingZeros . fromBits" countTrailingZeroAndFromBits - , QC.testProperty "length . takeWhile not . reverse . toBits === countTrailingZeros" countTrailingZeroAndToBits + , QC.testProperty + "length . takeWhile not . reverse === countTrailingZeros . fromBits" + countTrailingZeroAndFromBits + , QC.testProperty + "length . takeWhile not . reverse . toBits === countTrailingZeros" + countTrailingZeroAndToBits ] - where - finiteBitSizeIsBitSize :: BitVector -> Property - finiteBitSizeIsBitSize bv = - bitSize bv === finiteBitSize bv + where + finiteBitSizeIsBitSize :: BitVector -> Property + finiteBitSizeIsBitSize bv = bitSize bv === finiteBitSize bv - finiteBitSizeIsBitSizeMaybe :: BitVector -> Property - finiteBitSizeIsBitSizeMaybe bv = - bitSizeMaybe bv === (Just . finiteBitSize) bv - - finiteBitSizeIsDimension :: BitVector -> Property - finiteBitSizeIsDimension bv = - (fromEnum . dimension) bv === finiteBitSize bv + finiteBitSizeIsBitSizeMaybe :: BitVector -> Property + finiteBitSizeIsBitSizeMaybe bv = bitSizeMaybe bv === (Just . finiteBitSize) bv - finiteBitSizeIsGreaterThanLeadingZeros :: BitVector -> Bool - finiteBitSizeIsGreaterThanLeadingZeros bv = - countLeadingZeros bv <= finiteBitSize bv + finiteBitSizeIsDimension :: BitVector -> Property + finiteBitSizeIsDimension bv = (fromEnum . dimension) bv === finiteBitSize bv - finiteBitSizeIsGreaterThanTrailingZeros :: BitVector -> Bool - finiteBitSizeIsGreaterThanTrailingZeros bv = - countTrailingZeros bv <= finiteBitSize bv + finiteBitSizeIsGreaterThanLeadingZeros :: BitVector -> Bool + finiteBitSizeIsGreaterThanLeadingZeros bv = countLeadingZeros bv <= finiteBitSize bv - finiteBitSizeIsBitLength :: BitVector -> Property - finiteBitSizeIsBitLength bv = - (length . toBits) bv === finiteBitSize bv + finiteBitSizeIsGreaterThanTrailingZeros :: BitVector -> Bool + finiteBitSizeIsGreaterThanTrailingZeros bv = countTrailingZeros bv <= finiteBitSize bv - countLeadingZeroAndFromBits :: [Bool] -> Property - countLeadingZeroAndFromBits bs = - (length . takeWhile not) bs === (countLeadingZeros . fromBits) bs + finiteBitSizeIsBitLength :: BitVector -> Property + finiteBitSizeIsBitLength bv = (length . toBits) bv === finiteBitSize bv - countLeadingZeroAndToBits :: BitVector -> Property - countLeadingZeroAndToBits bv = - (length . takeWhile not . toBits) bv === countLeadingZeros bv + countLeadingZeroAndFromBits :: [Bool] -> Property + countLeadingZeroAndFromBits bs = (length . takeWhile not) bs === (countLeadingZeros . fromBits) bs - countTrailingZeroAndFromBits :: [Bool] -> Property - countTrailingZeroAndFromBits bs = - (length . takeWhile not . reverse) bs === (countTrailingZeros . fromBits) bs + countLeadingZeroAndToBits :: BitVector -> Property + countLeadingZeroAndToBits bv = (length . takeWhile not . toBits) bv === countLeadingZeros bv - countTrailingZeroAndToBits :: BitVector -> Property - countTrailingZeroAndToBits bv = - (length . takeWhile not . reverse . toBits) bv === countTrailingZeros bv + countTrailingZeroAndFromBits :: [Bool] -> Property + countTrailingZeroAndFromBits bs = + (length . takeWhile not . reverse) bs === (countTrailingZeros . fromBits) bs + countTrailingZeroAndToBits :: BitVector -> Property + countTrailingZeroAndToBits bv = + (length . takeWhile not . reverse . toBits) bv === countTrailingZeros bv + hashableTests :: TestTree -hashableTests = testGroup "Properties of Hashable" +hashableTests = testGroup + "Properties of Hashable" [ localOption (QuickCheckTests 10000) $ QC.testProperty "a == b -=> (hashWithSalt a) === (hashWithSalt b)" differentSaltsDifferentHashes ] - where - differentSaltsDifferentHashes :: BitVector -> Int -> Int -> Property - differentSaltsDifferentHashes bv salt1 salt2 = - salt1 /= salt2 -=> hashWithSalt salt1 bv /= hashWithSalt salt2 bv - + where + differentSaltsDifferentHashes :: BitVector -> Int -> Int -> Property + differentSaltsDifferentHashes bv salt1 salt2 = + salt1 /= salt2 -=> hashWithSalt salt1 bv /= hashWithSalt salt2 bv monoAdjustableProperties :: TestTree -monoAdjustableProperties = testGroup "Properites of a MonoAdjustable" +monoAdjustableProperties = testGroup + "Properties of a MonoAdjustable" [ QC.testProperty "oadjust id k === id" oadjustId , QC.testProperty "oadjust (f . g) k === oadjust f k . oadjust g k" oadjustComposition , QC.testProperty "oadjust f k === omapWithKey (\\i -> if i == k then f else id)" omapConditionality , QC.testProperty "oreplace k v === oreplace k v . oadjust f k" oreplaceNullification , QC.testProperty "oreplace (f v) k === oadjust f k . oreplace k v" oreplaceApplication ] - where - oadjustId :: Word -> BitVector -> Property - oadjustId k bv = - oadjust id k bv === bv + where + oadjustId :: Word -> BitVector -> Property + oadjustId k bv = oadjust id k bv === bv - oadjustComposition :: Blind (Bool -> Bool) -> Blind (Bool -> Bool) -> Word -> BitVector -> Property - oadjustComposition (Blind f) (Blind g) k bv = - oadjust (f . g) k bv === (oadjust f k . oadjust g k) bv + oadjustComposition :: Blind (Bool -> Bool) -> Blind (Bool -> Bool) -> Word -> BitVector -> Property + oadjustComposition (Blind f) (Blind g) k bv = oadjust (f . g) k bv === (oadjust f k . oadjust g k) bv - omapConditionality :: Blind (Bool -> Bool) -> Word -> BitVector -> Property - omapConditionality (Blind f) k bv = - oadjust f k bv === omapWithKey (\i -> if i == k then f else id) bv + omapConditionality :: Blind (Bool -> Bool) -> Word -> BitVector -> Property + omapConditionality (Blind f) k bv = + oadjust f k bv === omapWithKey (\i -> if i == k then f else id) bv - oreplaceNullification :: Blind (Bool -> Bool) -> Word -> Bool -> BitVector -> Property - oreplaceNullification (Blind f) k v bv = - oreplace k v bv === (oreplace k v . oadjust f k) bv + oreplaceNullification :: Blind (Bool -> Bool) -> Word -> Bool -> BitVector -> Property + oreplaceNullification (Blind f) k v bv = oreplace k v bv === (oreplace k v . oadjust f k) bv - oreplaceApplication :: Blind (Bool -> Bool) -> Word -> Bool -> BitVector -> Property - oreplaceApplication (Blind f) k v bv = - oreplace k (f v) bv === (oadjust f k . oreplace k v) bv + oreplaceApplication :: Blind (Bool -> Bool) -> Word -> Bool -> BitVector -> Property + oreplaceApplication (Blind f) k v bv = oreplace k (f v) bv === (oadjust f k . oreplace k v) bv monoFunctorProperties :: TestTree -monoFunctorProperties = testGroup "Properites of a MonoFunctor" +monoFunctorProperties = testGroup + "Properties of a MonoFunctor" [ QC.testProperty "omap id === id" omapId , QC.testProperty "omap (f . g) === omap f . omap g" omapComposition ] - where - omapId :: BitVector -> Property - omapId bv = - omap id bv === bv + where + omapId :: BitVector -> Property + omapId bv = omap id bv === bv - omapComposition :: Blind (Bool -> Bool) -> Blind (Bool -> Bool) -> BitVector -> Property - omapComposition (Blind f) (Blind g) bv = - omap (f . g) bv === (omap f . omap g) bv + omapComposition :: Blind (Bool -> Bool) -> Blind (Bool -> Bool) -> BitVector -> Property + omapComposition (Blind f) (Blind g) bv = omap (f . g) bv === (omap f . omap g) bv monoFoldableProperties :: TestTree -monoFoldableProperties = testGroup "Properties of MonoFoldable" +monoFoldableProperties = testGroup + "Properties of MonoFoldable" [ QC.testProperty "ofoldr f z t === appEndo (ofoldMap (Endo . f) t ) z" testFoldrFoldMap - , QC.testProperty "ofoldl' f z t === appEndo (getDual (ofoldMap (Dual . Endo . flip f) t)) z" testFoldlFoldMap + , QC.testProperty + "ofoldl' f z t === appEndo (getDual (ofoldMap (Dual . Endo . flip f) t)) z" + testFoldlFoldMap , QC.testProperty "ofoldr f z === ofoldr f z . otoList" testFoldr , QC.testProperty "ofoldl' f z === ofoldl' f z . otoList" testFoldl , QC.testProperty "ofoldr1Ex f === foldr1 f . otoList" testFoldr1 @@ -285,66 +283,54 @@ , QC.testProperty "lastEx === getLast . ofoldMap1Ex Last" testTail , QC.testProperty "oelem e /== onotElem e" testInclusionConsistency ] - where - testFoldrFoldMap :: Blind (Bool -> Word -> Word) -> Word -> BitVector -> Property - testFoldrFoldMap (Blind f) z bv = - ofoldr f z bv === appEndo (ofoldMap (Endo . f) bv) z + where + testFoldrFoldMap :: Blind (Bool -> Word -> Word) -> Word -> BitVector -> Property + testFoldrFoldMap (Blind f) z bv = ofoldr f z bv === appEndo (ofoldMap (Endo . f) bv) z - testFoldlFoldMap :: Blind (Word -> Bool -> Word) -> Word -> BitVector -> Property - testFoldlFoldMap (Blind f) z bv = - ofoldl' f z bv === appEndo (getDual (ofoldMap (Dual . Endo . flip f) bv)) z + testFoldlFoldMap :: Blind (Word -> Bool -> Word) -> Word -> BitVector -> Property + testFoldlFoldMap (Blind f) z bv = + ofoldl' f z bv === appEndo (getDual (ofoldMap (Dual . Endo . flip f) bv)) z - testFoldr :: Blind (Bool -> Word -> Word) -> Word -> BitVector -> Property - testFoldr (Blind f) z bv = - ofoldr f z bv === (ofoldr f z . otoList) bv + testFoldr :: Blind (Bool -> Word -> Word) -> Word -> BitVector -> Property + testFoldr (Blind f) z bv = ofoldr f z bv === (ofoldr f z . otoList) bv - testFoldl :: Blind (Word -> Bool -> Word) -> Word -> BitVector -> Property - testFoldl (Blind f) z bv = - ofoldl' f z bv === (ofoldl' f z . otoList) bv + testFoldl :: Blind (Word -> Bool -> Word) -> Word -> BitVector -> Property + testFoldl (Blind f) z bv = ofoldl' f z bv === (ofoldl' f z . otoList) bv --- testFoldr1 :: Blind (Bool -> Bool -> Bool) -> BitVector -> Property - testFoldr1 :: BinaryLogicalOperator -> BitVector -> Property --- testFoldr1 (Blind f) bv = - testFoldr1 x bv = - (not . onull) bv -=> ofoldr1Ex f bv === (foldr1 f . otoList) bv - where - f = getBinaryLogicalOperator x + -- testFoldr1 :: Blind (Bool -> Bool -> Bool) -> BitVector -> Property + testFoldr1 :: BinaryLogicalOperator -> BitVector -> Property + -- testFoldr1 (Blind f) bv = + testFoldr1 x bv = (not . onull) bv -=> ofoldr1Ex f bv === (foldr1 f . otoList) bv + where f = getBinaryLogicalOperator x - testFoldl1 :: Blind (Bool -> Bool -> Bool) -> BitVector -> Property - testFoldl1 (Blind f) bv = - (not . onull) bv -=> ofoldl1Ex' f bv === (foldl1 f . otoList) bv + testFoldl1 :: Blind (Bool -> Bool -> Bool) -> BitVector -> Property + testFoldl1 (Blind f) bv = (not . onull) bv -=> ofoldl1Ex' f bv === (foldl1 f . otoList) bv - testAll :: Blind (Bool -> Bool) -> BitVector -> Property - testAll (Blind f) bv = - oall f bv === (getAll . ofoldMap (All . f)) bv + testAll :: Blind (Bool -> Bool) -> BitVector -> Property + testAll (Blind f) bv = oall f bv === (getAll . ofoldMap (All . f)) bv - testAny :: Blind (Bool -> Bool) -> BitVector -> Property - testAny (Blind f) bv = - oany f bv === (getAny . ofoldMap (Any . f)) bv + testAny :: Blind (Bool -> Bool) -> BitVector -> Property + testAny (Blind f) bv = oany f bv === (getAny . ofoldMap (Any . f)) bv - testLength :: BitVector -> Property - testLength bv = - olength bv === (length . otoList) bv + testLength :: BitVector -> Property + testLength bv = olength bv === (length . otoList) bv - testNull :: BitVector -> Property - testNull bv = - onull bv === ((0 ==) . olength) bv + testNull :: BitVector -> Property + testNull bv = onull bv === ((0 ==) . olength) bv - testHead :: BitVector -> Property - testHead bv = - (not . onull) bv -=> headEx bv === (getFirst . ofoldMap1Ex First) bv + testHead :: BitVector -> Property + testHead bv = (not . onull) bv -=> headEx bv === (getFirst . ofoldMap1Ex First) bv - testTail :: BitVector -> Property - testTail bv = - (not . onull) bv -=> lastEx bv === (getLast . ofoldMap1Ex Last) bv + testTail :: BitVector -> Property + testTail bv = (not . onull) bv -=> lastEx bv === (getLast . ofoldMap1Ex Last) bv - testInclusionConsistency :: (Bool, BitVector) -> Property - testInclusionConsistency (e, bv) = - oelem e bv === (not . onotElem e) bv + testInclusionConsistency :: (Bool, BitVector) -> Property + testInclusionConsistency (e, bv) = oelem e bv === (not . onotElem e) bv monoFoldableWithKeyProperties :: TestTree -monoFoldableWithKeyProperties = testGroup "Properties of MonoFoldableWithKey" +monoFoldableWithKeyProperties = testGroup + "Properties of MonoFoldableWithKey" [ QC.testProperty "otoKeyedList === zip [0..] . otoList" testNaturalKeyedList , QC.testProperty "ofoldMapWithKey (const f) === ofoldMap f" testConstantFoldMap , QC.testProperty "ofoldrWithKey (const f) === ofoldr f" testConstantFoldr @@ -353,229 +339,229 @@ , QC.testProperty "ofoldrWithKey f === foldr (uncurry f) . otoKeyedList" testUncurriedFoldr , QC.testProperty "ofoldlWithKey f === foldl (uncurry . f) . otoKeyedList" testUncurriedFoldl ] - where - testNaturalKeyedList :: BitVector -> Property - testNaturalKeyedList bv = - otoKeyedList bv === (zip [0..] . otoList) bv + where + testNaturalKeyedList :: BitVector -> Property + testNaturalKeyedList bv = otoKeyedList bv === (zip [0 ..] . otoList) bv - testConstantFoldMap :: Blind (Bool -> [Word]) -> BitVector -> Property - testConstantFoldMap (Blind f) bv = - ofoldMapWithKey (const f) bv === ofoldMap f bv + testConstantFoldMap :: Blind (Bool -> [Word]) -> BitVector -> Property + testConstantFoldMap (Blind f) bv = ofoldMapWithKey (const f) bv === ofoldMap f bv - testConstantFoldr :: Blind (Bool -> Word -> Word) -> Word -> BitVector -> Property - testConstantFoldr (Blind f) e bv = - ofoldrWithKey (const f) e bv === ofoldr f e bv + testConstantFoldr :: Blind (Bool -> Word -> Word) -> Word -> BitVector -> Property + testConstantFoldr (Blind f) e bv = ofoldrWithKey (const f) e bv === ofoldr f e bv - testConstantFoldl :: Blind (Word -> Bool -> Word) -> Word -> BitVector -> Property - testConstantFoldl (Blind f) e bv = - ofoldlWithKey (const . f) e bv === ofoldl' f e bv + testConstantFoldl :: Blind (Word -> Bool -> Word) -> Word -> BitVector -> Property + testConstantFoldl (Blind f) e bv = ofoldlWithKey (const . f) e bv === ofoldl' f e bv - testUncurriedFoldMap :: Blind (Word -> Bool -> [Word]) -> BitVector -> Property - testUncurriedFoldMap (Blind f) bv = - ofoldMapWithKey f bv === (foldMap (uncurry f) . otoKeyedList) bv + testUncurriedFoldMap :: Blind (Word -> Bool -> [Word]) -> BitVector -> Property + testUncurriedFoldMap (Blind f) bv = ofoldMapWithKey f bv === (foldMap (uncurry f) . otoKeyedList) bv - testUncurriedFoldr :: Blind (Word -> Bool -> Word -> Word) -> Word -> BitVector -> Property - testUncurriedFoldr (Blind f) e bv = - ofoldrWithKey f e bv === (foldr (uncurry f) e . otoKeyedList) bv + testUncurriedFoldr :: Blind (Word -> Bool -> Word -> Word) -> Word -> BitVector -> Property + testUncurriedFoldr (Blind f) e bv = ofoldrWithKey f e bv === (foldr (uncurry f) e . otoKeyedList) bv - testUncurriedFoldl :: Blind (Word -> Word -> Bool -> Word) -> Word -> BitVector -> Property - testUncurriedFoldl (Blind f) e bv = - ofoldlWithKey f e bv === (foldl (uncurry . f) e . otoKeyedList) bv + testUncurriedFoldl :: Blind (Word -> Word -> Bool -> Word) -> Word -> BitVector -> Property + testUncurriedFoldl (Blind f) e bv = + ofoldlWithKey f e bv === (foldl (uncurry . f) e . otoKeyedList) bv monoKeyedProperties :: TestTree -monoKeyedProperties = testGroup "Properites of a MonoKeyed" +monoKeyedProperties = testGroup + "Properties of a MonoKeyed" [ QC.testProperty "omapWithKey (const id) === id" omapId , QC.testProperty "omapWithKey (\\k -> f k . g k) === omapWithKey f . omapWithKey g" omapComposition ] - where - omapId :: BitVector -> Property - omapId bv = - omapWithKey (const id) bv === bv + where + omapId :: BitVector -> Property + omapId bv = omapWithKey (const id) bv === bv - omapComposition :: Blind (Word -> Bool -> Bool) -> Blind (Word -> Bool -> Bool) -> BitVector -> Property - omapComposition (Blind f) (Blind g) bv = - omapWithKey (\k -> f k . g k) bv === (omapWithKey f . omapWithKey g) bv + omapComposition + :: Blind (Word -> Bool -> Bool) -> Blind (Word -> Bool -> Bool) -> BitVector -> Property + omapComposition (Blind f) (Blind g) bv = + omapWithKey (\k -> f k . g k) bv === (omapWithKey f . omapWithKey g) bv monoTraversableProperties :: TestTree -monoTraversableProperties = testGroup "Properties of MonoTraversable" +monoTraversableProperties = testGroup + "Properties of MonoTraversable" [ QC.testProperty "t . otraverse f === otraverse (t . f)" testNaturality , QC.testProperty "otraverse Identity === Identity" testIdentity - , QC.testProperty "otraverse (Compose . fmap g . f) === Compose . fmap (otraverse g) . otraverse f" testComposition + , QC.testProperty + "otraverse (Compose . fmap g . f) === Compose . fmap (otraverse g) . otraverse f" + testComposition , QC.testProperty "otraverse === omapM" testDefinitionEquality ] - where - testNaturality :: Blind (Bool -> [Bool]) -> BitVector -> Property - testNaturality (Blind f) bv = - (headMay . otraverse f) bv === otraverse (headMay . f) bv + where + testNaturality :: Blind (Bool -> [Bool]) -> BitVector -> Property + testNaturality (Blind f) bv = (headMay . otraverse f) bv === otraverse (headMay . f) bv - testIdentity :: BitVector -> Property - testIdentity bv = - otraverse Identity bv === Identity bv + testIdentity :: BitVector -> Property + testIdentity bv = otraverse Identity bv === Identity bv - testComposition :: Blind (Bool -> Either Word Bool) -> Blind (Bool -> Maybe Bool) -> BitVector -> Property - testComposition (Blind f) (Blind g) bv = - otraverse (Compose . fmap g . f) bv === (Compose . fmap (otraverse g) . otraverse f) bv + testComposition + :: Blind (Bool -> Either Word Bool) -> Blind (Bool -> Maybe Bool) -> BitVector -> Property + testComposition (Blind f) (Blind g) bv = + otraverse (Compose . fmap g . f) bv === (Compose . fmap (otraverse g) . otraverse f) bv - testDefinitionEquality :: Blind (Bool -> Maybe Bool) -> BitVector -> Property - testDefinitionEquality (Blind f) bv = - otraverse f bv === omapM f bv + testDefinitionEquality :: Blind (Bool -> Maybe Bool) -> BitVector -> Property + testDefinitionEquality (Blind f) bv = otraverse f bv === omapM f bv monoTraversableWithKeyProperties :: TestTree -monoTraversableWithKeyProperties = testGroup "Properties of MonoTraversableWithKey" +monoTraversableWithKeyProperties = testGroup + "Properties of MonoTraversableWithKey" [ QC.testProperty "t . otraverseWithKey f === otraverseWithKey (\\k -> t . f k)" testNaturality , QC.testProperty "otraverseWithKey (const Identity) === Identity" testIdentity - , QC.testProperty "otraverseWithKey (\\k -> Compose . fmap (g k) . f k) === Compose . fmap (otraverseWithKey g) . otraverseWithKey f" testComposition + , QC.testProperty + "otraverseWithKey (\\k -> Compose . fmap (g k) . f k) === Compose . fmap (otraverseWithKey g) . otraverseWithKey f" + testComposition , QC.testProperty "otraverseWithKey === omapWithKeyM" testDefinitionEquality ] - where - testNaturality :: Blind (Word -> Bool -> [Bool]) -> BitVector -> Property - testNaturality (Blind f) bv = - (headMay . otraverseWithKey f) bv === otraverseWithKey (\k -> headMay . f k) bv + where + testNaturality :: Blind (Word -> Bool -> [Bool]) -> BitVector -> Property + testNaturality (Blind f) bv = + (headMay . otraverseWithKey f) bv === otraverseWithKey (\k -> headMay . f k) bv - testIdentity :: BitVector -> Property - testIdentity bv = - otraverseWithKey (const Identity) bv === Identity bv + testIdentity :: BitVector -> Property + testIdentity bv = otraverseWithKey (const Identity) bv === Identity bv - testComposition :: Blind (Word -> Bool -> Either Word Bool) -> Blind (Word -> Bool -> Maybe Bool) -> BitVector -> Property - testComposition (Blind f) (Blind g) bv = - otraverseWithKey (\k -> Compose . fmap (g k) . f k) bv === (Compose . fmap (otraverseWithKey g) . otraverseWithKey f) bv + testComposition + :: Blind (Word -> Bool -> Either Word Bool) + -> Blind (Word -> Bool -> Maybe Bool) + -> BitVector + -> Property + testComposition (Blind f) (Blind g) bv = otraverseWithKey (\k -> Compose . fmap (g k) . f k) bv + === (Compose . fmap (otraverseWithKey g) . otraverseWithKey f) bv - testDefinitionEquality :: Blind (Word -> Bool -> Maybe Bool) -> BitVector -> Property - testDefinitionEquality (Blind f) bv = - otraverseWithKey f bv === omapWithKeyM f bv + testDefinitionEquality :: Blind (Word -> Bool -> Maybe Bool) -> BitVector -> Property + testDefinitionEquality (Blind f) bv = otraverseWithKey f bv === omapWithKeyM f bv monoZipProperties :: TestTree -monoZipProperties = testGroup "Properites of a MonoZip" - [ QC.testProperty "ozipWith const u u === ozipWith (flip const) u u === u" ozipWithConst +monoZipProperties = testGroup + "Properties of a MonoZip" + [ QC.testProperty "ozipWith const u u === ozipWith (const id) u u === u" ozipWithConst , QC.testProperty "ozipWith (flip f) x y === ozipWith f y x" ozipWithTransposition - , QC.testProperty "ozipWith (\\a b -> f (g a) (h b)) x y === ozipWith f (omap g x) (omap h y)" ozipWithComposition + , QC.testProperty + "ozipWith (\\a b -> f (g a) (h b)) x y === ozipWith f (omap g x) (omap h y)" + ozipWithComposition ] - where - ozipWithConst :: BitVector -> Property - ozipWithConst u = - ozipWith const u u === u .&&. ozipWith (flip const) u u === u + where + ozipWithConst :: BitVector -> Property + ozipWithConst u = ozipWith const u u === u .&&. ozipWith (const id) u u === u - ozipWithTransposition :: Blind (Bool -> Bool -> Bool) -> BitVector -> BitVector -> Property - ozipWithTransposition (Blind f) x y = - ozipWith (flip f) x y === ozipWith f y x + ozipWithTransposition :: Blind (Bool -> Bool -> Bool) -> BitVector -> BitVector -> Property + ozipWithTransposition (Blind f) x y = ozipWith (flip f) x y === ozipWith f y x - ozipWithComposition - :: Blind (Bool -> Bool -> Bool) - -> Blind (Bool -> Bool) - -> Blind (Bool -> Bool) -> BitVector -> BitVector -> Property - ozipWithComposition (Blind f) (Blind g) (Blind h) x y = - ozipWith (\a b -> f (g a) (h b)) x y === ozipWith f (omap g x) (omap h y) + ozipWithComposition + :: Blind (Bool -> Bool -> Bool) + -> Blind (Bool -> Bool) + -> Blind (Bool -> Bool) + -> BitVector + -> BitVector + -> Property + ozipWithComposition (Blind f) (Blind g) (Blind h) x y = + ozipWith (\a b -> f (g a) (h b)) x y === ozipWith f (omap g x) (omap h y) monoZipWithKeyProperties :: TestTree -monoZipWithKeyProperties = testGroup "Properites of a MonoZipWithKey" - [ QC.testProperty "ozipWithKey (const f) === ozipWith f" ozipWithKeyConst - ] - where - ozipWithKeyConst :: Blind (Bool -> Bool -> Bool) -> BitVector -> BitVector -> Property - ozipWithKeyConst (Blind f) x y = - ozipWithKey (const f) x y === ozipWith f x y +monoZipWithKeyProperties = testGroup + "Properties of a MonoZipWithKey" + [QC.testProperty "ozipWithKey (const f) === ozipWith f" ozipWithKeyConst] + where + ozipWithKeyConst :: Blind (Bool -> Bool -> Bool) -> BitVector -> BitVector -> Property + ozipWithKeyConst (Blind f) x y = ozipWithKey (const f) x y === ozipWith f x y +{- HLINT ignore monoidProperties "Monoid law, left identity" -} +{- HLINT ignore monoidProperties "Monoid law, right identity" -} +{- HLINT ignore monoidProperties "Use fold" -} monoidProperties :: TestTree -monoidProperties = testGroup "Properties of a Monoid" - [ QC.testProperty "left identity" leftIdentity +monoidProperties = testGroup + "Properties of a Monoid" + [ QC.testProperty "left identity" leftIdentity , QC.testProperty "right identity" rightIdentity - , QC.testProperty "mempty is associative" operationAssocativity + , QC.testProperty "mempty is associative" operationAssociativity , QC.testProperty "mconcat === foldr (<>) mempty" foldableApplication ] - where - leftIdentity :: BitVector -> Property - leftIdentity a = - mempty `mappend` a === a + where + leftIdentity :: BitVector -> Property + leftIdentity a = mempty `mappend` a === a - rightIdentity :: BitVector -> Property - rightIdentity a = - a `mappend` mempty === a + rightIdentity :: BitVector -> Property + rightIdentity a = a `mappend` mempty === a - operationAssocativity :: BitVector -> BitVector -> BitVector -> Property - operationAssocativity a b c = - a `mappend` (b `mappend` c) === (a `mappend` b) `mappend` c + operationAssociativity :: BitVector -> BitVector -> BitVector -> Property + operationAssociativity a b c = a `mappend` (b `mappend` c) === (a `mappend` b) `mappend` c - foldableApplication :: [BitVector] -> Property - foldableApplication bvs = - mconcat bvs === foldr mappend mempty bvs + foldableApplication :: [BitVector] -> Property + foldableApplication bvs = mconcat bvs === foldr mappend mempty bvs normalFormDataProperties :: TestTree -normalFormDataProperties = testGroup "Properties of NFData" - [ QC.testProperty "rnf result is finite" finiteReduction - ] - where - finiteReduction :: BitVector -> Property - finiteReduction bv = - rnf bv === () +normalFormDataProperties = testGroup + "Properties of NFData" + [QC.testProperty "rnf result is finite" finiteReduction] + where + finiteReduction :: BitVector -> Property + finiteReduction bv = rnf bv === () orderingProperties :: TestTree -orderingProperties = testGroup "Properties of an Ordering" - [ QC.testProperty "ordering preserves symetry" symetry +orderingProperties = testGroup + "Properties of an Ordering" + [ QC.testProperty "ordering preserves symmetry" symmetry , QC.testProperty "ordering is transitive (total)" transitivity ] - where - symetry :: BitVector -> BitVector -> Bool - symetry lhs rhs = - case (lhs `compare` rhs, rhs `compare` lhs) of - (EQ, EQ) -> True - (GT, LT) -> True - (LT, GT) -> True - _ -> False + where + symmetry :: BitVector -> BitVector -> Bool + symmetry lhs rhs = case (lhs `compare` rhs, rhs `compare` lhs) of + (EQ, EQ) -> True + (GT, LT) -> True + (LT, GT) -> True + _ -> False - transitivity :: BitVector -> BitVector -> BitVector -> Property - transitivity a b c = caseOne .||. caseTwo - where - caseOne = (a <= b && b <= c) -=> a <= c - caseTwo = (a >= b && b >= c) -=> a >= c + transitivity :: BitVector -> BitVector -> BitVector -> Property + transitivity a b c = caseOne .||. caseTwo + where + caseOne = (a <= b && b <= c) -=> a <= c + caseTwo = (a >= b && b >= c) -=> a >= c semigroupProperties :: TestTree -semigroupProperties = testGroup "Properties of a Semigroup" - [ localOption (QuickCheckTests 10000) - $ QC.testProperty "(<>) is associative" operationAssocativity +semigroupProperties = testGroup + "Properties of a Semigroup" + [ localOption (QuickCheckTests 10000) $ QC.testProperty "(<>) is associative" operationAssociativity , QC.testProperty "sconcat === foldr1 (<>)" foldableApplication , QC.testProperty "stimes n === mconcat . replicate n" repeatedApplication ] - where - operationAssocativity :: BitVector -> BitVector -> BitVector -> Property - operationAssocativity a b c = - a <> (b <> c) === (a <> b) <> c + where + operationAssociativity :: BitVector -> BitVector -> BitVector -> Property + operationAssociativity a b c = a <> (b <> c) === (a <> b) <> c - foldableApplication :: NonEmptyList BitVector -> Property - foldableApplication nel = - sconcat bvs === foldr1 mappend bvs - where - -- We do this because there is currently no Arbitrary inctance for NonEmpty - bvs = let x:xs = getNonEmpty nel - in x:|xs + foldableApplication :: NonEmptyList BitVector -> Property + foldableApplication manyBVs = sconcat bvs === foldr1 mappend bvs + where + -- We do this because there is currently no Arbitrary instance for NonEmpty + bvs = fromList $ getNonEmpty manyBVs - repeatedApplication :: NonNegative Int -> BitVector -> Property - repeatedApplication (NonNegative i) bv = - stimes i bv === (mconcat . replicate i) bv + repeatedApplication :: NonNegative Int -> BitVector -> Property + repeatedApplication (NonNegative i) bv = stimes i bv === (mconcat . replicate i) bv showProperties :: TestTree -showProperties = testGroup "Properties of Show" +showProperties = testGroup + "Properties of Show" [ QC.testProperty "show result is finite" finiteString , QC.testProperty "show result is non-null" nonNullString ] - where - finiteString :: BitVector -> Property - finiteString bv = - show bv === show bv - - nonNullString :: BitVector -> Bool - nonNullString = - not . null . show + where + finiteString :: BitVector -> Property + finiteString bv = show bv === show bv + nonNullString :: BitVector -> Bool + nonNullString = not . null . show + + + textshowProperties :: TestTree textshowProperties = testGroup "Properties of TextShow" [ QC.testProperty "textshow and show result agree" textshowCoherence @@ -586,224 +572,208 @@ (toString . showb $ bv) === show bv - bitVectorProperties :: TestTree -bitVectorProperties = testGroup "BitVector properties" +bitVectorProperties = testGroup + "BitVector properties" [ QC.testProperty "otoList === toBits" otoListTest , QC.testProperty "dimension === length . toBits" dimensionAndToBits , QC.testProperty "dimension === finiteBitSize" dimensionAndFiniteBitSize , QC.testProperty "fromBits . toBits === id" toBitsFromBits - , testCase "isZeroVector zeroBits" zeroBitsIsZeroVector + , testCase "isZeroVector zeroBits" zeroBitsIsZeroVector , QC.testProperty "isZeroVector === (0 ==) . popCount" popCountAndZeroVector , QC.testProperty "isZeroVector === all not . toBits" zeroVectorAndAllBitsOff , QC.testProperty "(0 ==) . toUnsignedNumber -=> isZeroVector" toUnsignedNumImpliesZeroVector , QC.testProperty "toSignedNumber . fromNumber === id" bitVectorUnsignedNumIdentity , QC.testProperty "isSigned == const False" noSignBitVector -- For an unknown reason, this test case causes GHC to panic! --- , QC.testProperty "i > j -=> subRange (i,j) === const zeroBits" badSubRangeEmptyResult + , QC.testProperty "i > j -=> subRange (i,j) === const zeroBits" badSubRangeEmptyResult , QC.testProperty "i <= j -=> dimension . subRange (i,j) === const (j - i + 1)" subRangeFixedDimension ] - where - otoListTest :: BitVector -> Property - otoListTest bv = - otoList bv === toBits bv + where + otoListTest :: BitVector -> Property + otoListTest bv = otoList bv === toBits bv - dimensionAndToBits :: BitVector -> Property - dimensionAndToBits bv = - (fromEnum . dimension) bv === (length . toBits) bv + dimensionAndToBits :: BitVector -> Property + dimensionAndToBits bv = (fromEnum . dimension) bv === (length . toBits) bv - dimensionAndFiniteBitSize :: BitVector -> Property - dimensionAndFiniteBitSize bv = - (fromEnum . dimension) bv === finiteBitSize bv + dimensionAndFiniteBitSize :: BitVector -> Property + dimensionAndFiniteBitSize bv = (fromEnum . dimension) bv === finiteBitSize bv - toBitsFromBits :: BitVector -> Property - toBitsFromBits bv = - (fromBits . toBits) bv === bv + toBitsFromBits :: BitVector -> Property + toBitsFromBits bv = (fromBits . toBits) bv === bv - zeroBitsIsZeroVector :: Assertion - zeroBitsIsZeroVector = - assertBool "zeroBits is not a 'zero vector'" $ isZeroVector zeroBits + zeroBitsIsZeroVector :: Assertion + zeroBitsIsZeroVector = assertBool "zeroBits is not a 'zero vector'" $ isZeroVector zeroBits - popCountAndZeroVector :: BitVector -> Property - popCountAndZeroVector bv = - isZeroVector bv === ((0 ==) . popCount) bv + popCountAndZeroVector :: BitVector -> Property + popCountAndZeroVector bv = isZeroVector bv === ((0 ==) . popCount) bv - zeroVectorAndAllBitsOff :: BitVector -> Property - zeroVectorAndAllBitsOff bv = - isZeroVector bv === (all not . toBits) bv + zeroVectorAndAllBitsOff :: BitVector -> Property + zeroVectorAndAllBitsOff bv = isZeroVector bv === (all not . toBits) bv - toUnsignedNumImpliesZeroVector :: BitVector -> Property - toUnsignedNumImpliesZeroVector bv = - ((0 ==) . (toUnsignedNumber :: BitVector -> Integer)) bv -=> isZeroVector bv + toUnsignedNumImpliesZeroVector :: BitVector -> Property + toUnsignedNumImpliesZeroVector bv = + ((0 ==) . (toUnsignedNumber :: BitVector -> Integer)) bv -=> isZeroVector bv - bitVectorUnsignedNumIdentity :: Integer -> Property - bitVectorUnsignedNumIdentity num = - (toSignedNumber . fromNumber width) num === num - where - width = succ . succ . ceiling . logBase (2.0 :: Double) . fromIntegral $ abs num + bitVectorUnsignedNumIdentity :: Integer -> Property + bitVectorUnsignedNumIdentity num = (toSignedNumber . fromNumber width) num === num + where width = succ . succ . ceiling . logBase (2.0 :: Double) . fromIntegral $ abs num - noSignBitVector :: BitVector -> Property - noSignBitVector bv = - isSigned bv === False + noSignBitVector :: BitVector -> Property + noSignBitVector bv = isSigned bv === False - badSubRangeEmptyResult :: (Word, Word) -> BitVector -> Property - badSubRangeEmptyResult range@(lower, upper) bv = - lower > upper -=> subRange range bv === zeroBits + badSubRangeEmptyResult :: (Word, Word) -> BitVector -> Property + badSubRangeEmptyResult range@(lower, upper) bv = lower > upper -=> subRange range bv === zeroBits - subRangeFixedDimension :: (NonNegative Int, NonNegative Int) -> BitVector -> Property - subRangeFixedDimension (NonNegative lowerI, NonNegative upperI) bv = - lower <= upper -=> dimension (subRange (lower, upper) bv) === upper - lower + 1 - where - lower = toEnum lowerI - upper = toEnum upperI + subRangeFixedDimension :: (NonNegative Int, NonNegative Int) -> BitVector -> Property + subRangeFixedDimension (NonNegative lowerI, NonNegative upperI) bv = + lower <= upper -=> dimension (subRange (lower, upper) bv) === upper - lower + 1 + where + lower = toEnum lowerI + upper = toEnum upperI bitVectorRankSelect :: TestTree -bitVectorRankSelect = testGroup "BitVector rank/select" +bitVectorRankSelect = testGroup + "BitVector rank/select" [ QC.testProperty "select (bit i) 0 === i" selectBitValue , QC.testProperty "select (bit x .|. bit y) 0 === min (select (bit x) 0) (select (bit y) 0)" selectBitOr - , QC.testProperty "rank (bit x .|. bit y) (max x y + 1) === rank (bit x) (x+1) + rank (bit y) (y+1)" rankBitOr + , QC.testProperty + "rank (bit x .|. bit y) (max x y + 1) === rank (bit x) (x+1) + rank (bit y) (y+1)" + rankBitOr , QC.testProperty "rank (bit i) (i+1) === i" rankBitValue , QC.testProperty "rank <$> id <*> dimension === popCount" rankPopCount , QC.testProperty "rank bv i === length . filter id . take i . toBits bv" rankToBits , QC.testProperty "rank bv (select bv i) === i" rankSelectMinDef ] - where - selectBitValue :: NonNegative Int -> Property - selectBitValue (NonNegative x) = - select (bit x) 0 === Just (toEnum x) + where + selectBitValue :: NonNegative Int -> Property + selectBitValue (NonNegative x) = select (bit x) 0 === Just (toEnum x) - selectBitOr :: NonNegative Int -> NonNegative Int -> Property - selectBitOr (NonNegative x) (NonNegative y) = - select (bit x .|. bit y) 0 === min (select (bit x) 0) (select (bit y) 0) + selectBitOr :: NonNegative Int -> NonNegative Int -> Property + selectBitOr (NonNegative x) (NonNegative y) = + select (bit x .|. bit y) 0 === min (select (bit x) 0) (select (bit y) 0) - rankBitValue :: NonNegative Word -> Property - rankBitValue (NonNegative x) = - rank (bit (fromEnum x)) (x+1) === 1 + rankBitValue :: NonNegative Word -> Property + rankBitValue (NonNegative x) = rank (bit (fromEnum x)) (x + 1) === 1 - rankBitOr :: NonNegative Int -> NonNegative Int -> Property - rankBitOr (NonNegative x) (NonNegative y) = - x /= y -=> - rank (bit x .|. bit y) z' === rank (bit x) (x'+1) + rank (bit y) (y'+1) - where - x' = toEnum x - y' = toEnum y - z' = max x' y' + 1 + rankBitOr :: NonNegative Int -> NonNegative Int -> Property + rankBitOr (NonNegative x) (NonNegative y) = + x /= y -=> rank (bit x .|. bit y) z' === rank (bit x) (x' + 1) + rank (bit y) (y' + 1) + where + x' = toEnum x + y' = toEnum y + z' = max x' y' + 1 - rankPopCount :: BitVector -> Property - rankPopCount bv = - (rank <$> id <*> dimension) bv === toEnum (popCount bv) + rankPopCount :: BitVector -> Property + rankPopCount bv = (rank <$> id <*> dimension) bv === toEnum (popCount bv) - rankToBits :: BitVector -> NonNegative Word -> Property - rankToBits bv (NonNegative x) = - rank bv x === (toEnum . length . filter id . take (fromEnum x) . toBits) bv + rankToBits :: BitVector -> NonNegative Word -> Property + rankToBits bv (NonNegative x) = + rank bv x === (toEnum . length . filter id . take (fromEnum x) . toBits) bv - rankSelectMinDef :: BitVector -> NonNegative Word -> Property - rankSelectMinDef bv (NonNegative x) = - let idx = select bv x - k = fromJust idx - in idx === Nothing .||. rank bv k === x - + rankSelectMinDef :: BitVector -> NonNegative Word -> Property + rankSelectMinDef bv (NonNegative x) = + let idx = select bv x + k = fromJust idx + in idx === Nothing .||. rank bv k === x -monoFunctorEquivelence :: TestTree -monoFunctorEquivelence = testGroup "Equivelence of a MonoFunctor" - [ SC.testProperty "omap f === fromBits . map f . toBits" $ forAll omapOptimizationIsValid - ] - where - omapOptimizationIsValid :: (Bool -> Bool, VisualBitVector) -> Bool - omapOptimizationIsValid (f, y) = omap f bv == (fromBits . map f . toBits) bv - where - bv = getBitVector y +monoFunctorEquivalence :: TestTree +monoFunctorEquivalence = testGroup + "Equivalence of a MonoFunctor" + [SC.testProperty "omap f === fromBits . map f . toBits" $ forAll omapOptimizationIsValid] + where + omapOptimizationIsValid :: (Bool -> Bool, VisualBitVector) -> Bool + omapOptimizationIsValid (f, y) = omap f bv == (fromBits . map f . toBits) bv + where bv = getBitVector y -monoFoldableEquivelence :: TestTree -monoFoldableEquivelence = testGroup "Equivelence of a MonoFoldable" - [ SC.testProperty "oall f === all f . otoList" $ forAll oallOptimizationIsValid - , SC.testProperty "oany f === any f . otoList" $ forAll oanyOptimizationIsValid - , SC.testProperty "ofoldr1Ex f === foldr1 f . otoList" $ forAll ofoldr1ExOptimizationIsValid - , SC.testProperty "ofold'1Ex' f === foldl1 f . otoList" $ forAll ofoldl1ExOptimizationIsValid - , SC.testProperty "headEx === head . otoList" $ forAll headExOptimizationIsValid - , SC.testProperty "lastEx === last . otoList" $ forAll lastExOptimizationIsValid --- , SC.testProperty "maximumByEx f === maximumBy f . otoList" $ forAll maximumByExOptimizationIsValid --- , SC.testProperty "minimumByEx f === minimumBy f . otoList" $ forAll minimumByExOptimizationIsValid - , SC.testProperty "oelem e === oelem e . otoList" $ forAll oelemOptimizationIsValid - , SC.testProperty "onotElem e === onotElem e . otoList" $ forAll onotElemOptimizationIsValid + +monoFoldableEquivalence :: TestTree +monoFoldableEquivalence = testGroup + "Equivalence of a MonoFoldable" + [ SC.testProperty "oall f === all f . otoList" $ forAll oallOptimizationIsValid + , SC.testProperty "oany f === any f . otoList" $ forAll oanyOptimizationIsValid + , SC.testProperty "ofoldr1Ex f === foldr1 f . otoList" $ forAll ofoldr1ExOptimizationIsValid + , SC.testProperty "ofoldl1Ex' f === foldl1 f . otoList" $ forAll ofoldl1ExOptimizationIsValid + , SC.testProperty "headEx === head . otoList" $ forAll headExOptimizationIsValid + , SC.testProperty "lastEx === last . otoList" $ forAll lastExOptimizationIsValid + , SC.testProperty "maximumByEx f === maximumBy f . otoList" $ forAll maximumByExOptimizationIsValid + , SC.testProperty "minimumByEx f === minimumBy f . otoList" $ forAll minimumByExOptimizationIsValid + , SC.testProperty "oelem e === oelem e . otoList" $ forAll oelemOptimizationIsValid + , SC.testProperty "onotElem e === onotElem e . otoList" $ forAll onotElemOptimizationIsValid ] - where - oallOptimizationIsValid :: (UnaryLogicalOperator, VisualBitVector) -> Bool - oallOptimizationIsValid (y, x) = oall op bv == (all op . otoList) bv - where - bv = getBitVector x - op = getUnaryLogicalOperator y + where + oallOptimizationIsValid :: (UnaryLogicalOperator, VisualBitVector) -> Bool + oallOptimizationIsValid (y, x) = oall op bv == (all op . otoList) bv + where + bv = getBitVector x + op = getUnaryLogicalOperator y - oanyOptimizationIsValid :: (UnaryLogicalOperator, VisualBitVector) -> Bool - oanyOptimizationIsValid (y, x) = oany op bv == (any op . otoList) bv - where - bv = getBitVector x - op = getUnaryLogicalOperator y + oanyOptimizationIsValid :: (UnaryLogicalOperator, VisualBitVector) -> Bool + oanyOptimizationIsValid (y, x) = oany op bv == (any op . otoList) bv + where + bv = getBitVector x + op = getUnaryLogicalOperator y - ofoldr1ExOptimizationIsValid :: (BinaryLogicalOperator, VisualBitVector) -> Bool - ofoldr1ExOptimizationIsValid (y, x) = - isZeroVector bv || ofoldr1Ex op bv == (foldr1 op . otoList) bv - where - bv = getBitVector x - op = getBinaryLogicalOperator y + ofoldr1ExOptimizationIsValid :: (BinaryLogicalOperator, VisualBitVector) -> Bool + ofoldr1ExOptimizationIsValid (y, x) = isZeroVector bv || ofoldr1Ex op bv == (foldr1 op . otoList) bv + where + bv = getBitVector x + op = getBinaryLogicalOperator y - ofoldl1ExOptimizationIsValid :: (BinaryLogicalOperator, VisualBitVector) -> Bool - ofoldl1ExOptimizationIsValid (y, x) = - isZeroVector bv || ofoldl1Ex' op bv == (foldl1 op . otoList) bv - where - bv = getBitVector x - op = getBinaryLogicalOperator y + ofoldl1ExOptimizationIsValid :: (BinaryLogicalOperator, VisualBitVector) -> Bool + ofoldl1ExOptimizationIsValid (y, x) = isZeroVector bv || ofoldl1Ex' op bv == (foldl1 op . otoList) bv + where + bv = getBitVector x + op = getBinaryLogicalOperator y - headExOptimizationIsValid :: VisualBitVector -> Bool - headExOptimizationIsValid x = - isZeroVector bv || headEx bv == (head . otoList) bv - where - bv = getBitVector x + headExOptimizationIsValid :: VisualBitVector -> Bool + headExOptimizationIsValid x = isZeroVector bv || headEx bv == (head . otoList) bv + where bv = getBitVector x - lastExOptimizationIsValid :: VisualBitVector -> Bool - lastExOptimizationIsValid x = - isZeroVector bv || lastEx bv == (last . otoList) bv - where - bv = getBitVector x + lastExOptimizationIsValid :: VisualBitVector -> Bool + lastExOptimizationIsValid x = isZeroVector bv || lastEx bv == (last . otoList) bv + where bv = getBitVector x - maximumByExOptimizationIsValid :: (VisualBitVector, ComparisonOperator) -> Bool - maximumByExOptimizationIsValid (x, y) = - isZeroVector bv || maximumByEx op bv == (maximumBy op . otoList) bv - where - bv = getBitVector x - op = getComparator y + maximumByExOptimizationIsValid :: (VisualBitVector, ComparisonOperator) -> Bool + maximumByExOptimizationIsValid (x, y) = + isZeroVector bv || maximumByEx op bv == (maximumBy op . otoList) bv + where + bv = getBitVector x + op = getComparator y - minimumByExOptimizationIsValid :: (VisualBitVector, ComparisonOperator) -> Bool - minimumByExOptimizationIsValid (x, y) = - isZeroVector bv || minimumByEx op bv == (minimumBy op . otoList) bv - where - bv = getBitVector x - op = getComparator y + minimumByExOptimizationIsValid :: (VisualBitVector, ComparisonOperator) -> Bool + minimumByExOptimizationIsValid (x, y) = + isZeroVector bv || minimumByEx op bv == (minimumBy op . otoList) bv + where + bv = getBitVector x + op = getComparator y - oelemOptimizationIsValid :: (VisualBitVector, Bool) -> Bool - oelemOptimizationIsValid (x, e) = oelem e bv == (oelem e . otoList) bv - where - bv = getBitVector x + oelemOptimizationIsValid :: (VisualBitVector, Bool) -> Bool + oelemOptimizationIsValid (x, e) = oelem e bv == (oelem e . otoList) bv where bv = getBitVector x - onotElemOptimizationIsValid :: (VisualBitVector, Bool) -> Bool - onotElemOptimizationIsValid (x, e) = onotElem e bv == (onotElem e . otoList) bv - where - bv = getBitVector x + onotElemOptimizationIsValid :: (VisualBitVector, Bool) -> Bool + onotElemOptimizationIsValid (x, e) = onotElem e bv == (onotElem e . otoList) bv + where bv = getBitVector x -monoZipEquivelence :: TestTree -monoZipEquivelence = testGroup "Equivelence of a MonoZip" - [ SC.testProperty "ozipWith f x === fromBits . zipWith f . (toBits x) . toBits" $ forAll omapOptimizationIsValid +monoZipEquivalence :: TestTree +monoZipEquivalence = testGroup + "Equivalence of a MonoZip" + [ SC.testProperty "ozipWith f x === fromBits . zipWith f . (toBits x) . toBits" + $ forAll omapOptimizationIsValid ] - where - omapOptimizationIsValid :: (BinaryLogicalOperator, VisualBitVectorSmall, VisualBitVectorSmall) -> Bool - omapOptimizationIsValid (f, x, y) = ozipWith op lhs rhs == (fromBits . zipWith op (toBits lhs) . toBits) rhs - where - op = getBinaryLogicalOperator f - lhs = getBitVector x - rhs = getBitVector y + where + omapOptimizationIsValid + :: (BinaryLogicalOperator, VisualBitVectorSmall, VisualBitVectorSmall) -> Bool + omapOptimizationIsValid (f, x, y) = ozipWith op lhs rhs + == (fromBits . zipWith op (toBits lhs) . toBits) rhs + where + op = getBinaryLogicalOperator f + lhs = getBitVector x + rhs = getBitVector y + {- infixr 0 ===> diff --git a/util/Operator/Binary/Comparison.hs b/util/Operator/Binary/Comparison.hs --- a/util/Operator/Binary/Comparison.hs +++ b/util/Operator/Binary/Comparison.hs @@ -1,27 +1,41 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-| +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +-} + +{-# Language BangPatterns #-} +{-# Language DeriveAnyClass #-} +{-# Language DeriveGeneric #-} +{-# Language DerivingStrategies #-} +{-# Language FlexibleInstances #-} +{-# Language MultiParamTypeClasses #-} +{-# Language Safe #-} + module Operator.Binary.Comparison - ( ComparisonOperator(getComparator) - ) where + ( ComparisonOperator (getComparator) + ) where import Control.DeepSeq -import Data.Data -import Data.List (elemIndex) -import Data.Maybe (fromJust) -import Data.Monoid () -import Data.Semigroup +import Data.List (elemIndex) +import Data.Maybe (fromJust) +import Data.Monoid () import GHC.Generics -import Test.QuickCheck hiding (generate) +import Test.QuickCheck hiding (generate) import Test.SmallCheck.Series -newtype ComparisonOperator = CO { getComparator :: Bool -> Bool -> Ordering } - deriving (Generic, NFData, Typeable) +{-| +Representation of all possible binary operators of type @(Bool -> Bool -> Bool)@. +Useful for both property and enumeration based testing. +-} +newtype ComparisonOperator + = CO { getComparator :: Bool -> Bool -> Ordering } + deriving anyclass (NFData) + deriving stock (Generic) comparatorList :: [ComparisonOperator] @@ -30,10 +44,13 @@ x <- [minBound .. maxBound] y <- [minBound .. maxBound] z <- [minBound .. maxBound] - pure . CO $ \a b -> if not a && not b then w - else if not a && b then x - else if a && not b then y - else {- a && b -} z + pure + $ let + op False False = w + op False True = x + op True False = y + op True True = z + in CO op instance Arbitrary ComparisonOperator where @@ -55,8 +72,7 @@ instance Enum ComparisonOperator where - toEnum n = let !i = n `quot` length comparatorList - in comparatorList !! i + toEnum n = let !i = n `quot` length comparatorList in comparatorList !! i fromEnum c = fromJust $ elemIndex c comparatorList @@ -65,9 +81,9 @@ (CO f) == (CO g) = and [ f False False == g False False - , f False True == g False True - , f True False == g True False - , f True True == g True True + , f False True == g False True + , f True False == g True False + , f True True == g True True ] @@ -80,8 +96,8 @@ show (CO f) = unlines [ "" - , "f / F F -> " <> show (f False False) - , " | F T -> " <> show (f False True ) - , " | T F -> " <> show (f True False) - , " \\ T T -> " <> show (f True True ) + , "f / F F -> " <> show (f False False) + , " | F T -> " <> show (f False True) + , " | T F -> " <> show (f True False) + , " \\ T T -> " <> show (f True True) ] diff --git a/util/Operator/Binary/Logical.hs b/util/Operator/Binary/Logical.hs --- a/util/Operator/Binary/Logical.hs +++ b/util/Operator/Binary/Logical.hs @@ -1,26 +1,40 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-| +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +-} + +{-# Language DeriveAnyClass #-} +{-# Language DeriveDataTypeable #-} +{-# Language DeriveGeneric #-} +{-# Language DerivingStrategies #-} +{-# Language FlexibleInstances #-} +{-# Language MultiParamTypeClasses #-} +{-# Language Safe #-} + module Operator.Binary.Logical - ( BinaryLogicalOperator() - , getBinaryLogicalSymbol - , getBinaryLogicalOperator - , fromBinaryLogicalFunction - ) where + ( BinaryLogicalOperator () + , fromBinaryLogicalFunction + , getBinaryLogicalOperator + , getBinaryLogicalSymbol + ) where import Control.DeepSeq import Data.Data import Data.Monoid () -import Data.Semigroup import GHC.Generics -import Test.QuickCheck hiding (generate) +import Test.QuickCheck hiding (generate) import Test.SmallCheck.Series -data BinaryLogicalOperator +{-| +Representation of all possible /binary/ operators of type @(Bool -> Bool -> Bool)@. +Useful for both property and enumeration based testing. +-} +data BinaryLogicalOperator = AlwaysFalse | LogicalNOR | ConverseNonImplication @@ -37,7 +51,8 @@ | ConverseImplication | LogicalOR | AlwaysTrue - deriving (Data, Eq, Ord, Generic, NFData, Typeable) + deriving anyclass (NFData) + deriving stock (Data, Eq, Generic, Ord) instance Arbitrary BinaryLogicalOperator where @@ -59,87 +74,85 @@ instance Enum BinaryLogicalOperator where - toEnum n = - case n `rem` 16 of - 0 -> AlwaysFalse - 1 -> LogicalNOR - 2 -> ConverseNonImplication - 3 -> NotFirstArgument - 4 -> NonImplication - 5 -> NotSecondArgument - 6 -> LogicalXOR - 7 -> LogicalNAND - 8 -> LogicalAND - 9 -> LogicalXNOR - 10 -> SecondArgument - 11 -> Implication - 12 -> FirstArgument - 13 -> ConverseImplication - 14 -> LogicalOR - _ -> AlwaysTrue + toEnum n = case n `rem` 16 of + 0 -> AlwaysFalse + 1 -> LogicalNOR + 2 -> ConverseNonImplication + 3 -> NotFirstArgument + 4 -> NonImplication + 5 -> NotSecondArgument + 6 -> LogicalXOR + 7 -> LogicalNAND + 8 -> LogicalAND + 9 -> LogicalXNOR + 10 -> SecondArgument + 11 -> Implication + 12 -> FirstArgument + 13 -> ConverseImplication + 14 -> LogicalOR + _ -> AlwaysTrue - fromEnum x = - case x of - AlwaysFalse -> 0 - LogicalNOR -> 1 - ConverseNonImplication -> 2 - NotFirstArgument -> 3 - NonImplication -> 4 - NotSecondArgument -> 5 - LogicalXOR -> 6 - LogicalNAND -> 7 - LogicalAND -> 8 - LogicalXNOR -> 9 - SecondArgument -> 10 - Implication -> 11 - FirstArgument -> 12 - ConverseImplication -> 13 - LogicalOR -> 14 - AlwaysTrue -> 15 + fromEnum x = case x of + AlwaysFalse -> 0 + LogicalNOR -> 1 + ConverseNonImplication -> 2 + NotFirstArgument -> 3 + NonImplication -> 4 + NotSecondArgument -> 5 + LogicalXOR -> 6 + LogicalNAND -> 7 + LogicalAND -> 8 + LogicalXNOR -> 9 + SecondArgument -> 10 + Implication -> 11 + FirstArgument -> 12 + ConverseImplication -> 13 + LogicalOR -> 14 + AlwaysTrue -> 15 - succ x = - case x of - AlwaysFalse -> LogicalNOR - LogicalNOR -> ConverseNonImplication - ConverseNonImplication -> NotFirstArgument - NotFirstArgument -> NonImplication - NonImplication -> NotSecondArgument - NotSecondArgument -> LogicalXOR - LogicalXOR -> LogicalNAND - LogicalNAND -> LogicalAND - LogicalAND -> LogicalXNOR - LogicalXNOR -> SecondArgument - SecondArgument -> Implication - Implication -> FirstArgument - FirstArgument -> ConverseImplication - ConverseImplication -> LogicalOR - LogicalOR -> AlwaysTrue - AlwaysTrue -> AlwaysFalse + succ x = case x of + AlwaysFalse -> LogicalNOR + LogicalNOR -> ConverseNonImplication + ConverseNonImplication -> NotFirstArgument + NotFirstArgument -> NonImplication + NonImplication -> NotSecondArgument + NotSecondArgument -> LogicalXOR + LogicalXOR -> LogicalNAND + LogicalNAND -> LogicalAND + LogicalAND -> LogicalXNOR + LogicalXNOR -> SecondArgument + SecondArgument -> Implication + Implication -> FirstArgument + FirstArgument -> ConverseImplication + ConverseImplication -> LogicalOR + LogicalOR -> AlwaysTrue + AlwaysTrue -> AlwaysFalse - pred x = - case x of - AlwaysFalse -> AlwaysTrue - LogicalNOR -> AlwaysFalse - ConverseNonImplication -> LogicalNOR - NotFirstArgument -> ConverseNonImplication - NonImplication -> NotFirstArgument - NotSecondArgument -> NonImplication - LogicalXOR -> NotSecondArgument - LogicalNAND -> LogicalXOR - LogicalAND -> LogicalNAND - LogicalXNOR -> LogicalAND - SecondArgument -> LogicalXNOR - Implication -> SecondArgument - FirstArgument -> Implication - ConverseImplication -> FirstArgument - LogicalOR -> ConverseImplication - AlwaysTrue -> LogicalOR + pred x = case x of + AlwaysFalse -> AlwaysTrue + LogicalNOR -> AlwaysFalse + ConverseNonImplication -> LogicalNOR + NotFirstArgument -> ConverseNonImplication + NonImplication -> NotFirstArgument + NotSecondArgument -> NonImplication + LogicalXOR -> NotSecondArgument + LogicalNAND -> LogicalXOR + LogicalAND -> LogicalNAND + LogicalXNOR -> LogicalAND + SecondArgument -> LogicalXNOR + Implication -> SecondArgument + FirstArgument -> Implication + ConverseImplication -> FirstArgument + LogicalOR -> ConverseImplication + AlwaysTrue -> LogicalOR + -- enumFrom x = toEnum <$> [fromEnum x .. 15] --- enumFromTo x y = +-- enumFromTo x y = + instance Monad m => Serial m BinaryLogicalOperator where series = generate $ const [minBound .. maxBound] @@ -148,84 +161,91 @@ instance Show BinaryLogicalOperator where show x = "f p q = " <> s - where - s = case x of - AlwaysFalse -> "False (Contradiction)" - LogicalNOR -> "¬p ∧ ¬q (Logical NOR)" - ConverseNonImplication -> "¬p ∧ q (Converse Non-Implication)" - NotFirstArgument -> "¬p (Not First)" - NonImplication -> "p ∧ ¬q (Non-Implication)" - NotSecondArgument -> "¬q (Not Second)" - LogicalXOR -> "(p ∧ ¬q) ∨ (¬p ∧ q) (Logical XOR)" - LogicalNAND -> "¬p ∨ ¬q (Logical NAND)" - LogicalAND -> "p ∧ q (Logical AND)" - LogicalXNOR -> "(p ∧ q) ∨ (¬p ∧ ¬q) (Logical XNOR)" - SecondArgument -> "q (Second)" - Implication -> "¬p ∨ q (Implication)" - FirstArgument -> "p (First)" - ConverseImplication -> "p ∨ ¬q (Converse Implication)" - LogicalOR -> "p ∧ q (Logical OR)" - AlwaysTrue -> "True (Tautology)" + where + s = case x of + AlwaysFalse -> "False (Contradiction)" + LogicalNOR -> "¬p ∧ ¬q (Logical NOR)" + ConverseNonImplication -> "¬p ∧ q (Converse Non-Implication)" + NotFirstArgument -> "¬p (Not First)" + NonImplication -> "p ∧ ¬q (Non-Implication)" + NotSecondArgument -> "¬q (Not Second)" + LogicalXOR -> "(p ∧ ¬q) ∨ (¬p ∧ q) (Logical XOR)" + LogicalNAND -> "¬p ∨ ¬q (Logical NAND)" + LogicalAND -> "p ∧ q (Logical AND)" + LogicalXNOR -> "(p ∧ q) ∨ (¬p ∧ ¬q) (Logical XNOR)" + SecondArgument -> "q (Second)" + Implication -> "¬p ∨ q (Implication)" + FirstArgument -> "p (First)" + ConverseImplication -> "p ∨ ¬q (Converse Implication)" + LogicalOR -> "p ∧ q (Logical OR)" + AlwaysTrue -> "True (Tautology)" +{-| +Convert from a closed, binary function over 'Bool' to a 'BinaryLogicalOperator'. +-} +fromBinaryLogicalFunction :: (Bool -> Bool -> Bool) -> BinaryLogicalOperator +fromBinaryLogicalFunction f = case (f True True, f True False, f False True, f False False) of + (False, False, False, False) -> AlwaysFalse + (False, False, False, True ) -> LogicalNOR + (False, False, True , False) -> ConverseNonImplication + (False, False, True , True ) -> NotFirstArgument + (False, True , False, False) -> NonImplication + (False, True , False, True ) -> NotSecondArgument + (False, True , True , False) -> LogicalXOR + (False, True , True , True ) -> LogicalNAND + (True , False, False, False) -> LogicalAND + (True , False, False, True ) -> LogicalXNOR + (True , False, True , False) -> SecondArgument + (True , False, True , True ) -> Implication + (True , True , False, False) -> FirstArgument + (True , True , False, True ) -> ConverseImplication + (True , True , True , False) -> LogicalOR + (True , True , True , True ) -> AlwaysTrue + + +{-| +Convert from a 'BinaryLogicalOperator' to a closed, binary function over 'Bool'. +-} getBinaryLogicalOperator :: BinaryLogicalOperator -> Bool -> Bool -> Bool -getBinaryLogicalOperator x = - case x of - AlwaysFalse -> const (const False) - LogicalNOR -> \p q -> not $ p || q - ConverseNonImplication -> \p q -> not p && q - NotFirstArgument -> \p _ -> not p - NonImplication -> \p q -> p && not q - NotSecondArgument -> \_ q -> not q - LogicalXOR -> (/=) - LogicalNAND -> \p q -> not $ p && q - LogicalAND -> (&&) - LogicalXNOR -> (==) - SecondArgument -> \_ q -> q - Implication -> \p q -> not p || q - FirstArgument -> const - ConverseImplication -> \p q -> p || not q - LogicalOR -> (||) - AlwaysTrue -> const (const True) +getBinaryLogicalOperator x = case x of + AlwaysFalse -> const (const False) + LogicalNOR -> \p q -> not $ p || q + ConverseNonImplication -> \p q -> not p && q + NotFirstArgument -> \p _ -> not p + NonImplication -> \p q -> p && not q + NotSecondArgument -> \_ q -> not q + LogicalXOR -> (/=) + LogicalNAND -> \p q -> not $ p && q + LogicalAND -> (&&) + LogicalXNOR -> (==) + SecondArgument -> \_ q -> q + Implication -> \p q -> not p || q + FirstArgument -> const + ConverseImplication -> \p q -> p || not q + LogicalOR -> (||) + AlwaysTrue -> const (const True) +{-| +Query the Haskell expression of a 'BinaryLogicalOperator' representation symbolically as a 'String'. +-} getBinaryLogicalSymbol :: BinaryLogicalOperator -> String -getBinaryLogicalSymbol x = - case x of - AlwaysFalse -> "(const False)" - LogicalNOR -> "(not . (||))" - ConverseNonImplication -> "( "(not . fst)" - NonImplication -> "(=/>)" - NotSecondArgument -> "(not . snd)" - LogicalXOR -> "(/=)" - LogicalNAND -> "(not . (&&))" - LogicalAND -> "(&&)" - LogicalXNOR -> "(==)" - SecondArgument -> "(snd)" - Implication -> "(==>)" - FirstArgument -> "(fst)" - ConverseImplication -> "(<==)" - LogicalOR -> "(||)" - AlwaysTrue -> "(const True)" - +getBinaryLogicalSymbol x = case x of + AlwaysFalse -> "(const False)" + LogicalNOR -> "(not . (||))" + ConverseNonImplication -> "( "(not . fst)" + NonImplication -> "(=/>)" + NotSecondArgument -> "(not . snd)" + LogicalXOR -> "(/=)" + LogicalNAND -> "(not . (&&))" + LogicalAND -> "(&&)" + LogicalXNOR -> "(==)" + SecondArgument -> "(snd)" + Implication -> "(==>)" + FirstArgument -> "(fst)" + ConverseImplication -> "(<==)" + LogicalOR -> "(||)" + AlwaysTrue -> "(const True)" -fromBinaryLogicalFunction :: (Bool -> Bool -> Bool) -> BinaryLogicalOperator -fromBinaryLogicalFunction f = - case (f True True, f True False, f False True, f False False) of - (False, False, False, False) -> AlwaysFalse - (False, False, False, True ) -> LogicalNOR - (False, False, True , False) -> ConverseNonImplication - (False, False, True , True ) -> NotFirstArgument - (False, True , False, False) -> NonImplication - (False, True , False, True ) -> NotSecondArgument - (False, True , True , False) -> LogicalXOR - (False, True , True , True ) -> LogicalNAND - (True , False, False, False) -> LogicalAND - (True , False, False, True ) -> LogicalXNOR - (True , False, True , False) -> SecondArgument - (True , False, True , True ) -> Implication - (True , True , False, False) -> FirstArgument - (True , True , False, True ) -> ConverseImplication - (True , True , True , False) -> LogicalOR - (True , True , True , True ) -> AlwaysTrue diff --git a/util/Operator/Unary/Logical.hs b/util/Operator/Unary/Logical.hs --- a/util/Operator/Unary/Logical.hs +++ b/util/Operator/Unary/Logical.hs @@ -1,31 +1,46 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-| +Copyright : © 2020 Alex Washburn +License : BSD-3-Clause +Maintainer : github@recursion.ninja +Stability : Stable + +-} + +{-# Language DeriveAnyClass #-} +{-# Language DeriveDataTypeable #-} +{-# Language DeriveGeneric #-} +{-# Language DerivingStrategies #-} +{-# Language FlexibleInstances #-} +{-# Language MultiParamTypeClasses #-} +{-# Language Safe #-} + module Operator.Unary.Logical - ( UnaryLogicalOperator() - , getUnaryLogicalSymbol - , getUnaryLogicalOperator - , fromUnaryLogicalFunction - ) where + ( UnaryLogicalOperator () + , fromUnaryLogicalFunction + , getUnaryLogicalOperator + , getUnaryLogicalSymbol + ) where import Control.DeepSeq import Data.Data import Data.Monoid () -import Data.Semigroup import GHC.Generics -import Test.QuickCheck hiding (generate) +import Test.QuickCheck hiding (generate) import Test.SmallCheck.Series -data UnaryLogicalOperator +{-| +Representation of all possible /unary/ operators of type @(Bool -> Bool)@. +Useful for both property and enumeration based testing. +-} +data UnaryLogicalOperator = AlwaysFalse | Identity | Negation | AlwaysTrue - deriving (Data, Eq, Ord, Generic, NFData, Typeable) + deriving anyclass (NFData) + deriving stock (Data, Eq, Generic, Ord) instance Arbitrary UnaryLogicalOperator where @@ -47,34 +62,29 @@ instance Enum UnaryLogicalOperator where - toEnum n = - case n `rem` 4 of - 0 -> AlwaysFalse - 1 -> Identity - 2 -> Negation - _ -> AlwaysTrue - - fromEnum x = - case x of - AlwaysFalse -> 0 - Identity -> 1 - Negation -> 2 - AlwaysTrue -> 3 + toEnum n = case n `rem` 4 of + 0 -> AlwaysFalse + 1 -> Identity + 2 -> Negation + _ -> AlwaysTrue - succ x = - case x of - AlwaysFalse -> Identity - Identity -> Negation - Negation -> AlwaysTrue - AlwaysTrue -> AlwaysFalse + fromEnum x = case x of + AlwaysFalse -> 0 + Identity -> 1 + Negation -> 2 + AlwaysTrue -> 3 + succ x = case x of + AlwaysFalse -> Identity + Identity -> Negation + Negation -> AlwaysTrue + AlwaysTrue -> AlwaysFalse - pred x = - case x of - AlwaysFalse -> AlwaysTrue - Identity -> AlwaysFalse - Negation -> Identity - AlwaysTrue -> Negation + pred x = case x of + AlwaysFalse -> AlwaysTrue + Identity -> AlwaysFalse + Negation -> Identity + AlwaysTrue -> Negation instance Monad m => Serial m UnaryLogicalOperator where @@ -85,37 +95,42 @@ instance Show UnaryLogicalOperator where show x = "f p q = " <> s - where - s = case x of - AlwaysFalse -> "False (Contradiction)" - Identity -> "id (Identity)" - Negation -> "not (Negation)" - AlwaysTrue -> "True (Tautology)" + where + s = case x of + AlwaysFalse -> "False (Contradiction)" + Identity -> "id (Identity)" + Negation -> "not (Negation)" + AlwaysTrue -> "True (Tautology)" -getUnaryLogicalOperator :: UnaryLogicalOperator -> Bool -> Bool -getUnaryLogicalOperator x = - case x of - AlwaysFalse -> const False - Identity -> id - Negation -> not - AlwaysTrue -> const True +{-| +Convert from a closed, unnary function over 'Bool' to a 'UnaryLogicalOperator'. +-} +fromUnaryLogicalFunction :: (Bool -> Bool) -> UnaryLogicalOperator +fromUnaryLogicalFunction f = case (f False, f True) of + (False, False) -> AlwaysFalse + (False, True ) -> Identity + (True , False) -> Negation + (True , True ) -> AlwaysTrue -getUnaryLogicalSymbol :: UnaryLogicalOperator -> String -getUnaryLogicalSymbol x = - case x of - AlwaysFalse -> "(const False)" - Identity -> "(id)" - Negation -> "(not)" - AlwaysTrue -> "(const True)" +{-| +Convert from a 'UnaryLogicalOperator' to a closed, unary function over 'Bool'. +-} +getUnaryLogicalOperator :: UnaryLogicalOperator -> Bool -> Bool +getUnaryLogicalOperator x = case x of + AlwaysFalse -> const False + Identity -> id + Negation -> not + AlwaysTrue -> const True -fromUnaryLogicalFunction :: (Bool -> Bool) -> UnaryLogicalOperator -fromUnaryLogicalFunction f = - case (f False, f True) of - (False, False) -> AlwaysFalse - (False, True ) -> Identity - (True , False) -> Negation - (True , True ) -> AlwaysTrue - +{-| +Query the Haskell expression of a 'UnaryLogicalOperator' representation symbolically as a 'String'. +-} +getUnaryLogicalSymbol :: UnaryLogicalOperator -> String +getUnaryLogicalSymbol x = case x of + AlwaysFalse -> "(const False)" + Identity -> "(id)" + Negation -> "(not)" + AlwaysTrue -> "(const True)"