packages feed

hw-bits 0.0.0.10 → 0.0.0.11

raw patch · 5 files changed

+299/−3 lines, 5 files

Files

hw-bits.cabal view
@@ -1,5 +1,5 @@ name:                   hw-bits-version:                0.0.0.10+version:                0.0.0.11 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-bits#readme@@ -46,6 +46,7 @@                       , HaskellWorks.Data.Bits.PopCount.PopCount1                       , HaskellWorks.Data.Bits.Types.Broadword                       , HaskellWorks.Data.Bits.Types.Builtin+                      , HaskellWorks.Data.Bits.Unmatched                       , HaskellWorks.Data.Bits.Word   build-depends:        base                          >= 4          && < 5                       , bytestring@@ -63,6 +64,7 @@   other-modules:        HaskellWorks.Data.Bits.BitReadSpec                       , HaskellWorks.Data.Bits.BitWiseSpec                       , HaskellWorks.Data.Bits.FromBitTextByteStringSpec+                      , HaskellWorks.Data.Bits.UnmatchedSpec   build-depends:        base                          >= 4          && < 5                       , bytestring                       , hspec
+ src/HaskellWorks/Data/Bits/Unmatched.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.Bits.Unmatched+  ( UnmatchedL0(..)+  , UnmatchedL1(..)+  , UnmatchedR0(..)+  , UnmatchedR1(..)+  ) where++import qualified Data.Vector.Storable               as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.FixedBitSize+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Positioning++bitEnd :: FixedBitSize w => w -> Position+bitEnd = toPosition . fixedBitSize+{-# INLINE bitEnd #-}++goL0 :: (TestBit w, FixedBitSize w) => Position -> Int -> w -> Int+goL0 n c w = if 0 <= n && n < bitEnd w+  then let delta = if w .?. (bitEnd w - n - 1) then -1 else 1 in goL0 (n + 1) ((c + delta) `max` 0) w+  else c+{-# INLINE goL0 #-}++goL1 :: (TestBit w, FixedBitSize w) => Position -> Int -> w -> Int+goL1 n c w = if 0 <= n && n < bitEnd w+  then let delta = if w .?. (bitEnd w - n - 1) then 1 else -1 in goL1 (n + 1) ((c + delta) `max` 0) w+  else c+{-# INLINE goL1 #-}++goR0 :: (TestBit w, FixedBitSize w) => Position -> Int -> w -> Int+goR0 n c w = if 0 <= n && n < bitEnd w+  then let delta = if w .?. n then -1 else 1 in goR0 (n + 1) ((c + delta) `max` 0) w+  else c+{-# INLINE goR0 #-}++goR1 :: (TestBit w, FixedBitSize w) => Position -> Int -> w -> Int+goR1 n c w = if 0 <= n && n < bitEnd w+  then let delta = if w .?. n then 1 else -1 in goR1 (n + 1) ((c + delta) `max` 0) w+  else c+{-# INLINE goR1 #-}++goDVSL0 :: (UnmatchedL0 w, UnmatchedR1 w, DVS.Storable w) => Int -> DVS.Vector w -> Int+goDVSL0 ub v = if DVS.length v == 0+  then ub+  else let a = DVS.last v in goDVSL0 (unmatchedL0 a + ((ub - unmatchedR1 a) `max` 0)) (DVS.init v)+{-# INLINE goDVSL0 #-}++goDVSL1 :: (UnmatchedL1 w, UnmatchedR0 w, DVS.Storable w) => Int -> DVS.Vector w -> Int+goDVSL1 ub v = if DVS.length v == 0+  then ub+  else let a = DVS.last v in goDVSL1 (unmatchedL1 a + ((ub - unmatchedR0 a) `max` 0)) (DVS.init v)+{-# INLINE goDVSL1 #-}++goDVSR0 :: (UnmatchedR0 w, UnmatchedL1 w, DVS.Storable w) => Int -> DVS.Vector w -> Int+goDVSR0 ua v = if DVS.length v == 0+  then ua+  else let b = DVS.head v in goDVSR0 (unmatchedR0 b + ((ua - unmatchedL1 b) `max` 0)) (DVS.tail v)+{-# INLINE goDVSR0 #-}++goDVSR1 :: (UnmatchedR1 w, UnmatchedL0 w, DVS.Storable w) => Int -> DVS.Vector w -> Int+goDVSR1 ub v = if DVS.length v == 0+  then ub+  else let a = DVS.head v in goDVSR1 (unmatchedR1 a + ((ub - unmatchedL0 a) `max` 0)) (DVS.tail v)+{-# INLINE goDVSR1 #-}++class UnmatchedL0 a where+  unmatchedL0 :: a -> Int++class UnmatchedL1 a where+  unmatchedL1 :: a -> Int++class UnmatchedR0 a where+  unmatchedR0 :: a -> Int++class UnmatchedR1 a where+  unmatchedR1 :: a -> Int++instance UnmatchedL0 Word8 where+  unmatchedL0 = goL0 0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL0 Word16 where+  unmatchedL0 = goL0 0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL0 Word32 where+  unmatchedL0 = goL0 0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL0 Word64 where+  unmatchedL0 = goL0 0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL0 (DVS.Vector Word8) where+  unmatchedL0 = goDVSL0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL0 (DVS.Vector Word16) where+  unmatchedL0 = goDVSL0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL0 (DVS.Vector Word32) where+  unmatchedL0 = goDVSL0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL0 (DVS.Vector Word64) where+  unmatchedL0 = goDVSL0 0+  {-# INLINE unmatchedL0 #-}++instance UnmatchedL1 Word8 where+  unmatchedL1 = goL1 0 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedL1 Word16 where+  unmatchedL1 = goL1 0 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedL1 Word32 where+  unmatchedL1 = goL1 0 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedL1 Word64 where+  unmatchedL1 = goL1 0 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedL1 (DVS.Vector Word8) where+  unmatchedL1 = goDVSL1 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedL1 (DVS.Vector Word16) where+  unmatchedL1 = goDVSL1 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedL1 (DVS.Vector Word32) where+  unmatchedL1 = goDVSL1 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedL1 (DVS.Vector Word64) where+  unmatchedL1 = goDVSL1 0+  {-# INLINE unmatchedL1 #-}++instance UnmatchedR0 Word8 where+  unmatchedR0 = goR0 0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR0 Word16 where+  unmatchedR0 = goR0 0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR0 Word32 where+  unmatchedR0 = goR0 0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR0 Word64 where+  unmatchedR0 = goR0 0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR0 (DVS.Vector Word8) where+  unmatchedR0 = goDVSR0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR0 (DVS.Vector Word16) where+  unmatchedR0 = goDVSR0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR0 (DVS.Vector Word32) where+  unmatchedR0 = goDVSR0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR0 (DVS.Vector Word64) where+  unmatchedR0 = goDVSR0 0+  {-# INLINE unmatchedR0 #-}++instance UnmatchedR1 Word8 where+  unmatchedR1 = goR1 0 0+  {-# INLINE unmatchedR1 #-}++instance UnmatchedR1 Word16 where+  unmatchedR1 = goR1 0 0+  {-# INLINE unmatchedR1 #-}++instance UnmatchedR1 Word32 where+  unmatchedR1 = goR1 0 0+  {-# INLINE unmatchedR1 #-}++instance UnmatchedR1 Word64 where+  unmatchedR1 = goR1 0 0+  {-# INLINE unmatchedR1 #-}++instance UnmatchedR1 (DVS.Vector Word8) where+  unmatchedR1 = goDVSR1 0+  {-# INLINE unmatchedR1 #-}++instance UnmatchedR1 (DVS.Vector Word16) where+  unmatchedR1 = goDVSR1 0+  {-# INLINE unmatchedR1 #-}++instance UnmatchedR1 (DVS.Vector Word32) where+  unmatchedR1 = goDVSR1 0+  {-# INLINE unmatchedR1 #-}++instance UnmatchedR1 (DVS.Vector Word64) where+  unmatchedR1 = goDVSR1 0+  {-# INLINE unmatchedR1 #-}
test/HaskellWorks/Data/Bits/BitWiseSpec.hs view
@@ -15,7 +15,7 @@ {-# ANN module ("HLint: ignore Redundant do" :: String) #-}  spec :: Spec-spec = describe "HaskellWorks.Data.SuccinctSpec" $ do+spec = describe "HaskellWorks.Data.Bits.BitWiseSpec" $ do   describe "for popCount0" $ do     it "for Word8 matches Data.Bits implementation" $ property $       \(w :: Word8 ) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)
test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs view
@@ -15,7 +15,7 @@ {-# ANN module ("HLint: Ignore Redundant do" :: String) #-}  spec :: Spec-spec = describe "HaskellWorks.Data.FromBitTextByteStringSpec" $ do+spec = describe "HaskellWorks.Data.Bits.FromBitTextByteStringSpec" $ do   describe "For (DVS.Vector Word8)" $ do     it "fromBitTextByteString (BS.unpack []) :: DVS.Vector Word8" $       let w = fromBitTextByteString (BS.pack []) ::DVS.Vector Word8 in
+ test/HaskellWorks/Data/Bits/UnmatchedSpec.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.UnmatchedSpec (spec) where++import           Data.Vector.Storable                 as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.FixedBitSize+import           HaskellWorks.Data.Bits.Unmatched+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Bits.UnmatchedSpec" $ do+  describe "For Word8" $ do+    it "umatchedL0 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL0 a + ((unmatchedL0 b - unmatchedR1 a) `max` 0) `shouldBe` unmatchedL0 c+    it "umatchedL1 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL1 a + ((unmatchedL1 b - unmatchedR0 a) `max` 0) `shouldBe` unmatchedL1 c+    it "umatchedR0 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR0 b + ((unmatchedR0 a - unmatchedL1 b) `max` 0) `shouldBe` unmatchedR0 c+    it "umatchedR1 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR1 b + ((unmatchedR1 a - unmatchedL0 b) `max` 0) `shouldBe` unmatchedR1 c+  describe "For Word16" $ do+    it "umatchedL0 concatentation" $+      property $ \(a :: Word16) (b :: Word16) ->+        let c :: Word32 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL0 a + ((unmatchedL0 b - unmatchedR1 a) `max` 0) `shouldBe` unmatchedL0 c+    it "umatchedL1 concatentation" $+      property $ \(a :: Word16) (b :: Word16) ->+        let c :: Word32 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL1 a + ((unmatchedL1 b - unmatchedR0 a) `max` 0) `shouldBe` unmatchedL1 c+    it "umatchedR0 concatentation" $+      property $ \(a :: Word16) (b :: Word16) ->+        let c :: Word32 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR0 b + ((unmatchedR0 a - unmatchedL1 b) `max` 0) `shouldBe` unmatchedR0 c+    it "umatchedR1 concatentation" $+      property $ \(a :: Word16) (b :: Word16) ->+        let c :: Word32 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR1 b + ((unmatchedR1 a - unmatchedL0 b) `max` 0) `shouldBe` unmatchedR1 c+  describe "For Word32" $ do+    it "umatchedL0 concatentation" $+      property $ \(a :: Word32) (b :: Word32) ->+        let c :: Word64 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL0 a + ((unmatchedL0 b - unmatchedR1 a) `max` 0) `shouldBe` unmatchedL0 c+    it "umatchedL1 concatentation" $+      property $ \(a :: Word32) (b :: Word32) ->+        let c :: Word64 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL1 a + ((unmatchedL1 b - unmatchedR0 a) `max` 0) `shouldBe` unmatchedL1 c+    it "umatchedR0 concatentation" $+      property $ \(a :: Word32) (b :: Word32) ->+        let c :: Word64 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR0 b + ((unmatchedR0 a - unmatchedL1 b) `max` 0) `shouldBe` unmatchedR0 c+    it "umatchedR1 concatentation" $+      property $ \(a :: Word32) (b :: Word32) ->+        let c :: Word64 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR1 b + ((unmatchedR1 a - unmatchedL0 b) `max` 0) `shouldBe` unmatchedR1 c+  describe "For (DVS.Vector Word8)" $ do+    it "umatchedL0 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c = DVS.fromList [a, b] in+        let d :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL0 d `shouldBe` unmatchedL0 c+    it "umatchedL1 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c = DVS.fromList [a, b] in+        let d :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedL1 d `shouldBe` unmatchedL1 c+    it "umatchedR0 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c = DVS.fromList [a, b] in+        let d :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR0 d `shouldBe` unmatchedR0 c+    it "umatchedR1 concatentation" $+      property $ \(a :: Word8) (b :: Word8) ->+        let c = DVS.fromList [a, b] in+        let d :: Word16 = (fromIntegral a) .|. (fromIntegral b .<. fixedBitSize b) in+        unmatchedR1 d `shouldBe` unmatchedR1 c