diff --git a/AUTHORS b/AUTHORS --- a/AUTHORS +++ b/AUTHORS @@ -3,3 +3,4 @@ * Mark Wotton * Jaap ter Woerds * PHO +* Anton Gushcha diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2015-03-04 PHO + + * Data/Bitstream.hs, Data/Bitstream/Lazy.hs: Fix Haddock comments + mentioning a wrong module name, Reported by sebastianv89 (#3). + 2015-01-15 PHO * bitstream.cabal: Bump version to 0.2.0.4 diff --git a/Data/Bitstream.hs b/Data/Bitstream.hs --- a/Data/Bitstream.hs +++ b/Data/Bitstream.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns + , CPP , FlexibleContexts , FlexibleInstances , ScopedTypeVariables @@ -13,7 +14,7 @@ -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions. e.g. -- --- > import qualified Data.BitStream as BS +-- > import qualified Data.Bitstream as BS -- -- Strict 'Bitstream's are made of strict 'SV.Vector' of 'Packet's, -- and each 'Packet's have at least 1 bit. @@ -42,7 +43,7 @@ , fromNBits , toBits - -- ** Converting from\/to 'S.Stream's + -- ** Converting from\/to 'Stream's , stream , unstream , streamPackets @@ -174,9 +175,18 @@ import qualified Data.Vector.Generic.New as New import qualified Data.Vector.Generic.Mutable as MVector import qualified Data.Vector.Storable as SV -import qualified Data.Vector.Fusion.Stream as S -import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) +#if MIN_VERSION_vector(0,11,0) +import qualified Data.Vector.Fusion.Bundle as S +import qualified Data.Vector.Fusion.Bundle.Monadic as B +import Data.Vector.Fusion.Bundle (Bundle) +import Data.Vector.Fusion.Bundle.Size +#else import Data.Vector.Fusion.Stream.Size +#endif +#if MIN_VERSION_base(4,9,0) +import Prelude (Semigroup(..)) +#endif +import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) import Data.Vector.Fusion.Util import Prelude ( Bool(..), Eq(..), Int, Integral, Maybe(..), Monad(..), Num(..) , Ord(..), Show(..), ($), error, fmap, fromIntegral, fst @@ -228,6 +238,16 @@ {-# INLINE compare #-} x `compare` y = stream x `compare` stream y +#if MIN_VERSION_base(4,9,0) +-- | 'Bitstream' forms 'Semigroup' in the same way as ordinary lists: +-- +-- @ +-- '(<>)' = 'append' +-- @ +instance G.Bitstream (Bitstream d) ⇒ Semigroup (Bitstream d) where + (<>) = (⧺) +#endif + -- | 'Bitstream' forms 'Monoid' in the same way as ordinary lists: -- -- @ @@ -350,7 +370,11 @@ {-# INLINEABLE basicToBits #-} basicToBits = unId ∘ bePacketsToBits ∘ streamPackets -strictStream ∷ G.Bitstream (Packet d) ⇒ Bitstream d → S.Stream Bool +#if MIN_VERSION_vector(0,11,0) +strictStream ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bundle SV.Vector Bool +#else +strictStream ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Stream Bool +#endif {-# INLINE strictStream #-} strictStream (Bitstream l v) = {-# CORE "Strict Bitstream stream" #-} @@ -358,7 +382,11 @@ `S.sized` Exact l -strictUnstream ∷ G.Bitstream (Packet d) ⇒ S.Stream Bool → Bitstream d +#if MIN_VERSION_vector(0,11,0) +strictUnstream ∷ G.Bitstream (Packet d) ⇒ Bundle SV.Vector Bool → Bitstream d +#else +strictUnstream ∷ G.Bitstream (Packet d) ⇒ Stream Bool → Bitstream d +#endif {-# INLINE strictUnstream #-} strictUnstream = {-# CORE "Strict Bitstream unstream" #-} @@ -485,7 +513,11 @@ = unstreamPackets ∘ takeWhilePS ∘ streamPackets where {-# INLINE takeWhilePS #-} +#if MIN_VERSION_vector(0,11,0) + takeWhilePS (B.Bundle (Stream step s0) _ _ sz) = B.fromStream (Stream step' (Just s0)) (toMax sz) +#else takeWhilePS (Stream step s0 sz) = Stream step' (Just s0) (toMax sz) +#endif where {-# INLINE step' #-} step' Nothing = return Done @@ -523,7 +555,11 @@ = unstreamPackets ∘ filterPS ∘ streamPackets where {-# INLINE filterPS #-} +#if MIN_VERSION_vector(0,11,0) + filterPS (B.Bundle (Stream step s0) _ _ sz) = B.fromStream (Stream step' s0) (toMax sz) +#else filterPS (Stream step s0 sz) = Stream step' s0 (toMax sz) +#endif where {-# INLINE step' #-} step' s @@ -622,12 +658,21 @@ , G.Bitstream (Packet d) ) ⇒ Bitstream d → BS.ByteString toByteString = unstreamBS +#if MIN_VERSION_vector(0,11,0) + ∘ (packPackets ∷ B.Bundle Id SV.Vector Bool → B.Bundle Id SV.Vector (Packet d)) +#else ∘ (packPackets ∷ Stream Id Bool → Stream Id (Packet d)) +#endif ∘ stream -unstreamBS ∷ Stream Id (Packet d) → BS.ByteString {-# INLINE unstreamBS #-} +#if MIN_VERSION_vector(0,11,0) +unstreamBS ∷ B.Bundle Id SV.Vector (Packet d) → BS.ByteString +unstreamBS (B.Bundle (Stream step s0) _ _ sz) +#else +unstreamBS ∷ Stream Id (Packet d) → BS.ByteString unstreamBS (Stream step s0 sz) +#endif = case upperBound sz of Just n → fst $ BS.unfoldrN n (unId ∘ go) s0 Nothing → BS.unfoldr (unId ∘ go) s0 @@ -662,13 +707,21 @@ {-# INLINE toPackets #-} toPackets (Bitstream _ d) = d --- | /O(1)/ Convert a 'Bitstream' into a 'S.Stream' of 'Packet's. -streamPackets ∷ Bitstream d → S.Stream (Packet d) +-- | /O(1)/ Convert a 'Bitstream' into a 'Stream' of 'Packet's. +#if MIN_VERSION_vector(0,11,0) +streamPackets ∷ Bitstream d → Bundle SV.Vector (Packet d) +#else +streamPackets ∷ Bitstream d → Stream (Packet d) +#endif {-# NOINLINE streamPackets #-} streamPackets (Bitstream _ v) = GV.stream v --- | /O(n)/ Convert a 'S.Stream' of 'Packet's into 'Bitstream'. -unstreamPackets ∷ G.Bitstream (Packet d) ⇒ S.Stream (Packet d) → Bitstream d +-- | /O(n)/ Convert a 'Stream' of 'Packet's into 'Bitstream'. +#if MIN_VERSION_vector(0,11,0) +unstreamPackets ∷ G.Bitstream (Packet d) ⇒ Bundle SV.Vector (Packet d) → Bitstream d +#else +unstreamPackets ∷ G.Bitstream (Packet d) ⇒ Stream (Packet d) → Bitstream d +#endif {-# NOINLINE unstreamPackets #-} unstreamPackets s = let !v = GV.unstream s @@ -738,7 +791,7 @@ -- | /O(n)/ Write a 'Bitstream' to a file. writeFile ∷ ( G.Bitstream (Bitstream d) , G.Bitstream (Packet d) - ) + ) ⇒ FilePath → Bitstream d → IO () diff --git a/Data/Bitstream/Fusion.hs b/Data/Bitstream/Fusion.hs --- a/Data/Bitstream/Fusion.hs +++ b/Data/Bitstream/Fusion.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - UnicodeSyntax + CPP + , UnicodeSyntax #-} -- | Some functions currently missing from -- "Data.Vector.Fusion.Stream". @@ -15,39 +16,83 @@ ) where import qualified Data.Bitstream.Fusion.Monadic as M +#if MIN_VERSION_vector(0,11,0) +import Data.Bifunctor (first) +import Data.Vector.Fusion.Bundle as B +import Data.Vector.Fusion.Bundle.Size +#else import Data.Vector.Fusion.Stream -import Data.Vector.Fusion.Util +#endif import Prelude hiding (replicate) -import Prelude.Unicode -genericLength ∷ Num n ⇒ Stream α → n {-# INLINE genericLength #-} +#if MIN_VERSION_vector(0,11,0) +genericLength ∷ Num n ⇒ Bundle v α → n +genericLength = fromIntegral . B.length +#else +genericLength ∷ Num n ⇒ Stream α → n genericLength = unId ∘ M.genericLength +#endif -genericTake ∷ Integral n ⇒ n → Stream α → Stream α {-# INLINE genericTake #-} +#if MIN_VERSION_vector(0,11,0) +genericTake ∷ Integral n ⇒ n → Bundle v α → Bundle v α +genericTake n = inplace (M.genericTake n) toMax +#else +genericTake ∷ Integral n ⇒ n → Stream α → Stream α genericTake = M.genericTake +#endif -genericDrop ∷ Integral n ⇒ n → Stream α → Stream α {-# INLINE genericDrop #-} +#if MIN_VERSION_vector(0,11,0) +genericDrop ∷ Integral n ⇒ n → Bundle v α → Bundle v α +genericDrop n = inplace (M.genericDrop n) toMax +#else +genericDrop ∷ Integral n ⇒ n → Stream α → Stream α genericDrop = M.genericDrop +#endif -genericIndex ∷ (Integral n, Show n) ⇒ Stream α → n → α {-# INLINE genericIndex #-} +#if MIN_VERSION_vector(0,11,0) +genericIndex ∷ (Integral n, Show n) ⇒ Bundle v α → n → α +genericIndex s i = s B.!! (fromIntegral i) +#else +genericIndex ∷ (Integral n, Show n) ⇒ Stream α → n → α genericIndex s = unId ∘ M.genericIndex s +#endif -genericReplicate ∷ Integral n ⇒ n → α → Stream α {-# INLINE genericReplicate #-} +#if MIN_VERSION_vector(0,11,0) +genericReplicate ∷ Integral n ⇒ n → α → Bundle v α +genericReplicate = B.replicate . fromIntegral +#else +genericReplicate ∷ Integral n ⇒ n → α → Stream α genericReplicate = M.genericReplicate +#endif -genericUnfoldrN ∷ Integral n ⇒ n → (β → Maybe (α, β)) → β → Stream α {-# INLINE genericUnfoldrN #-} +#if MIN_VERSION_vector(0,11,0) +genericUnfoldrN ∷ Integral n ⇒ n → (β → Maybe (α, β)) → β → Bundle v α +genericUnfoldrN = B.unfoldrN . fromIntegral +#else +genericUnfoldrN ∷ Integral n ⇒ n → (β → Maybe (α, β)) → β → Stream α genericUnfoldrN = M.genericUnfoldrN +#endif -genericFindIndex ∷ Integral n ⇒ (α → Bool) → Stream α → Maybe n {-# INLINE genericFindIndex #-} +#if MIN_VERSION_vector(0,11,0) +genericFindIndex ∷ Integral n ⇒ (α → Bool) → Bundle v α → Maybe n +genericFindIndex f = fmap fromIntegral . B.findIndex f +#else +genericFindIndex ∷ Integral n ⇒ (α → Bool) → Stream α → Maybe n genericFindIndex f = unId ∘ M.genericFindIndex f +#endif -genericIndexed ∷ Integral n ⇒ Stream α → Stream (n, α) {-# INLINE genericIndexed #-} +#if MIN_VERSION_vector(0,11,0) +genericIndexed ∷ Integral n ⇒ Bundle v α → Bundle v (n, α) +genericIndexed = fmap (first fromIntegral) . B.indexed +#else +genericIndexed ∷ Integral n ⇒ Stream α → Stream (n, α) genericIndexed = M.genericIndexed +#endif diff --git a/Data/Bitstream/Fusion/Monadic.hs b/Data/Bitstream/Fusion/Monadic.hs --- a/Data/Bitstream/Fusion/Monadic.hs +++ b/Data/Bitstream/Fusion/Monadic.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns + , CPP , UnicodeSyntax #-} -- | Some functions currently missing from @@ -19,7 +20,10 @@ ) where import Data.Vector.Fusion.Stream.Monadic +#if MIN_VERSION_vector(0,11,0) +#else import Data.Vector.Fusion.Stream.Size +#endif import Prelude hiding ((!!), drop, replicate, take) import Prelude.Unicode @@ -30,7 +34,11 @@ genericTake ∷ (Monad m, Integral n) ⇒ n → Stream m α → Stream m α {-# INLINE [0] genericTake #-} {-# RULES "genericTake → take" genericTake = take #-} +#if MIN_VERSION_vector(0,11,0) +genericTake n (Stream step s0) = Stream step' (s0, 0) +#else genericTake n (Stream step s0 sz) = Stream step' (s0, 0) (toMax sz) +#endif where {-# INLINE step' #-} step' (s, i) @@ -46,7 +54,11 @@ genericDrop ∷ (Monad m, Integral n) ⇒ n → Stream m α → Stream m α {-# INLINE [0] genericDrop #-} {-# RULES "genericDrop → drop" genericDrop = drop #-} +#if MIN_VERSION_vector(0,11,0) +genericDrop n0 (Stream step s0) = Stream step' (s0, Just n0) +#else genericDrop n0 (Stream step s0 sz) = Stream step' (s0, Just n0) (toMax sz) +#endif where {-# INLINE step' #-} step' (s, Just n) @@ -69,7 +81,11 @@ genericIndex ∷ (Monad m, Integral n, Show n) ⇒ Stream m α → n → m α {-# INLINE [0] genericIndex #-} {-# RULES "genericIndex → (!!)" genericIndex = (!!) #-} +#if MIN_VERSION_vector(0,11,0) +genericIndex (Stream step s0) i0 +#else genericIndex (Stream step s0 _) i0 +#endif | i0 < 0 = fail ("genericIndex: out of range: " ⧺ show i0) | otherwise = index_loop s0 0 where @@ -120,7 +136,11 @@ genericFindIndexM ∷ (Monad m, Integral n) ⇒ (α → m Bool) → Stream m α → m (Maybe n) {-# INLINE [0] genericFindIndexM #-} {-# RULES "genericFindIndexM → findIndexM" genericFindIndexM = findIndexM #-} +#if MIN_VERSION_vector(0,11,0) +genericFindIndexM f (Stream step s0) = findIndex_loop s0 0 +#else genericFindIndexM f (Stream step s0 _) = findIndex_loop s0 0 +#endif where {-# INLINE findIndex_loop #-} findIndex_loop s i @@ -135,7 +155,11 @@ genericIndexed ∷ (Monad m, Integral n) ⇒ Stream m α → Stream m (n, α) {-# INLINE [0] genericIndexed #-} {-# RULES "genericIndexed → indexed" genericIndexed = indexed #-} +#if MIN_VERSION_vector(0,11,0) +genericIndexed (Stream step s0) = Stream step' (s0, 0) +#else genericIndexed (Stream step s0 sz) = Stream step' (s0, 0) sz +#endif where {-# INLINE step' #-} step' (s, i) diff --git a/Data/Bitstream/Generic.hs b/Data/Bitstream/Generic.hs --- a/Data/Bitstream/Generic.hs +++ b/Data/Bitstream/Generic.hs @@ -122,8 +122,14 @@ import Data.Bits import Data.Bitstream.Fusion import Data.Maybe +#if MIN_VERSION_vector(0,11,0) +import Data.Vector.Fusion.Bundle (Bundle) +import qualified Data.Vector.Fusion.Bundle as S +import qualified Data.Vector.Storable as SV +#else import Data.Vector.Fusion.Stream (Stream) import qualified Data.Vector.Fusion.Stream as S +#endif import Prelude ( Bool(..), Integer, Integral(..), Num(..), Show(..), ($) , fst, flip, otherwise, snd ) @@ -147,13 +153,14 @@ -- Methods of this class are functions of 'Bitstream's that are either -- basic functions to implement other ones, or have to preserve their -- packet/chunk structure for efficiency and strictness behaviour. --- --- Minimum complete implementation: /All but/ 'basicCons'', --- 'basicConcat', 'basicReplicate', 'basicPartition' and --- 'basicFromBits'. class Bitstream α where +#if MIN_VERSION_vector(0,11,0) + basicStream ∷ α → Bundle SV.Vector Bool + basicUnstream ∷ Bundle SV.Vector Bool → α +#else basicStream ∷ α → Stream Bool basicUnstream ∷ Stream Bool → α +#endif basicCons ∷ Bool → α → α basicCons' ∷ Bool → α → α @@ -276,12 +283,20 @@ -- The automatic fusion rules are carefully designed to fire only when -- there aren't any reason to preserve the original packet / chunk -- structure. +#if MIN_VERSION_vector(0,11,0) +stream ∷ Bitstream α ⇒ α → Bundle SV.Vector Bool +#else stream ∷ Bitstream α ⇒ α → Stream Bool +#endif {-# NOINLINE stream #-} stream = basicStream -- | /O(n)/ Convert a 'S.Stream' of 'Bool' into a 'Bitstream'. +#if MIN_VERSION_vector(0,11,0) +unstream ∷ Bitstream α ⇒ Bundle SV.Vector Bool → α +#else unstream ∷ Bitstream α ⇒ Stream Bool → α +#endif {-# NOINLINE unstream #-} unstream = basicUnstream @@ -681,7 +696,7 @@ -- returns a tuple where first element is longest prefix (possibly -- 'empty') of @xs@ of bits that satisfy @p@ and second element is the -- remainder of the 'Bitstream'. --- +-- -- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p -- xs)@ span ∷ Bitstream α ⇒ (Bool → Bool) → α → (α, α) diff --git a/Data/Bitstream/Internal.hs b/Data/Bitstream/Internal.hs --- a/Data/Bitstream/Internal.hs +++ b/Data/Bitstream/Internal.hs @@ -1,13 +1,16 @@ {-# LANGUAGE BangPatterns + , CPP , FlexibleContexts , UnicodeSyntax #-} module Data.Bitstream.Internal ( packPackets + , packPacketsSize , lePacketsFromNBits , bePacketsFromNBits + , packetsFromNBitsSize , lePacketsToBits , bePacketsToBits @@ -17,22 +20,40 @@ import Data.Bitstream.Generic import Data.Bitstream.Packet import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) +#if MIN_VERSION_vector(0,11,0) +import qualified Data.Vector.Fusion.Bundle.Monadic as B +import Data.Vector.Fusion.Bundle.Monadic (Bundle) +import Data.Vector.Fusion.Bundle.Size +#else import Data.Vector.Fusion.Stream.Size +#endif import Prelude hiding (length, null) import Prelude.Unicode -packPackets ∷ (Bitstream (Packet d), Monad m) ⇒ Stream m Bool → Stream m (Packet d) +packPacketsSize ∷ Size -> Size +{-# INLINE packPacketsSize #-} +packPacketsSize sz = case sz of + Exact n → Exact ((n+7) `div` 8) + Max n → Max ((n+7) `div` 8) + Unknown → Unknown + +#if MIN_VERSION_vector(0,11,0) +inplace :: Monad m => (Stream m a -> Stream m b) + -> (Size -> Size) -> Bundle m v a -> Bundle m v b +inplace f g b = b `seq` B.fromStream (f (B.elements b)) (g (B.size b)) +#endif + {-# INLINEABLE packPackets #-} -packPackets (Stream step s0 sz) = Stream step' ((∅), Just s0) sz' +#if MIN_VERSION_vector(0,11,0) +packPackets ∷ (Bitstream (Packet d), Monad m) ⇒ Bundle m v Bool → Bundle m v (Packet d) +packPackets = inplace (\(Stream s s0) -> Stream (step' s) ((∅), Just s0)) packPacketsSize +#else +packPackets ∷ (Bitstream (Packet d), Monad m) ⇒ Stream m Bool → Stream m (Packet d) +packPackets (Stream s s0 sz) = Stream (step' s) ((∅), Just s0) (packPacketsSize sz) +#endif where - sz' ∷ Size - {-# INLINE sz' #-} - sz' = case sz of - Exact n → Exact ((n+7) `div` 8) - Max n → Max ((n+7) `div` 8) - Unknown → Unknown {-# INLINE step' #-} - step' (p, Just s) + step' step (p, Just s) = do r ← step s case r of Yield b s' @@ -42,7 +63,7 @@ Done | null p → return Done | otherwise → return $ Yield p ((⊥) , Nothing) - step' (_, Nothing) + step' _ (_, Nothing) = return Done nOctets ∷ Integral n ⇒ n → Int @@ -50,6 +71,11 @@ nOctets nBits = (fromIntegral nBits + 7) `div` 8 +packetsFromNBitsSize ∷ Integral n ⇒ n → Size +packetsFromNBitsSize = Exact . nOctets + +{-# INLINEABLE lePacketsFromNBits #-} +#if MIN_VERSION_vector(0,11,0) lePacketsFromNBits ∷ ( Integral n , Integral β , Bits β @@ -57,9 +83,19 @@ ) ⇒ n → β + → Bundle m v (Packet Left) +lePacketsFromNBits n0 β0 = B.fromStream (Stream step (n0, β0)) (packetsFromNBitsSize n0) +#else +lePacketsFromNBits ∷ ( Integral n + , Integral β + , Bits β + , Monad m + ) + ⇒ n + → β → Stream m (Packet Left) -{-# INLINEABLE lePacketsFromNBits #-} -lePacketsFromNBits n0 β0 = Stream step (n0, β0) (Exact (nOctets n0)) +lePacketsFromNBits n0 β0 = Stream step (n0, β0) (packetsFromNBitsSize n0) +#endif where {-# INLINE step #-} step (n, β) @@ -73,7 +109,19 @@ | otherwise = return Done +{-# INLINEABLE bePacketsFromNBits #-} +#if MIN_VERSION_vector(0,11,0) bePacketsFromNBits ∷ ( Integral n + , Integral β + , Bits β + , Monad m + ) + ⇒ n + → β + → Bundle m v (Packet Right) +bePacketsFromNBits n0 β = B.fromStream (Stream step (n0, nOctets n0 ⋅ 8)) (packetsFromNBitsSize n0) +#else +bePacketsFromNBits ∷ ( Integral n , Integral β , Bits β , Monad m @@ -81,8 +129,8 @@ ⇒ n → β → Stream m (Packet Right) -{-# INLINEABLE bePacketsFromNBits #-} -bePacketsFromNBits n0 β = Stream step (n0, nOctets n0 ⋅ 8) (Exact (nOctets n0)) +bePacketsFromNBits n0 β = Stream step (n0, nOctets n0 ⋅ 8) (bePacketsFromNBitsSize n0) +#endif where {-# INLINE step #-} step (n, r) @@ -96,9 +144,14 @@ | otherwise = return Done -lePacketsToBits ∷ (Monad m, Integral β, Bits β) ⇒ Stream m (Packet Left) → m β {-# INLINEABLE lePacketsToBits #-} +#if MIN_VERSION_vector(0,11,0) +lePacketsToBits ∷ (Monad m, Integral β, Bits β) ⇒ Bundle m v (Packet Left) → m β +lePacketsToBits (B.Bundle (Stream step s0) _ _ _) = go (s0, 0, 0) +#else +lePacketsToBits ∷ (Monad m, Integral β, Bits β) ⇒ Stream m (Packet Left) → m β lePacketsToBits (Stream step s0 _) = go (s0, 0, 0) +#endif where {-# INLINE go #-} go (s, o, n) @@ -111,9 +164,14 @@ Skip s' → go (s', o, n) Done → return n -bePacketsToBits ∷ (Monad m, Integral β, Bits β) ⇒ Stream m (Packet Right) → m β {-# INLINEABLE bePacketsToBits #-} +#if MIN_VERSION_vector(0,11,0) +bePacketsToBits ∷ (Monad m, Integral β, Bits β) ⇒ Bundle m v (Packet Right) → m β +bePacketsToBits (B.Bundle (Stream step s0) _ _ _) = go (s0, 0) +#else +bePacketsToBits ∷ (Monad m, Integral β, Bits β) ⇒ Stream m (Packet Right) → m β bePacketsToBits (Stream step s0 _) = go (s0, 0) +#endif where {-# INLINE go #-} go (s, n) diff --git a/Data/Bitstream/Lazy.hs b/Data/Bitstream/Lazy.hs --- a/Data/Bitstream/Lazy.hs +++ b/Data/Bitstream/Lazy.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns + , CPP , FlexibleContexts , FlexibleInstances , ScopedTypeVariables @@ -12,7 +13,7 @@ -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions. e.g. -- --- > import qualified Data.BitStream.Lazy as LS +-- > import qualified Data.Bitstream.Lazy as LS -- -- Lazy 'Bitstream's are made of possibly infinite list of strict -- 'SB.Bitstream's as chunks, and each chunks have at least 1 bit. @@ -170,9 +171,20 @@ import qualified Data.ByteString.Lazy as LS import qualified Data.List as L import Data.Monoid +#if MIN_VERSION_vector(0,11,0) +import qualified Data.Vector.Fusion.Bundle as S +import qualified Data.Vector.Fusion.Bundle.Monadic as B +import Data.Vector.Fusion.Bundle (Bundle) +import Data.Vector.Fusion.Bundle.Size +#else import qualified Data.Vector.Fusion.Stream as S -import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) import Data.Vector.Fusion.Stream.Size +#endif +#if MIN_VERSION_base(4,9,0) +import Prelude (Semigroup(..)) +#endif +import Prelude (seq) +import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) import Data.Vector.Fusion.Util import qualified Data.Vector.Generic as GV import qualified Data.Vector.Generic.New as New @@ -230,6 +242,16 @@ {-# INLINE compare #-} x `compare` y = stream x `compare` stream y +#if MIN_VERSION_base(4,9,0) +-- | 'Bitstream' forms 'Semigroup' in the same way as ordinary lists: +-- +-- @ +-- '(<>)' = 'append' +-- @ +instance G.Bitstream (Bitstream d) ⇒ Semigroup (Bitstream d) where + (<>) = (⧺) +#endif + -- | 'Bitstream' forms 'Monoid' in the same way as ordinary lists: -- -- @ @@ -360,18 +382,30 @@ {-# INLINE basicToBits #-} basicToBits = unId ∘ bePacketsToBits ∘ unpackChunks ∘ streamChunks -lazyStream ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → S.Stream Bool {-# INLINE lazyStream #-} +#if MIN_VERSION_vector(0,11,0) +lazyStream ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bundle SV.Vector Bool +#else +lazyStream ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → S.Stream Bool +#endif lazyStream = {-# CORE "Lazy Bitstream stream" #-} S.concatMap stream ∘ streamChunks +{-# INLINE lazyUnstream #-} +#if MIN_VERSION_vector(0,11,0) lazyUnstream ∷ ( G.Bitstream (SB.Bitstream d) , G.Bitstream (Packet d) ) + ⇒ Bundle v Bool + → Bitstream d +#else +lazyUnstream ∷ ( G.Bitstream (SB.Bitstream d) + , G.Bitstream (Packet d) + ) ⇒ S.Stream Bool → Bitstream d -{-# INLINE lazyUnstream #-} +#endif lazyUnstream = {-# CORE "Lazy Bitstream unstream" #-} unId ∘ unstreamChunks ∘ packChunks ∘ packPackets @@ -655,25 +689,43 @@ {-# INLINE toByteString #-} toByteString = LS.fromChunks ∘ L.map SB.toByteString ∘ toChunks +{-# NOINLINE streamChunks #-} +#if MIN_VERSION_vector(0,11,0) streamChunks ∷ ( G.Bitstream (SB.Bitstream d) , Monad m ) ⇒ Bitstream d + → B.Bundle m v (SB.Bitstream d) +streamChunks ch0 = B.fromStream (Stream step ch0) Unknown +#else +streamChunks ∷ ( G.Bitstream (SB.Bitstream d) + , Monad m + ) + ⇒ Bitstream d → Stream m (SB.Bitstream d) -{-# NOINLINE streamChunks #-} streamChunks ch0 = Stream step ch0 Unknown +#endif where {-# INLINE step #-} step Empty = return Done step (Chunk x xs) = return $ Yield x xs +{-# NOINLINE unstreamChunks #-} +#if MIN_VERSION_vector(0,11,0) unstreamChunks ∷ ( G.Bitstream (SB.Bitstream d) , Monad m ) + ⇒ B.Bundle m v (SB.Bitstream d) + → m (Bitstream d) +unstreamChunks (B.Bundle (Stream step s0) _ _ _) = go s0 +#else +unstreamChunks ∷ ( G.Bitstream (SB.Bitstream d) + , Monad m + ) ⇒ Stream m (SB.Bitstream d) → m (Bitstream d) -{-# NOINLINE unstreamChunks #-} unstreamChunks (Stream step s0 _) = go s0 +#endif where {-# INLINE go #-} go s = do r ← step s @@ -688,18 +740,34 @@ {-# RULES "Lazy Bitstream streamChunks/unstreamChunks fusion" ∀s. streamChunks (unId (unstreamChunks s)) = s - +#if MIN_VERSION_base(4,9,0) +#else "Lazy Bitstream unstreamChunks/streamChunks fusion" ∀v. unId (unstreamChunks (streamChunks v)) = v +#endif #-} +#if MIN_VERSION_vector(0,11,0) +inplace :: Monad m => (Stream m a -> Stream m b) + -> (Size -> Size) -> B.Bundle m v a -> B.Bundle m v b +inplace f g b = b `seq` B.fromStream (f (B.elements b)) (g (B.size b)) +#endif + -- Awful implementation to gain speed... +{-# INLINEABLE packChunks #-} +#if MIN_VERSION_vector(0,11,0) +packChunks ∷ ∀d m v . (G.Bitstream (Packet d), Monad m) + ⇒ B.Bundle m v (Packet d) + → B.Bundle m v (SB.Bitstream d) +packChunks = inplace (\(Stream st s0) + -> Stream (step' st) (emptyChunk, 0, 0, Just s0)) sz' +#else packChunks ∷ ∀d m. (G.Bitstream (Packet d), Monad m) ⇒ Stream m (Packet d) → Stream m (SB.Bitstream d) -{-# INLINEABLE packChunks #-} -packChunks (Stream step s0 sz) - = Stream step' (emptyChunk, 0, 0, Just s0) sz' +packChunks (Stream st s0 sz) + = Stream (step' st) (emptyChunk, 0, 0, Just s0) (sz' sz) +#endif where emptyChunk ∷ New.New SV.Vector (Packet d) {-# INLINE emptyChunk #-} @@ -729,15 +797,15 @@ $ GV.new $ New.apply (MVector.take cLen) ch - sz' ∷ Size + sz' ∷ Size -> Size {-# INLINE sz' #-} - sz' = case sz of + sz' v = case v of Exact n → Exact ((n + chunkSize - 1) `div` chunkSize) Max n → Max ((n + chunkSize - 1) `div` chunkSize) Unknown → Unknown {-# INLINE step' #-} - step' (ch, cLen, bLen, Just s) + step' step (ch, cLen, bLen, Just s) = do r ← step s case r of Yield p s' @@ -753,11 +821,15 @@ | otherwise → return $ Yield (newChunk ch cLen bLen) ((⊥), (⊥), (⊥), Nothing) - step' (_, _, _, Nothing) + step' _ (_, _, _, Nothing) = return Done -unpackChunks ∷ S.Stream (SB.Bitstream d) → S.Stream (Packet d) {-# INLINE unpackChunks #-} +#if MIN_VERSION_vector(0,11,0) +unpackChunks ∷ Bundle SV.Vector (SB.Bitstream d) → Bundle SV.Vector (Packet d) +#else +unpackChunks ∷ S.Stream (SB.Bitstream d) → S.Stream (Packet d) +#endif unpackChunks = S.concatMap SB.streamPackets -- | /O(n)/ Convert a @'Bitstream' 'Left'@ into a @'Bitstream' diff --git a/Data/Bitstream/Packet.hs b/Data/Bitstream/Packet.hs --- a/Data/Bitstream/Packet.hs +++ b/Data/Bitstream/Packet.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns + , CPP , EmptyDataDecls , FlexibleContexts , FlexibleInstances @@ -25,9 +26,16 @@ import Data.Bits import qualified Data.List as L import Data.Ord +#if MIN_VERSION_vector(0,11,0) +import qualified Data.Vector.Fusion.Bundle as S +import qualified Data.Vector.Fusion.Bundle.Monadic as B +import Data.Vector.Fusion.Bundle.Monadic (Bundle(..)) +import Data.Vector.Fusion.Bundle.Size +#else import qualified Data.Vector.Fusion.Stream as S -import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) import Data.Vector.Fusion.Stream.Size +#endif +import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) import Data.Vector.Fusion.Util import Data.Word import Foreign.Storable @@ -126,7 +134,11 @@ {-# INLINE basicStream #-} basicStream (Packet n o) = {-# CORE "Packet Left stream" #-} +#if MIN_VERSION_vector(0,11,0) + B.fromStream (Stream step 0) (Exact n) +#else Stream step 0 (Exact n) +#endif where {-# INLINE step #-} step !i @@ -134,6 +146,15 @@ | otherwise = return $! Yield (o `testBit` i) (i+1) {-# INLINE basicUnstream #-} +#if MIN_VERSION_vector(0,11,0) + basicUnstream (Bundle (Stream step s0) _ _ sz) + = {-# CORE "Packet Left unstream" #-} + case upperBound sz of + Just n + | n ≤ 8 → unId (unsafeConsume s0 0 0) + | otherwise → packetOverflow + Nothing → unId (safeConsume s0 0 0) +#else basicUnstream (Stream step s0 sz) = {-# CORE "Packet Left unstream" #-} case upperBound sz of @@ -141,6 +162,7 @@ | n ≤ 8 → unId (unsafeConsume s0 0 0) | otherwise → packetOverflow Nothing → unId (safeConsume s0 0 0) +#endif where {-# INLINE unsafeConsume #-} unsafeConsume s !i !o @@ -248,7 +270,11 @@ {-# INLINE basicStream #-} basicStream (Packet n o) = {-# CORE "Packet Right stream" #-} +#if MIN_VERSION_vector(0,11,0) + B.fromStream (Stream step 0) (Exact n) +#else Stream step 0 (Exact n) +#endif where {-# INLINE step #-} step !i @@ -256,6 +282,15 @@ | otherwise = return $! Yield (o `testBit` (7-i)) (i+1) {-# INLINE basicUnstream #-} +#if MIN_VERSION_vector(0,11,0) + basicUnstream (Bundle (Stream step s0) _ _ sz) + = {-# CORE "Packet Right unstream" #-} + case upperBound sz of + Just n + | n ≤ 8 → unId (unsafeConsume s0 0 0) + | otherwise → packetOverflow + Nothing → unId (safeConsume s0 0 0) +#else basicUnstream (Stream step s0 sz) = {-# CORE "Packet Right unstream" #-} case upperBound sz of @@ -263,6 +298,7 @@ | n ≤ 8 → unId (unsafeConsume s0 0 0) | otherwise → packetOverflow Nothing → unId (safeConsume s0 0 0) +#endif where {-# INLINE unsafeConsume #-} unsafeConsume s i o diff --git a/Test/Bitstream.hs b/Test/Bitstream.hs --- a/Test/Bitstream.hs +++ b/Test/Bitstream.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - FlexibleContexts + CPP + , FlexibleContexts , OverloadedStrings , ScopedTypeVariables , UndecidableInstances @@ -14,7 +15,11 @@ import Data.List.Unicode import qualified Data.Monoid as M import qualified Data.Monoid.Unicode as M +#if MIN_VERSION_vector(0,11,0) +import qualified Data.Vector.Fusion.Bundle as S +#else import qualified Data.Vector.Fusion.Stream as S +#endif import Prelude.Unicode import Test.Bitstream.Utils import Test.QuickCheck hiding ((.&.)) diff --git a/Test/Bitstream/Lazy.hs b/Test/Bitstream/Lazy.hs --- a/Test/Bitstream/Lazy.hs +++ b/Test/Bitstream/Lazy.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - FlexibleContexts + CPP + , FlexibleContexts , OverloadedStrings , ScopedTypeVariables , UndecidableInstances @@ -14,7 +15,11 @@ import Data.List.Unicode import qualified Data.Monoid as M import qualified Data.Monoid.Unicode as M +#if MIN_VERSION_vector(0,11,0) +import qualified Data.Vector.Fusion.Bundle as S +#else import qualified Data.Vector.Fusion.Stream as S +#endif import Prelude.Unicode import Test.Bitstream.Utils import Test.QuickCheck diff --git a/Test/Bitstream/Utils.hs b/Test/Bitstream/Utils.hs --- a/Test/Bitstream/Utils.hs +++ b/Test/Bitstream/Utils.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - FlexibleContexts + CPP + , FlexibleContexts , OverloadedStrings , ScopedTypeVariables , UndecidableInstances @@ -52,6 +53,8 @@ do xs ← replicateM n arbitrary return (LS.unfoldr uncons xs) +#if MIN_VERSION_QuickCheck(2,9,0) +#else instance ( Arbitrary α, Arbitrary β, Arbitrary γ , Arbitrary δ, Arbitrary ε, Arbitrary ζ ) @@ -77,6 +80,7 @@ ζ ← arbitrary η ← arbitrary return (α, β, γ, δ, ε, ζ, η) +#endif runTest ∷ Property → IO () runTest prop diff --git a/bitstream.cabal b/bitstream.cabal --- a/bitstream.cabal +++ b/bitstream.cabal @@ -6,7 +6,7 @@ fusion. This is like @bytestring@ but stores bits instead of bytes. -Version: 0.2.0.4 +Version: 0.3.0.0 License: PublicDomain License-File: COPYING Author: PHO @@ -32,8 +32,12 @@ base == 4.*, base-unicode-symbols == 0.2.*, bytestring >= 0.9 && < 0.11, - vector == 0.10.* + vector >= 0.10 && < 0.13 + if !impl(ghc >= 8.0) + Build-Depends: + bifunctors >= 4.1 + Exposed-Modules: Data.Bitstream Data.Bitstream.Fusion @@ -61,7 +65,10 @@ base == 4.*, base-unicode-symbols == 0.2.*, bytestring >= 0.9 && < 0.11, - vector == 0.10.* + vector >= 0.10 && < 0.13 + if !impl(ghc >= 8.0) + Build-Depends: + bifunctors >= 4.1 Default-Language: Haskell2010 GHC-Options: -Wall -fno-warn-orphans @@ -76,7 +83,10 @@ base == 4.*, base-unicode-symbols == 0.2.*, bytestring >= 0.9 && < 0.11, - vector == 0.10.* + vector >= 0.10 && < 0.13 + if !impl(ghc >= 8.0) + Build-Depends: + bifunctors >= 4.1 Default-Language: Haskell2010 GHC-Options: -Wall -fno-warn-orphans