Codec/Audio/WavPack/Unpack.hs

   1 {-# LANGUAGE
   2     BangPatterns
   3   , UnboxedTuples
   4   , UnicodeSyntax
   5   #-}
   6 module Codec.Audio.WavPack.Unpack
   7     (
   8     )
   9     where
  10 import Codec.Audio.WavPack.Internal
  11 import Data.Bits
  12 import Data.Bitstream.Generic (Bitstream)
  13 import qualified Data.Bitstream.Generic as B
  14 import Data.Word
  15 import Prelude.Unicode
  16
  17 -- Read a single unsigned value from the specified bitstream with a
  18 -- value from 0 to maxCode. If there are exactly a power of two number
  19 -- of possible codes then this will read a fixed number of bits;
  20 -- otherwise it reads the minimum number of bits and then determines
  21 -- whether another bit is needed to define the code.
  22 readCode ∷ Bitstream bs ⇒ bs → Word32 → (# Word32, bs #)
  23 {-# INLINEABLE readCode #-}
  24 readCode bs 0       = (# 0, bs #)
  25 readCode bs 1       = (# b2n (B.head bs), B.tail bs #)
  26 readCode bs maxCode
  27     = let !bitCount = countBits maxCode
  28           !extras   = bit bitCount - maxCode - 1
  29           !code     = B.toBits (B.take (bitCount - 1) bs)
  30           (# code', bitCount' #)
  31                     = if code ≥ extras then
  32                           (# (code `shiftL` 1)
  33                              - extras
  34                              + b2n (bs B.!! bitCount)
  35                            , bitCount #)
  36                       else
  37                           (# code, bitCount - 1 #)
  38           !bs'      = B.drop bitCount' bs
  39       in
  40         (# code', bs' #)