started implementing readCode

diff --git a/Codec/Audio/WavPack/Internal.hs b/Codec/Audio/WavPack/Internal.hs
index 5769a3fac37f202ab813a0f4074d467b3e6610d6..7d3cdf4948136fc21755425ad41d3128055027c2 100644 (file)
--- a/Codec/Audio/WavPack/Internal.hs
+++ b/Codec/Audio/WavPack/Internal.hs
@@ -14,6 +14,8 @@ module Codec.Audio.WavPack.Internal
     , exp2
 
     , countBits
+
+    , b2n
     )
     where
 import Data.Int
@@ -26,6 +28,7 @@ import Prelude.Unicode
 -- signed character version for storage in metadata. The weights are
 -- clipped here in the case they are outside that range.
 packWeight ∷ Int16 → Word8
+{-# INLINEABLE packWeight #-}
 packWeight !w
     = let !w'   | w  >  1024 =  1024
                 | w  < -1024 = -1024
@@ -43,6 +46,7 @@ packWeight !w
 -- > unpackWeight . packWeight = id
 --
 unpackWeight ∷ Word8 → Int16
+{-# INLINEABLE unpackWeight #-}
 unpackWeight !w
     = let w'  ∷ Int8
           w'  = fromIntegral w
@@ -57,6 +61,7 @@ unpackWeight !w
 -- input values are valid and the return values are in the range of
 -- +/-8192.
 log2s ∷ Int32 → Int16
+{-# INLINE log2s #-}
 log2s !n
     | n < 0     = fromIntegral $ negate $ log2 $ fromIntegral $ negate n
     | otherwise = fromIntegral $ log2 $ fromIntegral n
@@ -78,24 +83,25 @@ log2s !n
 -- value. The maximum value allowed is about 0xff800000 and returns
 -- 8447.
 log2 ∷ Word32 → Word16
+{-# INLINEABLE log2 #-}
 log2 !n
     | n' < (1 `shiftL` 8)
         = let dbits  ∷ Word16
-              dbits  = fromIntegral $ getNBits $ fromIntegral n'
+              !dbits = getNBits $ fromIntegral n'
               !index = (n' `shiftL` fromIntegral (9 - dbits)) .&. 0xFF
-              !log2n = fromIntegral $ getLog2 $ fromIntegral index
+              !log2n = getLog2 $ fromIntegral index
           in
             (dbits `shiftL` 8) + log2n
     | otherwise
         = let dbits ∷ Word16
-              dbits | n' < (1 `shiftL` 16)
-                        = fromIntegral (getNBits $ fromIntegral $ n' `shiftR`  8) +  8
-                    | n' < (1 `shiftL` 24)
-                        = fromIntegral (getNBits $ fromIntegral $ n' `shiftR` 16) + 16
-                    | otherwise
-                        = fromIntegral (getNBits $ fromIntegral $ n' `shiftR` 24) + 24
+              !dbits | n' < (1 `shiftL` 16)
+                         = (getNBits $ fromIntegral $ n' `shiftR`  8) +  8
+                     | n' < (1 `shiftL` 24)
+                         = (getNBits $ fromIntegral $ n' `shiftR` 16) + 16
+                     | otherwise
+                         = (getNBits $ fromIntegral $ n' `shiftR` 24) + 24
               !index = (n' `shiftR` fromIntegral (dbits - 9)) .&. 0xFF
-              !log2n = fromIntegral $ getLog2 $ fromIntegral index
+              !log2n = getLog2 $ fromIntegral index
           in
             (dbits `shiftL` 8) + log2n
     where
@@ -107,6 +113,7 @@ log2 !n
 -- since a full 32-bit value is returned this can be used for unsigned
 -- conversions as well (i.e. the input range is -8192 to +8447).
 exp2s ∷ Int16 → Int32
+{-# INLINE exp2s #-}
 exp2s !l
     | l < 0     = fromIntegral $ negate $ exp2 $ fromIntegral $ negate l
     | otherwise = fromIntegral $ exp2 $ fromIntegral l
@@ -114,9 +121,10 @@ exp2s !l
 -- | Return the original integer represented by the supplied logarithm
 -- (at least within the provided accuracy).
 exp2 ∷ Word16 → Word32
+{-# INLINEABLE exp2 #-}
 exp2 !l
     = let exp2l ∷ Word32
-          exp2l = fromIntegral (getExp2 $ fromIntegral $ l .&. 0xFF) .|. 0x100
+          exp2l = (getExp2 $ fromIntegral $ l .&. 0xFF) .|. 0x100
           l'    ∷ Word32
           l'    = fromIntegral $ l `shiftR` 8
       in
@@ -127,15 +135,23 @@ exp2 !l
 
 -- | 'countBits' @av@ returns the number of bits that is required to
 -- represent @av@.
-countBits ∷ Word32 → Word8
+countBits ∷ Num a ⇒ Word32 → a
+{-# INLINEABLE countBits #-}
 countBits av
     | av < (1 `shiftL`  8) = getNBits (fromIntegral  av)
     | av < (1 `shiftL` 16) = getNBits (fromIntegral (av `shiftR`  8)) +  8
     | av < (1 `shiftL` 24) = getNBits (fromIntegral (av `shiftR` 16)) + 16
     | otherwise            = getNBits (fromIntegral (av `shiftR` 24)) + 24
 
-getNBits ∷ Word8 → Word8
-getNBits = UV.unsafeIndex nbitsTable ∘ fromIntegral
+-- | Return 0 for 'False' and 1 for 'True'.
+b2n ∷ Num a ⇒ Bool → a
+{-# INLINE b2n #-}
+b2n True  = 1
+b2n False = 0
+
+getNBits ∷ Num a ⇒ Word8 → a
+{-# INLINE getNBits #-}
+getNBits = fromIntegral ∘ UV.unsafeIndex nbitsTable ∘ fromIntegral
     where
       nbitsTable ∷ UV.Vector Word8
       nbitsTable
@@ -158,8 +174,9 @@ getNBits = UV.unsafeIndex nbitsTable ∘ fromIntegral
             , 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8 -- 240 - 255
             ]
 
-getLog2 ∷ Word8 → Word8
-getLog2 = UV.unsafeIndex log2Table ∘ fromIntegral
+getLog2 ∷ Num n ⇒ Word8 → n
+{-# INLINE getLog2 #-}
+getLog2 = fromIntegral ∘ UV.unsafeIndex log2Table ∘ fromIntegral
     where
       log2Table ∷ UV.Vector Word8
       log2Table
@@ -182,8 +199,9 @@ getLog2 = UV.unsafeIndex log2Table ∘ fromIntegral
             , 0xF4, 0xF5, 0xF6, 0xF7, 0xF7, 0xF8, 0xF9, 0xF9, 0xFa, 0xFB, 0xFC, 0xFC, 0xFD, 0xFE, 0xFF, 0xFF
             ]
 
-getExp2 ∷ Word8 → Word8
-getExp2 = UV.unsafeIndex exp2Table ∘ fromIntegral
+getExp2 ∷ Num n ⇒ Word8 → n
+{-# INLINE getExp2 #-}
+getExp2 = fromIntegral ∘ UV.unsafeIndex exp2Table ∘ fromIntegral
     where
       exp2Table ∷ UV.Vector Word8
       exp2Table

diff --git a/Codec/Audio/WavPack/Unpack.hs b/Codec/Audio/WavPack/Unpack.hs
new file mode 100644 (file)
index 0000000..8d27906
--- /dev/null
+++ b/Codec/Audio/WavPack/Unpack.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
+module Codec.Audio.WavPack.Unpack
+    (
+    )
+    where
+import Codec.Audio.WavPack.Internal
+import Data.Bits
+import Data.Bitstream.Generic (Bitstream)
+import qualified Data.Bitstream.Generic as B
+import Data.Word
+
+-- Read a single unsigned value from the specified bitstream with a
+-- value from 0 to maxCode. If there are exactly a power of two number
+-- of possible codes then this will read a fixed number of bits;
+-- otherwise it reads the minimum number of bits and then determines
+-- whether another bit is needed to define the code.
+readCode ∷ Bitstream bs ⇒ bs → Word32 → (Word32, bs)
+{-# INLINEABLE readCode #-}
+readCode bs 0       = (0, bs)
+readCode bs 1       = (b2n $ B.head bs, B.tail bs)
+readCode bs maxCode
+    = let !bitCount = countBits maxCode
+          !extras   = (1 `shiftL` bitCount) - maxCode - 1
+      in
+        error "unk"
\ No newline at end of file

diff --git a/wavpack.cabal b/wavpack.cabal
index 06ebd9535c9ef900b2c60c573eb0838cdae3e84e..399a28491fd12f2808da90f08829c4062e831076 100644 (file)
--- a/wavpack.cabal
+++ b/wavpack.cabal
@@ -46,6 +46,7 @@ Library
         Codec.Audio.WavPack.Decorrelation
         Codec.Audio.WavPack.Internal
         Codec.Audio.WavPack.Metadata
+        Codec.Audio.WavPack.Unpack
 
     GHC-Options:
         -Wall