bugfix of consRem

diff --git a/Codec/Audio/WavPack/BitString.hs b/Codec/Audio/WavPack/BitString.hs
index 136ddf8d7672a65fe55a13ec12b7de12e5101612..11302768c4ba9a5b7a06f7eafada9bdc27296515 100644 (file)
--- a/Codec/Audio/WavPack/BitString.hs
+++ b/Codec/Audio/WavPack/BitString.hs
@@ -11,6 +11,7 @@ module Codec.Audio.WavPack.BitString
 
       -- * Construction
     , (∅)
+    , empty
     , singleton
 
       -- * Basic Interface
@@ -49,7 +50,33 @@ data BitString
       , rightBytes ∷ !L.ByteString
       , rightRem   ∷ !Remnant
       }
-    deriving (Eq, Show)
+    deriving Show
+
+instance Eq BitString where
+    a == b = leftRem    a' ≡ leftRem    b' ∧
+             leftBytes  a' ≡ leftBytes  b' ∧
+             rightRem   a' ≡ rightRem   b'
+        where
+          a' = normalise a
+          b' = normalise b
+
+normalise ∷ BitString → BitString
+normalise bs
+    | remLen (leftRem bs) ≡ 8
+        = normalise $ bs {
+                        leftRem   = remEmpty
+                      , leftBytes = L.cons (remByte $ leftRem bs) $ leftBytes bs
+                      }
+    | remLen (rightRem bs) ≡ 8
+        = normalise $ bs {
+                        rightBytes = L.cons (remByte $ rightRem bs) $ rightBytes bs
+                      , rightRem   = remEmpty
+                      }
+    | otherwise
+        = bs {
+            leftBytes  = leftBytes bs `L.append` (L.reverse $ rightBytes bs)
+          , rightBytes = L.empty
+          }
 
 data Remnant
     = Remnant {
@@ -94,7 +121,7 @@ consRem b r
                       in
                         (# r', S.Nothing #)
     where
-      w' = (remByte r `shiftR` 1)
+      w' = (remByte r `shiftL` 1)
            .|.
            if b then 1 else 0
 
@@ -115,7 +142,7 @@ snocRem r b
 unconsRem ∷ Remnant → (# S.Maybe Bool, Remnant #)
 unconsRem r
     | remNull r = (# S.Nothing, remEmpty #)
-    | otherwise = let !b  = remByte r `testBit` 1
+    | otherwise = let !b  = remByte r `testBit` 0
                       !r' = Remnant {
                               remLen  = remLen r - 1
                             , remByte = remByte r `shiftR` 1
@@ -153,14 +180,18 @@ splitRemAt n r
     | otherwise
         = (# S.Nothing, remEmpty #)
 
--- | /O(1)/ The empty 'BitString'.
+-- | /O(1)/ The same as 'empty'.
 (∅) ∷ BitString
-(∅) = BitString {
-        leftRem    = remEmpty
-      , leftBytes  = L.empty
-      , rightBytes = L.empty
-      , rightRem   = remEmpty
-      }
+(∅) = empty
+
+-- | /O(1)/ The empty 'BitString'.
+empty ∷ BitString
+empty = BitString {
+          leftRem    = remEmpty
+        , leftBytes  = L.empty
+        , rightBytes = L.empty
+        , rightRem   = remEmpty
+        }
 
 -- | /O(1)/ Convert a 'Bool' into a 'BitString'.
 singleton ∷ Bool → BitString
@@ -250,13 +281,13 @@ uncons bs
 -- | /O(1)/ Test whether a 'BitString' is empty.
 null ∷ BitString → Bool
 null bs
-    = remLen (leftRem bs) ≡ 0
+    = remNull (leftRem bs)
       ∧
       L.null (leftBytes bs)
       ∧
       L.null (rightBytes bs)
       ∧
-      remLen (rightRem bs) ≡ 0
+      remNull (rightRem bs)
 
 -- | /O(n)/ Return the number of bits in a 'BitString'.
 length ∷ Integral n ⇒ BitString → n