X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=blobdiff_plain;f=Codec%2FAudio%2FWavPack%2FInternal.hs;h=99ff05c811326c2293bb6eb1ea073bf71c3c668e;hp=b852a76c74078f41e6260041de7ec853ae5deb78;hb=c12220b6ce900bced2b48b1fbc3a098e06d94946;hpb=78a686c2314abc67b3f388833c255a102fe63024 diff --git a/Codec/Audio/WavPack/Internal.hs b/Codec/Audio/WavPack/Internal.hs index b852a76..99ff05c 100644 --- a/Codec/Audio/WavPack/Internal.hs +++ b/Codec/Audio/WavPack/Internal.hs @@ -12,6 +12,10 @@ module Codec.Audio.WavPack.Internal , exp2s , exp2 + + , countBits + + , b2n ) where import Data.Int @@ -24,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 @@ -35,12 +40,13 @@ packWeight !w fromIntegral w''' -- | Convert a packed weight to internal weight (+/-1024). Note that --- the following equation might not hold because 'packWeight' is +-- the following equation /might not hold/ because 'packWeight' is -- lossy. -- -- > unpackWeight . packWeight = id -- unpackWeight ∷ Word8 → Int16 +{-# INLINEABLE unpackWeight #-} unpackWeight !w = let w' ∷ Int8 w' = fromIntegral w @@ -55,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 @@ -70,30 +77,31 @@ log2s !n -- zero and can therefore represent both zero and negative -- values. They have 8 bits of precision and in \"roundtrip\" -- conversions the total error never exceeds 1 part in 225 except for --- the cases of +/-115 and +/-195 (which error by 1). +-- the cases of +\/-115 and +\/-195 (which error by 1). -- -- This function returns the log2 for the specified 32-bit unsigned -- 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 @@ -105,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 @@ -112,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 @@ -123,10 +133,28 @@ exp2 !l else exp2l `shiftL` fromIntegral (l' - 9) -getNBits ∷ Word8 → Word8 -getNBits = UV.unsafeIndex nbitsTable ∘ fromIntegral +-- | 'countBits' @av@ returns the number of bits that is required to +-- represent @av@. +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 + +-- | 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 + {-# NOINLINE nbitsTable #-} nbitsTable = UV.fromList [ 0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4 -- 0 - 15 @@ -147,10 +175,12 @@ 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 + {-# NOINLINE log2Table #-} log2Table = UV.fromList [ 0x00, 0x01, 0x03, 0x04, 0x06, 0x07, 0x09, 0x0a, 0x0B, 0x0D, 0x0E, 0x10, 0x11, 0x12, 0x14, 0x15 @@ -171,10 +201,12 @@ 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 + {-# NOINLINE exp2Table #-} exp2Table = UV.fromList [ 0x00, 0x01, 0x01, 0x02, 0x03, 0x03, 0x04, 0x05, 0x06, 0x06, 0x07, 0x08, 0x08, 0x09, 0x0a, 0x0B