bitstream 0.1 → 0.2

raw patch · 7 files changed

+1513/−827 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog +6/−0
• Data/Bitstream.hs +393/−189
• Data/Bitstream/Generic.hs +506/−379
• Data/Bitstream/Internal.hs +92/−4
• Data/Bitstream/Lazy.hs +397/−160
• Data/Bitstream/Packet.hs +116/−90
• bitstream.cabal +3/−5

@@ -0,0 +1,6 @@+== bitstream-0.2 / 2011-07-08+* bugfix: Make stream fusion actually work+* Implement fromBits / toBits+* Strict Bitstreams' bit length should only be a hint, just like stream size.+* Strict Bitstream should keep bit-length maintained+* Strict bitstrems should use unstreamPackets instead of hand-written unfoldr-based unstreamers.

@@ -1,7 +1,9 @@ {-# LANGUAGE     BangPatterns   , FlexibleContexts+  , FlexibleInstances   , ScopedTypeVariables+  , UnboxedTuples   , UndecidableInstances   , UnicodeSyntax   #-}@@ -16,7 +18,7 @@ -- Strict 'Bitstream's are made of strict 'SV.Vector' of 'Packet's, -- and each 'Packet's have at least 1 bit. module Data.Bitstream-    ( -- * Types+    ( -- * Data types       Bitstream     , Left     , Right@@ -28,15 +30,23 @@     , pack     , unpack     , fromPackets+    , unsafeFromPackets     , toPackets        -- ** Converting from\/to strict 'BS.ByteString's     , fromByteString     , toByteString +    -- ** Converting from\/to 'Bits''+    , fromBits+    , fromNBits+    , toBits+       -- ** Converting from\/to 'S.Stream's     , stream     , unstream+    , streamPackets+    , unstreamPackets        -- * Changing bit order in octets     , directionLToR@@ -74,7 +84,7 @@     , any     , all -      -- * Building lists+      -- * Building 'Bitstream's       -- ** Scans     , scanl     , scanl1@@ -161,14 +171,16 @@ import qualified Data.List as L import Data.Monoid import qualified Data.Vector.Generic as GV+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(..)) import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util import Prelude ( Bool(..), Eq(..), Int, Integral, Maybe(..), Monad(..), Num(..)-               , Ord(..), Show(..), ($), div, error, fmap-               , fromIntegral, fst, mod, otherwise+               , Ord(..), Show(..), ($), error, fmap, fromIntegral, fst+               , otherwise                ) import Prelude.Unicode hiding ((⧺), (∈), (∉)) import System.IO (FilePath, Handle, IO)@@ -178,12 +190,15 @@ -- /directions/ controlling how octets are interpreted as bits. There -- are two types of concrete 'Bitstream's: @'Bitstream' 'Left'@ and -- @'Bitstream' 'Right'@.-newtype Bitstream d-    = Bitstream (SV.Vector (Packet d))+data Bitstream d+    = Bitstream {-# UNPACK #-} !Int -- bit length+                {-# UNPACK #-} !(SV.Vector (Packet d))+-- THINKME: The bit length should only be a hint, just like stream+-- size.  instance Show (Packet d) ⇒ Show (Bitstream d) where     {-# INLINEABLE show #-}-    show (Bitstream v0)+    show (Bitstream _ v0)         = L.concat           [ "(S"           , L.concat (L.unfoldr go v0)@@ -194,7 +209,7 @@           go v | SV.null v = Nothing                | otherwise = Just (show (SV.head v), SV.tail v) -instance G.Bitstream (Packet d) ⇒ Eq (Bitstream d) where+instance G.Bitstream (Bitstream d) ⇒ Eq (Bitstream d) where     {-# INLINE (==) #-}     x == y = stream x ≡ stream y @@ -209,7 +224,7 @@ --   , 'compare' z y -- 'LT' --   ] -- @-instance G.Bitstream (Packet d) ⇒ Ord (Bitstream d) where+instance G.Bitstream (Bitstream d) ⇒ Ord (Bitstream d) where     {-# INLINE compare #-}     x `compare` y = stream x `compare` stream y @@ -220,225 +235,353 @@ -- 'mappend' = 'append' -- 'mconcat' = 'concat' -- @-instance G.Bitstream (Packet d) ⇒ Monoid (Bitstream d) where+instance G.Bitstream (Bitstream d) ⇒ Monoid (Bitstream d) where     mempty  = (∅)     mappend = (⧺)     mconcat = concat -instance G.Bitstream (Packet d) ⇒ G.Bitstream (Bitstream d) where-    {-# INLINE [0] stream #-}-    stream (Bitstream v)-        = {-# CORE "Bitstream stream" #-}-          S.concatMap stream (GV.stream v)-          `S.sized`-          Exact (length (Bitstream v))+instance G.Bitstream (Bitstream Left) where+    {-# INLINE basicStream #-}+    basicStream = strictStream -    {-# INLINE [0] unstream #-}-    unstream-        = {-# CORE "Bitstream unstream" #-}-          Bitstream ∘ GV.unstream ∘ packPackets+    {-# INLINE basicUnstream #-}+    basicUnstream = strictUnstream -    {-# INLINEABLE [2] cons #-}-    cons b (Bitstream v)-        | SV.null v = Bitstream (SV.singleton (singleton b))-        | otherwise = case SV.head v of-                        p | length p < (8 ∷ Int)-                                → Bitstream ((b `cons` p) `SV.cons` SV.tail v)-                          | otherwise-                                → Bitstream (singleton b `SV.cons` v)+    {-# INLINE basicCons #-}+    basicCons = strictCons -    {-# INLINEABLE [2] snoc #-}-    snoc (Bitstream v) b-        | SV.null v = Bitstream (SV.singleton (singleton b))-        | otherwise = case SV.last v of-                        p | length p < (8 ∷ Int)-                                → Bitstream (SV.init v `SV.snoc` (p `snoc` b))-                          | otherwise-                                → Bitstream (v `SV.snoc` singleton b)+    {-# INLINE basicSnoc #-}+    basicSnoc = strictSnoc -    {-# INLINE [2] append #-}-    append (Bitstream x) (Bitstream y)-        = Bitstream (x SV.++ y)+    {-# INLINE basicAppend #-}+    basicAppend = strictAppend -    {-# INLINEABLE [2] tail #-}-    tail (Bitstream v)-        | SV.null v = emptyStream-        | otherwise = case tail (SV.head v) of-                        p' | null p'   → Bitstream (SV.tail v)-                           | otherwise → Bitstream (p' `SV.cons` SV.tail v)+    {-# INLINE basicTail #-}+    basicTail = strictTail -    {-# INLINEABLE [2] init #-}-    init (Bitstream v)-        | SV.null v = emptyStream-        | otherwise = case init (SV.last v) of-                        p' | null p'   → Bitstream (SV.init v)-                           | otherwise → Bitstream (SV.init v `SV.snoc` p')+    {-# INLINE basicInit #-}+    basicInit = strictInit -    {-# INLINE [2] map #-}-    map f (Bitstream v)-        = Bitstream (SV.map (map f) v)+    {-# INLINE basicMap #-}+    basicMap = strictMap -    {-# INLINE [2] reverse #-}-    reverse (Bitstream v)-        = Bitstream (SV.reverse (SV.map reverse v))+    {-# INLINE basicReverse #-}+    basicReverse = strictReverse -    {-# INLINE [1] scanl #-}-    scanl f b-        = unstream ∘ S.scanl f b ∘ stream+    {-# INLINE basicConcat #-}+    basicConcat = strictConcat -    {-# INLINE [2] concat #-}-    concat = Bitstream ∘ SV.concat ∘ L.map toPackets+    {-# INLINE basicScanl #-}+    basicScanl = strictScanl -    {-# INLINEABLE replicate #-}-    replicate n0 b-        | n0 ≤ 0         = (∅)-        | n0 `mod` 8 ≡ 0 = Bitstream anterior-        | otherwise      = Bitstream (anterior `SV.snoc` posterior)-        where-          {-# INLINE anterior #-}-          anterior = SV.replicate n p-              where-                n ∷ Int-                {-# INLINE n #-}-                n = fromIntegral (n0 `div` 8)-                {-# INLINE p #-}-                p = replicate (8 ∷ Int) b+    {-# INLINE basicTake #-}+    basicTake = strictTake -          {-# INLINE posterior #-}-          posterior = replicate n b-              where-                n ∷ Int-                {-# INLINE n #-}-                n = fromIntegral (n0 `mod` 8)+    {-# INLINE basicDrop #-}+    basicDrop = strictDrop -    {-# INLINEABLE [2] take #-}-    take n0 (Bitstream v0)-        | n0 ≤ 0    = (∅)-        | otherwise = Bitstream (SV.unfoldrN nOctets go (n0, v0))-        where-          {-# INLINE nOctets #-}-          nOctets ∷ Int-          nOctets = fromIntegral (min n0 (fromIntegral (SV.length v0)))-          {-# INLINE go #-}-          go (0, _) = Nothing-          go (n, v)-              | SV.null v = Nothing-              | otherwise = let p  = SV.head v-                                v' = SV.tail v-                                p' = take n p-                                n' = n - length p'+    {-# INLINE basicTakeWhile #-}+    basicTakeWhile = strictTakeWhile++    {-# INLINE basicDropWhile #-}+    basicDropWhile = strictDropWhile++    {-# INLINE basicFilter #-}+    basicFilter = strictFilter++    {-# INLINE basicFromNBits #-}+    basicFromNBits = (unstreamPackets ∘) ∘ lePacketsFromNBits++    {-# INLINE basicToBits #-}+    basicToBits = unId ∘ lePacketsToBits ∘ streamPackets++instance G.Bitstream (Bitstream Right) where+    {-# INLINE basicStream #-}+    basicStream = strictStream++    {-# INLINE basicUnstream #-}+    basicUnstream = strictUnstream++    {-# INLINE basicCons #-}+    basicCons = strictCons++    {-# INLINE basicSnoc #-}+    basicSnoc = strictSnoc++    {-# INLINE basicAppend #-}+    basicAppend = strictAppend++    {-# INLINE basicTail #-}+    basicTail = strictTail++    {-# INLINE basicInit #-}+    basicInit = strictInit++    {-# INLINE basicMap #-}+    basicMap = strictMap++    {-# INLINE basicReverse #-}+    basicReverse = strictReverse++    {-# INLINE basicConcat #-}+    basicConcat = strictConcat++    {-# INLINE basicScanl #-}+    basicScanl = strictScanl++    {-# INLINE basicTake #-}+    basicTake = strictTake++    {-# INLINE basicDrop #-}+    basicDrop = strictDrop++    {-# INLINE basicTakeWhile #-}+    basicTakeWhile = strictTakeWhile++    {-# INLINE basicDropWhile #-}+    basicDropWhile = strictDropWhile++    {-# INLINE basicFilter #-}+    basicFilter = strictFilter++    {-# INLINEABLE basicFromNBits #-}+    basicFromNBits = (unstreamPackets ∘) ∘ bePacketsFromNBits++    {-# INLINEABLE basicToBits #-}+    basicToBits = unId ∘ bePacketsToBits ∘ streamPackets++strictStream ∷ G.Bitstream (Packet d) ⇒ Bitstream d → S.Stream Bool+{-# INLINE strictStream #-}+strictStream (Bitstream l v)+    = {-# CORE "Strict Bitstream stream" #-}+      S.concatMap stream (GV.stream v)+      `S.sized`+      Exact l++strictUnstream ∷ G.Bitstream (Packet d) ⇒ S.Stream Bool → Bitstream d+{-# INLINE strictUnstream #-}+strictUnstream+    = {-# CORE "Strict Bitstream unstream" #-}+      unstreamPackets ∘ packPackets++strictCons ∷ G.Bitstream (Packet d) ⇒ Bool → Bitstream d → Bitstream d+{-# INLINEABLE strictCons #-}+strictCons b (Bitstream 0 _) = Bitstream 1 (SV.singleton (singleton b))+strictCons b (Bitstream l v)+    = case SV.head v of+        p | length p < (8 ∷ Int)+                → Bitstream (l+1) ((b `cons` p) `SV.cons` SV.tail v)+          | otherwise+                → Bitstream (l+1) (singleton b `SV.cons` v)++strictSnoc ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool → Bitstream d+{-# INLINEABLE strictSnoc #-}+strictSnoc (Bitstream 0 _) b = Bitstream 1 (SV.singleton (singleton b))+strictSnoc (Bitstream l v) b+    = case SV.last v of+        p | length p < (8 ∷ Int)+                → Bitstream (l+1) (SV.init v `SV.snoc` (p `snoc` b))+          | otherwise+                → Bitstream (l+1) (v `SV.snoc` singleton b)++strictAppend ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bitstream d → Bitstream d+{-# INLINE strictAppend #-}+strictAppend (Bitstream lx x) (Bitstream ly y)+    = Bitstream (lx + ly) (x SV.++ y)++strictTail ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bitstream d+{-# INLINEABLE strictTail #-}+strictTail (Bitstream 0 _) = emptyStream+strictTail (Bitstream l v)+    = case tail (SV.head v) of+        p' | null p'   → Bitstream (l-1) (SV.tail v)+           | otherwise → Bitstream (l-1) (p' `SV.cons` SV.tail v)++strictInit ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bitstream d+{-# INLINEABLE strictInit #-}+strictInit (Bitstream 0 _) = emptyStream+strictInit (Bitstream l v)+    = case init (SV.last v) of+        p' | null p'   → Bitstream (l-1) (SV.init v)+           | otherwise → Bitstream (l-1) (SV.init v `SV.snoc` p')++strictMap ∷ G.Bitstream (Packet d) ⇒ (Bool → Bool) → Bitstream d → Bitstream d+{-# INLINE strictMap #-}+strictMap f (Bitstream l v)+    = Bitstream l (SV.map (map f) v)++strictReverse ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bitstream d+{-# INLINE strictReverse #-}+strictReverse (Bitstream l v)+    = Bitstream l (SV.reverse (SV.map reverse v))++strictConcat ∷ G.Bitstream (Bitstream d) ⇒ [Bitstream d] → Bitstream d+{-# INLINEABLE strictConcat #-}+strictConcat xs+    = let (!l, !vs) = L.mapAccumL (\n x → (n + length x, toPackets x)) 0 xs+          !v        = SV.concat vs+      in+        Bitstream l v++strictScanl ∷ G.Bitstream (Bitstream d) ⇒ (Bool → Bool → Bool) → Bool → Bitstream d → Bitstream d+{-# INLINE strictScanl #-}+strictScanl f b+    = unstream ∘ S.scanl f b ∘ stream++strictTake ∷ ( Integral n+             , G.Bitstream (Bitstream d)+             , G.Bitstream (Packet d)+             )+           ⇒ n+           → Bitstream d+           → Bitstream d+{-# INLINEABLE strictTake #-}+strictTake n0 (Bitstream l0 v0)+    | l0 ≡ 0    = (∅)+    | n0 ≤ 0    = (∅)+    | otherwise = let !e = New.create (MVector.new (SV.length v0))+                  in+                    case go n0 v0 0 0 e of+                      (# l, np, mv #)+                          → let !mv' = New.apply (MVector.take np) mv+                                !v   = GV.new mv'                             in-                              return (p', (n', v'))+                              Bitstream l v+    where+      {-# INLINE go #-}+      go 0 _ l np mv  = (# l, np, mv #)+      go n v l np mv+          | SV.null v = (# l, np, mv #)+          | otherwise = let !p   = SV.head v+                            !p'  = take n p+                            !n'  = n - length p'+                            !v'  = SV.tail v+                            !l'  = l + length p'+                            !np' = np + 1+                            !mv' = New.modify (\x → MVector.write x np p') mv+                        in+                          go n' v' l' np' mv' -    {-# INLINEABLE [2] drop #-}-    drop n0 (Bitstream v0)-        | n0 ≤ 0    = Bitstream v0-        | otherwise = Bitstream (go n0 v0)-        where-          {-# INLINE go #-}-          go 0 v = v-          go n v-              | SV.null v = v-              | otherwise = case SV.head v of-                              p | n ≥ length p → go (n - length p) (SV.tail v)-                                | otherwise    → drop n p `SV.cons` (SV.tail v)+strictDrop ∷ (Integral n, G.Bitstream (Packet d)) ⇒ n → Bitstream d → Bitstream d+{-# INLINEABLE strictDrop #-}+strictDrop n0 (Bitstream l0 v0)+    | n0 ≤ 0    = Bitstream l0 v0+    | otherwise = case go n0 l0 v0 of+                    (# l, v #) → Bitstream l v+    where+      {-# INLINE go #-}+      go 0 l v = (# l, v #)+      go _ 0 v = (# 0, v #)+      go n l v = let !p = SV.head v+                 in+                   case drop n p of+                     p' | null p'   → go (n - length p) (l - length p) (SV.tail v)+                        | otherwise → (# l - length p + length p'+                                       , p' `SV.cons` SV.tail v #) -    {-# INLINEABLE [2] takeWhile #-}-    takeWhile f (Bitstream v0)-        = Bitstream (GV.unstream (takeWhilePS (GV.stream v0)))-        where-          {-# INLINE takeWhilePS #-}-          takeWhilePS (Stream step s0 sz) = Stream step' (Just s0) (toMax sz)-              where-                {-# INLINE step' #-}-                step' Nothing  = return Done-                step' (Just s)-                    = do r ← step s-                         case r of-                           Yield p s'-                               → case takeWhile f p of-                                    p' | p ≡ p'    → return $ Yield p' (Just s')-                                       | otherwise → return $ Yield p' Nothing-                           Skip    s'-                               → return $ Skip (Just s')-                           Done-                               → return Done+strictTakeWhile ∷ G.Bitstream (Packet d) ⇒ (Bool → Bool) → Bitstream d → Bitstream d+{-# INLINEABLE strictTakeWhile #-}+strictTakeWhile f+    = unstreamPackets ∘ takeWhilePS ∘ streamPackets+    where+      {-# INLINE takeWhilePS #-}+      takeWhilePS (Stream step s0 sz) = Stream step' (Just s0) (toMax sz)+          where+            {-# INLINE step' #-}+            step' Nothing  = return Done+            step' (Just s)+                = do r ← step s+                     case r of+                       Yield p s'+                           → case takeWhile f p of+                                p' | p ≡ p'    → return $ Yield p' (Just s')+                                   | otherwise → return $ Yield p' Nothing+                       Skip    s'+                           → return $ Skip (Just s')+                       Done+                           → return Done -    {-# INLINEABLE [2] dropWhile #-}-    dropWhile f (Bitstream v0) = Bitstream (go v0)-        where-          {-# INLINE go #-}-          go v | SV.null v = v-               | otherwise = case dropWhile f (SV.head v) of-                               p' | null p'   → go (SV.tail v)-                                  | otherwise → p' `SV.cons` SV.tail v+strictDropWhile ∷ G.Bitstream (Packet d) ⇒ (Bool → Bool) → Bitstream d → Bitstream d+{-# INLINEABLE strictDropWhile #-}+strictDropWhile _ (Bitstream 0  v0) = Bitstream 0 v0+strictDropWhile f (Bitstream l0 v0) = case go l0 v0 of+                                        (# l, v #) → Bitstream l v+    where+      {-# INLINE go #-}+      go 0 v = (# 0, v #)+      go l v = let !p    = SV.head v+                   !pLen = length p+               in+                 case dropWhile f p of+                   p' | null p'   → go (l - pLen) (SV.tail v)+                      | otherwise → (# l - pLen + length p'+                                     , p' `SV.cons` SV.tail v #) -    {-# INLINEABLE [2] filter #-}-    filter f (Bitstream v0)-        = Bitstream (GV.unstream (filterPS (GV.stream v0)))-        where-          {-# INLINE filterPS #-}-          filterPS (Stream step s0 sz) = Stream step' s0 (toMax sz)-              where-                {-# INLINE step' #-}-                step' s-                    = do r ← step s-                         case r of-                           Yield p s' → case filter f p of-                                           p' | null p'   → return $ Skip s'-                                              | otherwise → return $ Yield p' s'-                           Skip    s' → return $ Skip s'-                           Done       → return Done+strictFilter ∷ G.Bitstream (Packet d) ⇒ (Bool → Bool) → Bitstream d → Bitstream d+{-# INLINEABLE strictFilter #-}+strictFilter f+    = unstreamPackets ∘ filterPS ∘ streamPackets+    where+      {-# INLINE filterPS #-}+      filterPS (Stream step s0 sz) = Stream step' s0 (toMax sz)+          where+            {-# INLINE step' #-}+            step' s+                = do r ← step s+                     case r of+                       Yield p s' → case filter f p of+                                       p' | null p'   → return $ Skip s'+                                          | otherwise → return $ Yield p' s'+                       Skip    s' → return $ Skip s'+                       Done       → return Done  strictHead ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "head → strictHead" [2]+{-# RULES "head → strictHead" [1]     ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).     head v = strictHead v #-} {-# INLINE strictHead #-}-strictHead (Bitstream v) = head (SV.head v)+strictHead (Bitstream _ v) = head (SV.head v)  strictLast ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "last → strictLast" [2]+{-# RULES "last → strictLast" [1]     ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).     last v = strictLast v #-} {-# INLINE strictLast #-}-strictLast (Bitstream v) = last (SV.last v)+strictLast (Bitstream _ v) = last (SV.last v)  strictNull ∷ Bitstream d → Bool-{-# RULES "null → strictNull" [2] null = strictNull #-}+{-# RULES "null → strictNull" [1] null = strictNull #-} {-# INLINE strictNull #-}-strictNull (Bitstream v) = SV.null v+strictNull (Bitstream 0 _) = True+strictNull _               = False -strictLength ∷ (G.Bitstream (Packet d), Num n) ⇒ Bitstream d → n-{-# RULES "length → strictLength" [2]-    ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).-    length v = strictLength v #-}-{-# INLINEABLE strictLength #-}-strictLength (Bitstream v)-    = SV.foldl' (\n p → n + length p) 0 v+strictLength ∷ Num n ⇒ Bitstream d → n+{-# RULES "length → strictLength" [1] length = strictLength #-}+{-# INLINE strictLength #-}+strictLength (Bitstream len _) = fromIntegral len  strictAnd ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "and → strictAnd" [2]+{-# RULES "and → strictAnd" [1]     ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).     and v = strictAnd v #-} {-# INLINE strictAnd #-}-strictAnd (Bitstream v)+strictAnd (Bitstream _ v)     = SV.all and v  strictOr ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "or → strictOr" [2]+{-# RULES "or → strictOr" [1]     ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).     or v = strictOr v #-} {-# INLINE strictOr #-}-strictOr (Bitstream v)+strictOr (Bitstream _ v)     = SV.any or v  strictIndex ∷ (G.Bitstream (Packet d), Integral n) ⇒ Bitstream d → n → Bool-{-# RULES "(!!) → strictIndex" [2]+{-# RULES "(!!) → strictIndex" [1]     ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d) n.     v !! n = strictIndex v n #-} {-# INLINEABLE strictIndex #-}-strictIndex (Bitstream v0) i0+strictIndex (Bitstream _ v0) i0     | i0 < 0    = indexOutOfRange i0     | otherwise = go v0 i0     where@@ -461,10 +604,11 @@ -- 'Bitstream'. {-# INLINE fromByteString #-} fromByteString ∷ BS.ByteString → Bitstream d-fromByteString bs0 = Bitstream (SV.unfoldrN nOctets go bs0)+fromByteString bs0+    = Bitstream (nOctets ⋅ 8) (SV.unfoldrN nOctets go bs0)     where-      {-# INLINE nOctets #-}       nOctets ∷ Int+      {-# INLINE nOctets #-}       nOctets = BS.length bs0       {-# INLINE go #-}       go bs = do (o, bs') ← BS.uncons bs@@ -474,7 +618,9 @@ -- into a strict 'BS.ByteString'. The resulting octets will be padded -- with zeroes if the 'length' of @bs@ is not multiple of 8. {-# INLINEABLE toByteString #-}-toByteString ∷ ∀d. G.Bitstream (Packet d) ⇒ Bitstream d → BS.ByteString+toByteString ∷ ∀d. ( G.Bitstream (Bitstream d)+                   , G.Bitstream (Packet d)+                                     ) ⇒ Bitstream d → BS.ByteString toByteString = unstreamBS              ∘ (packPackets ∷ Stream Id Bool → Stream Id (Packet d))              ∘ stream@@ -493,29 +639,64 @@                     Skip    s' → go s'                     Done       → return Nothing --- | /O(1)/ Convert a 'SV.Vector' of 'Packet's into a 'Bitstream'.-fromPackets ∷ SV.Vector (Packet d) → Bitstream d+-- WARNING: countBits is rather slow.+countBits ∷ (G.Bitstream (Packet d), Num n) ⇒ SV.Vector (Packet d) → n+{-# INLINE countBits #-}+countBits = SV.foldl' (\n p → n + length p) 0++-- | /O(n)/ Convert a 'SV.Vector' of 'Packet's into a 'Bitstream'.+fromPackets ∷ G.Bitstream (Packet d) ⇒ SV.Vector (Packet d) → Bitstream d {-# INLINE fromPackets #-}-fromPackets = Bitstream+fromPackets v = Bitstream (countBits v) v +-- | /O(1)/ Convert a 'SV.Vector' of 'Packet's into a 'Bitstream',+-- with provided overall bit length. The correctness of the bit length+-- isn't checked, so you MUST be sure your bit length is absolutely+-- correct.+unsafeFromPackets ∷ G.Bitstream (Packet d) ⇒ Int → SV.Vector (Packet d) → Bitstream d+{-# INLINE unsafeFromPackets #-}+unsafeFromPackets = Bitstream+ -- | /O(1)/ Convert a 'Bitstream' into a 'SV.Vector' of 'Packet's. toPackets ∷ Bitstream d → SV.Vector (Packet d) {-# INLINE toPackets #-}-toPackets (Bitstream d) = d+toPackets (Bitstream _ d) = d +-- | /O(1)/ Convert a 'Bitstream' into a 'S.Stream' of 'Packet's.+streamPackets ∷ Bitstream d → S.Stream (Packet d)+{-# 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+{-# NOINLINE unstreamPackets #-}+unstreamPackets s+    = let !v = GV.unstream s+          !l = countBits v+      in+        Bitstream l v++{-# RULES+"Strict Bitstream streamPackets/unstreamPackets fusion"+    ∀s. streamPackets (unstreamPackets s) = s++"Strict Bitstream unstreamPackets/streamPackets fusion"+    ∀v. unstreamPackets (streamPackets v) = v+  #-}+ -- | /O(n)/ Convert a @'Bitstream' 'Left'@ into a @'Bitstream' -- 'Right'@. Bit directions only affect octet-based operations such as -- 'toByteString'. directionLToR ∷ Bitstream Left → Bitstream Right {-# INLINE directionLToR #-}-directionLToR (Bitstream v) = Bitstream (SV.map packetLToR v)+directionLToR (Bitstream l v) = Bitstream l (SV.map packetLToR v)  -- | /O(n)/ Convert a @'Bitstream' 'Right'@ into a @'Bitstream' -- 'Left'@. Bit directions only affect octet-based operations such as -- 'toByteString'. directionRToL ∷ Bitstream Right → Bitstream Left {-# INLINE directionRToL #-}-directionRToL (Bitstream v) = Bitstream (SV.map packetRToL v)+directionRToL (Bitstream l v) = Bitstream l (SV.map packetRToL v)  -- | /O(n)/ Read a 'Bitstream' from the stdin strictly, equivalent to -- 'hGetContents' @stdin@. The 'Handle' is closed after the contents@@ -526,7 +707,11 @@  -- | /O(n)/ Write a 'Bitstream' to the stdout, equivalent to 'hPut' -- @stdout@.-putBits ∷ G.Bitstream (Packet d) ⇒ Bitstream d → IO ()+putBits ∷ ( G.Bitstream (Bitstream d)+          , G.Bitstream (Packet d)+          )+        ⇒ Bitstream d+        → IO () {-# INLINE putBits #-} putBits = BS.putStr ∘ toByteString @@ -534,7 +719,11 @@ -- -> 'Bitstream' d@ as its argument. The entire input from the stdin -- is passed to this function as its argument, and the resulting -- 'Bitstream' is output on the stdout.-interact ∷ G.Bitstream (Packet d) ⇒ (Bitstream d → Bitstream d) → IO ()+interact ∷ ( G.Bitstream (Bitstream d)+           , G.Bitstream (Packet d)+           )+         ⇒ (Bitstream d → Bitstream d)+         → IO () {-# INLINE interact #-} interact = BS.interact ∘ lift'     where@@ -547,12 +736,22 @@ readFile = fmap fromByteString ∘ BS.readFile  -- | /O(n)/ Write a 'Bitstream' to a file.-writeFile ∷ G.Bitstream (Packet d) ⇒ FilePath → Bitstream d → IO ()+writeFile ∷ ( G.Bitstream (Bitstream d)+            , G.Bitstream (Packet d)+            ) +          ⇒ FilePath+          → Bitstream d+          → IO () {-# INLINE writeFile #-} writeFile = (∘ toByteString) ∘ BS.writeFile  -- | /O(n)/ Append a 'Bitstream' to a file.-appendFile ∷ G.Bitstream (Packet d) ⇒ FilePath → Bitstream d → IO ()+appendFile ∷ ( G.Bitstream (Bitstream d)+             , G.Bitstream (Packet d)+             )+           ⇒ FilePath+           → Bitstream d+           → IO () {-# INLINE appendFile #-} appendFile = (∘ toByteString) ∘ BS.appendFile @@ -597,6 +796,11 @@ hGetNonBlocking = (fmap fromByteString ∘) ∘ BS.hGetNonBlocking  -- | /O(n)/ Write a 'Bitstream' to the given 'Handle'.-hPut ∷ G.Bitstream (Packet d) ⇒ Handle → Bitstream d → IO ()+hPut ∷ ( G.Bitstream (Bitstream d)+       , G.Bitstream (Packet d)+       )+     ⇒ Handle+     → Bitstream d+     → IO () {-# INLINE hPut #-} hPut = (∘ toByteString) ∘ BS.hPut

@@ -5,21 +5,43 @@   #-} -- | Generic interface to diverse types of 'Bitstream'. module Data.Bitstream.Generic-    ( Bitstream(..)+    ( -- * The type class+      Bitstream(..) +    -- * Introducing and eliminating 'Bitstream's+    , empty+    , (∅)+    , singleton     , pack     , unpack -    , empty-    , singleton+    -- ** Converting from\/to 'Bits''+    , fromBits+    , fromNBits+    , toBits +    -- ** Converting from\/to 'S.Stream's+    , stream+    , unstream++    -- * Basic interface+    , cons+    , cons'+    , snoc+    , append+    , (⧺)     , head     , last+    , tail+    , init     , null     , length -    , concatMap+    -- * Transforming 'Bitstream's+    , map+    , reverse +    -- * Reducing 'Bitstream's     , foldl     , foldl'     , foldl1@@ -27,32 +49,57 @@     , foldr     , foldr1 +    -- ** Special folds+    , concat+    , concatMap     , and     , or     , any     , all -    , unfoldr-    , unfoldrN-+    -- * Building 'Bitstream's+    -- ** scans+    , scanl     , scanl1     , scanr     , scanr1 +    -- ** Replication+    , replicate++    -- ** Unfolding+    , unfoldr+    , unfoldrN++    -- * Substreams+    , take+    , drop+    , takeWhile+    , dropWhile     , span     , break +    -- * Searching streams     , elem+    , (∈)+    , (∋)     , notElem+    , (∉)+    , (∌) +    -- ** Searching with a predicate     , find+    , filter+    , partition +    -- ** Indexing streams     , (!!)     , elemIndex     , elemIndices     , findIndex     , findIndices +    -- * Zipping and unzipping streams     , zip     , zip3     , zip4@@ -68,16 +115,10 @@     , unzip4     , unzip5     , unzip6--    , (∅)-    , (⧺)-    , (∈)-    , (∋)-    , (∉)-    , (∌)     )     where import qualified Data.List as L+import Data.Bits import Data.Bitstream.Fusion import Data.Maybe import Data.Vector.Fusion.Stream (Stream)@@ -94,177 +135,62 @@ {- Notes about inlining / rewriting phase control:     1. We want "*/unstream fusion" rules always fire.-   2. Unfused form specialisations should occur at phase 2 and later.-   3. Fusible form inlinings should occur at phase 1 and later.-   4. stream / unstream inlinings should occur last i.e. phase 0.+   2. Fusible producer inlinings should always occur.+   3. Unfused form specialisations should occur at phase 1 and later.+   4. Fusible consumer/filter inlinings should occur last i.e. phase 0.+   5. stream/unstream inlinings should never occur.  -}  -- | Class of diverse types of 'Bitstream'. ----- Methods of this class are functions of 'Bitstream's that is either+-- 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/ 'cons'', 'concat',--- 'replicate' and 'partition'.+-- Minimum complete implementation: /All but/ 'basicCons'',+-- 'basicConcat', 'basicReplicate', 'basicPartition' and+-- 'basicFromBits'. class Bitstream α where-    -- | /O(n)/ Explicitly convert a 'Bitstream' into a 'Stream' of-    -- 'Bool'.-    ---    -- 'Bitstream' operations are automatically fused whenever it's-    -- possible, safe, and effective to do so, but sometimes you may-    -- find the rules are too conservative. These two functions-    -- 'stream' and 'unstream' provide a means for coercive stream-    -- fusion.-    ---    -- You should be careful when you use 'stream'. Most functions in-    -- this package are optimised to minimise frequency of memory-    -- allocations and copyings, but getting 'Bitstream's back from-    -- @'Stream' 'Bool'@ requires the whole 'Bitstream' to be-    -- constructed from scratch. Moreover, for lazy 'Bitstream's this-    -- leads to be an incorrect strictness behaviour because lazy-    -- 'Bitstream's are represented as lists of strict 'Bitstream'-    -- chunks but 'stream' can't preserve the original chunk-    -- structure. Let's say you have a lazy 'Bitstream' with the-    -- following chunks:-    ---    -- @-    -- bs = [chunk1, chunk2, chunk3, ...]-    -- @-    ---    -- and you want to drop the first bit of such stream. Our 'tail'-    -- is only strict on the @chunk1@ and will produce the following-    -- chunks:-    ---    -- @-    -- 'tail' bs = [chunk0, chunk1', chunk2, chunk3, ...]-    -- @-    ---    -- where @chunk0@ is a singleton vector of the first packet of-    -- @chunk1@ whose first bit is dropped, and @chunk1'@ is a vector-    -- of remaining packets of the @chunk1@. Neither @chunk2@ nor-    -- @chunk3@ have to be evaluated here as you might expect.-    ---    -- But think about the following expression:-    ---    -- @-    -- import qualified Data.Vector.Fusion.Stream as Stream-    -- 'unstream' $ Stream.tail $ 'stream' bs-    -- @-    ---    -- the resulting chunk structure will be:-    ---    -- @-    -- [chunk1', chunk2', chunk3', ...]-    -- @-    ---    -- where each and every chunks are slightly different from the-    -- original chunks, and this time @chunk1'@ has the same length as-    -- @chunk1@ but the last bit of @chunk1'@ is from the first bit of-    -- @chunk2@. This means when you next time apply some functions-    -- strict on the first chunk, you end up fully evaluating @chunk2@-    -- as well as @chunk1@ and this can be a serious misbehaviour for-    -- lazy 'Bitstream's.-    ---    -- The automatic fusion rules are carefully designed to fire only-    -- when there aren't any reason to preserve the original packet /-    -- chunk structure.-    stream ∷ α → Stream Bool+    basicStream   ∷ α → Stream Bool+    basicUnstream ∷ Stream Bool → α -    -- | /O(n)/ Convert a 'S.Stream' of 'Bool' into a 'Bitstream'.-    unstream ∷ Stream Bool → α+    basicCons   ∷ Bool → α → α+    basicCons'  ∷ Bool → α → α+    {-# INLINE basicCons' #-}+    basicCons'  = basicCons+    basicSnoc   ∷ α → Bool → α+    basicAppend ∷ α → α → α+    basicTail   ∷ α → α+    basicInit   ∷ α → α -    -- | /strict: O(n), lazy: O(1)/ 'cons' is an analogous to (':')-    -- for lists.-    cons ∷ Bool → α → α+    basicMap     ∷ (Bool → Bool) → α → α+    basicReverse ∷ α → α -    -- | /O(n)/ For strict 'Bitstream's, 'cons'' is exactly the same-    -- as 'cons'.-    ---    -- For lazy ones, 'cons'' is strict in the 'Bitstream' we are-    -- consing onto. More precisely, it forces the first chunk to be-    -- evaluated. It does this because, for space efficiency, it may-    -- coalesce the new bit onto the first chunk rather than starting-    -- a new chunk.-    cons' ∷ Bool → α → α-    {-# INLINE cons' #-}-    cons' = cons+    basicConcat ∷ [α] → α+    {-# INLINE basicConcat #-}+    basicConcat []     = (∅)+    basicConcat (α:αs) = α ⧺ concat αs -    -- | /O(n)/ Append a bit to the end of a 'Bitstream'.-    snoc ∷ α → Bool → α+    basicScanl ∷ (Bool → Bool → Bool) → Bool → α → α -    -- | /O(n)/ Append two 'Bitstream's.-    append ∷ α → α → α+    basicTake      ∷ Integral n ⇒ n → α → α+    basicDrop      ∷ Integral n ⇒ n → α → α+    basicTakeWhile ∷ (Bool → Bool) → α → α+    basicDropWhile ∷ (Bool → Bool) → α → α -    -- | /O(1)/ Extract the bits after the 'head' of a non-empty-    -- 'Bitstream'. An exception will be thrown if empty.-    tail ∷ α → α+    basicFilter    ∷ (Bool → Bool) → α → α+    basicPartition ∷ (Bool → Bool) → α → (α, α)+    {-# INLINE basicPartition #-}+    basicPartition f α = (filter f α, filter ((¬) ∘ f) α) -    -- | /O(n)/ Return all the bits of a 'Bitstream' except the last-    -- one. An exception will be thrown if empty.-    init ∷ α → α+    basicFromNBits ∷ (Integral n, Integral β, Bits β) ⇒ n → β → α+    basicToBits    ∷ Bits β ⇒ α → β -    -- | /O(n)/ Map a function over a 'Bitstream'.-    map ∷ (Bool → Bool) → α → α -    -- | /O(n)/ Reverse a 'Bitstream'.-    reverse ∷ α → α--    -- | /O(n)/ Concatenate all 'Bitstream's in the list.-    concat ∷ [α] → α-    {-# INLINE concat #-}-    concat []     = (∅)-    concat (α:αs) = α ⧺ concat αs--    -- | /O(n)/ 'scanl' is similar to 'foldl', but returns a-    -- 'Bitstream' of successive reduced bits from the left:-    ---    -- @-    -- 'scanl' f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]-    -- @-    ---    -- Note that-    ---    -- @-    -- 'last' ('scanl' f z xs) == 'foldl' f z xs-    -- @-    scanl ∷ (Bool → Bool → Bool) → Bool → α → α--    -- | /O(n)/ @'replicate' n x@ is a 'Bitstream' of length @n@ with-    -- @x@ the value of every bit.-    replicate ∷ Integral n ⇒ n → Bool → α-    {-# INLINE replicate #-}-    replicate n = unstream ∘ genericReplicate n--    -- | /O(n)/ 'take' @n@, applied to a 'Bitstream' @xs@, returns the-    -- prefix of @xs@ of length @n@, or @xs@ itself if @n > 'length'-    -- xs@.-    take ∷ Integral n ⇒ n → α → α--    -- | /O(n)/ 'drop' @n xs@ returns the suffix of @xs@ after the-    -- first @n@ bits, or 'empty' if @n > 'length' xs@.-    drop ∷ Integral n ⇒ n → α → α--    -- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a-    -- 'Bitstream' @xs@, returns the longest prefix (possibly 'empty')-    -- of @xs@ of bits that satisfy @p@.-    takeWhile ∷ (Bool → Bool) → α → α--    -- | /O(n)/ 'dropWhile' @p xs@ returns the suffix remaining after-    -- 'takeWhile' @p xs@.-    dropWhile ∷ (Bool → Bool) → α → α--    -- | /O(n)/ 'filter', applied to a predicate and a 'Bitstream',-    -- returns the 'Bitstream' of those bits that satisfy the-    -- predicate.-    filter ∷ (Bool → Bool) → α → α--    -- | /O(n)/ The 'partition' function takes a predicate and a-    -- 'Bitstream' and returns the pair of 'Bitstream's of bits which-    -- do and do not satisfy the predicate, respectively.-    partition ∷ (Bool → Bool) → α → (α, α)-    {-# INLINEABLE partition #-}-    partition f α = (filter f α, filter ((¬) ∘ f) α)+-- | /O(1)/ The empty 'Bitstream'.+empty ∷ Bitstream α ⇒ α+{-# INLINE empty #-}+empty = unstream S.empty  -- | (∅) = 'empty' --@@ -273,43 +199,13 @@ (∅) ∷ Bitstream α ⇒ α (∅) = empty --- | (⧺) = 'append'------ U+29FA, DOUBLE PLUS-(⧺) ∷ Bitstream α ⇒ α → α → α-(⧺) = append-{-# INLINE (⧺) #-}---- | (∈) = 'elem'------ U+2208, ELEMENT OF-(∈) ∷ Bitstream α ⇒ Bool → α → Bool-{-# INLINE (∈) #-}-(∈) = elem---- | (∋) = 'flip' (∈)------ U+220B, CONTAINS AS MEMBER-(∋) ∷ Bitstream α ⇒ α → Bool → Bool-(∋) = flip elem-{-# INLINE (∋) #-}---- | (∉) = 'notElem'------ U+2209, NOT AN ELEMENT OF-(∉) ∷ Bitstream α ⇒ Bool → α → Bool-(∉) = notElem-{-# INLINE (∉) #-}---- | (∌) = 'flip' (∉)------ U+220C, DOES NOT CONTAIN AS MEMBER-(∌) ∷ Bitstream α ⇒ α → Bool → Bool-(∌) = flip notElem-{-# INLINE (∌) #-}+-- | /O(1)/ Convert a 'Bool' into a 'Bitstream'.+singleton ∷ Bitstream α ⇒ Bool → α+{-# INLINE singleton #-}+singleton = unstream ∘ S.singleton  -- | /O(n)/ Convert a ['Bool'] into a 'Bitstream'.-{-# INLINE [1] pack #-}+{-# INLINE pack #-} pack ∷ Bitstream α ⇒ [Bool] → α pack = unstream ∘ S.fromList @@ -318,26 +214,160 @@ {-# RULES "Bitstream unpack/unstream fusion"     ∀s. unpack (unstream s) = S.toList s   #-}-{-# INLINE [1] unpack #-}+{-# INLINE [0] unpack #-} unpack = S.toList ∘ stream --- | /O(1)/ The empty 'Bitstream'.-empty ∷ Bitstream α ⇒ α-{-# INLINE [1] empty #-}-empty = unstream S.empty+-- | /O(n)/ Explicitly convert a 'Bitstream' into a 'Stream' of+-- 'Bool'.+--+-- 'Bitstream' operations are automatically fused whenever it's+-- possible, safe, and effective to do so, but sometimes you may find+-- the rules are too conservative. These two functions 'stream' and+-- 'unstream' provide a means for coercive stream fusion.+--+-- You should be careful when you use 'stream'. Most functions in this+-- package are optimised to minimise frequency of memory allocations+-- and copyings, but getting 'Bitstream's back from @'Stream' 'Bool'@+-- requires the whole 'Bitstream' to be constructed from+-- scratch. Moreover, for lazy 'Bitstream's this leads to be an+-- incorrect strictness behaviour because lazy 'Bitstream's are+-- represented as lists of strict 'Bitstream' chunks but 'stream'+-- can't preserve the original chunk structure. Let's say you have a+-- lazy 'Bitstream' with the following chunks:+--+-- @+-- bs = [chunk1, chunk2, chunk3, ...]+-- @+--+-- and you want to drop the first bit of such stream. Our 'tail' is+-- only strict on the @chunk1@ and will produce the following chunks:+--+-- @+-- 'tail' bs = [chunk0, chunk1', chunk2, chunk3, ...]+-- @+--+-- where @chunk0@ is a singleton vector of the first packet of+-- @chunk1@ whose first bit is dropped, and @chunk1'@ is a vector of+-- remaining packets of the @chunk1@. Neither @chunk2@ nor @chunk3@+-- have to be evaluated here as you might expect.+--+-- But think about the following expression:+--+-- @+-- import qualified Data.Vector.Fusion.Stream as Stream+-- 'unstream' $ Stream.tail $ 'stream' bs+-- @+--+-- the resulting chunk structure will be:+--+-- @+-- [chunk1', chunk2', chunk3', ...]+-- @+--+-- where each and every chunks are slightly different from the+-- original chunks, and this time @chunk1'@ has the same length as+-- @chunk1@ but the last bit of @chunk1'@ is from the first bit of+-- @chunk2@. This means when you next time apply some functions strict+-- on the first chunk, you end up fully evaluating @chunk2@ as well as+-- @chunk1@ and this can be a serious misbehaviour for lazy+-- 'Bitstream's.+--+-- The automatic fusion rules are carefully designed to fire only when+-- there aren't any reason to preserve the original packet / chunk+-- structure.+stream ∷ Bitstream α ⇒ α → Stream Bool+{-# NOINLINE stream #-}+stream = basicStream --- | /O(1)/ Convert a 'Bool' into a 'Bitstream'.-singleton ∷ Bitstream α ⇒ Bool → α-{-# INLINE [1] singleton #-}-singleton = unstream ∘ S.singleton+-- | /O(n)/ Convert a 'S.Stream' of 'Bool' into a 'Bitstream'.+unstream ∷ Bitstream α ⇒ Stream Bool → α+{-# NOINLINE unstream #-}+unstream = basicUnstream +{-# RULES+"Bitstream stream/unstream fusion"+    ∀s. stream (unstream s) = s++"Bitstream unstream/stream fusion"+    ∀v. unstream (stream v) = v+  #-}++-- | /O(n)/ Convert a 'Bits' into a 'Bitstream'. Note that this+-- function is undefined for instances of 'Bits' which have no fixed+-- 'bitSize' (like 'Integer').+fromBits ∷ (Integral β, Bits β, Bitstream α) ⇒ β → α+{-# INLINE fromBits #-}+fromBits β = basicFromNBits (bitSize β) β++-- | /O(n)/ Convert the lower 'n' bits of the given 'Bits'. In the+-- case that more bits are requested than the 'Bits' provides, this+-- acts as if the 'Bits' has an infinite number of leading 0 bits.+fromNBits ∷ (Integral n, Integral β, Bits β, Bitstream α) ⇒ n → β → α+{-# INLINE fromNBits #-}+fromNBits = basicFromNBits++-- | /O(n)/ Convert a 'Bitstream' into a 'Bits'.+toBits ∷ (Bitstream α, Bits β) ⇒ α → β+{-# INLINE [0] toBits #-}+toBits = basicToBits++-- | /strict: O(n), lazy: O(1)/ 'cons' is an analogous to (':') for+-- lists.+cons ∷ Bitstream α ⇒ Bool → α → α+{-# RULES+"Bitstream cons/unstream fusion"+    ∀b s. cons b (unstream s) = unstream (S.cons b s)+  #-}+{-# INLINE [0] cons #-}+cons = basicCons++-- | /O(n)/ For strict 'Bitstream's, 'cons'' is exactly the same as+-- 'cons'.+--+-- For lazy ones, 'cons'' is strict in the 'Bitstream' we are consing+-- onto. More precisely, it forces the first chunk to be evaluated. It+-- does this because, for space efficiency, it may coalesce the new+-- bit onto the first chunk rather than starting a new chunk.+cons' ∷ Bitstream α ⇒ Bool → α → α+{-# RULES+"Bitstream cons'/unstream fusion"+    ∀b s. cons' b (unstream s) = unstream (S.cons b s)+  #-}+{-# INLINE [0] cons' #-}+cons' = basicCons'++-- | /O(n)/ Append a bit to the end of a 'Bitstream'.+snoc ∷ Bitstream α ⇒ α → Bool → α+{-# RULES+"Bitstream snoc/unstream fusion"+    ∀s b. snoc (unstream s) b = unstream (S.snoc s b)+  #-}+{-# INLINE [0] snoc #-}+snoc = basicSnoc++-- | /O(n)/ Append two 'Bitstream's.+append ∷ Bitstream α ⇒ α → α → α+{-# RULES+"Bitstream append/unstream fusion"+    ∀s1 s2. append (unstream s1) (unstream s2) = unstream (s1 S.++ s2)+  #-}+{-# INLINE [0] append #-}+append = basicAppend++-- | (⧺) = 'append'+--+-- U+29FA, DOUBLE PLUS+(⧺) ∷ Bitstream α ⇒ α → α → α+{-# INLINE (⧺) #-}+(⧺) = append+ -- | /O(1)/ Extract the first bit of a non-empty 'Bitstream'. An -- exception will be thrown if empty. head ∷ Bitstream α ⇒ α → Bool {-# RULES "Bitstream head/unstream fusion"     ∀s. head (unstream s) = S.head s   #-}-{-# INLINE [1] head #-}+{-# INLINE [0] head #-} head = S.head ∘ stream  -- | /strict: O(1), lazy: O(n)/ Extract the last bit of a finite@@ -346,31 +376,138 @@ {-# RULES "Bitstream last/unstream fusion"     ∀s. last (unstream s) = S.last s   #-}-{-# INLINE [1] last #-}+{-# INLINE [0] last #-} last = S.last ∘ stream +-- | /O(1)/ Extract the bits after the 'head' of a non-empty+-- 'Bitstream'. An exception will be thrown if empty.+tail ∷ Bitstream α ⇒ α → α+{-# RULES+"Bitstream tail/unstream fusion"+    ∀s. tail (unstream s) = unstream (S.tail s)+  #-}+{-# INLINE [0] tail #-}+tail = basicTail++-- | /O(n)/ Return all the bits of a 'Bitstream' except the last+-- one. An exception will be thrown if empty.+init ∷ Bitstream α ⇒ α → α+{-# RULES+"Bitstream init/unstream fusion"+    ∀s. init (unstream s) = unstream (S.init s)+  #-}+{-# INLINE [0] init #-}+init = basicInit+ -- | /O(1)/ Test whether a 'Bitstream' is empty. null ∷ Bitstream α ⇒ α → Bool {-# RULES "Bitstream null/unstream fusion"     ∀s. null (unstream s) = S.null s   #-}-{-# INLINE [1] null #-}+{-# INLINE [0] null #-} null = S.null ∘ stream --- | /O(n)/ Retern the length of a finite 'Bitstream'.+-- | /strict: O(1), lazy: O(n)/ Return the length of a finite+-- 'Bitstream'. length ∷ Bitstream α ⇒ Num n ⇒ α → n {-# RULES "Bitstream length/unstream fusion"     ∀s. length (unstream s) = genericLength s   #-}-{-# INLINE [1] length #-}+{-# INLINE [0] length #-} length = genericLength ∘ stream +-- | /O(n)/ Map a function over a 'Bitstream'.+map ∷ Bitstream α ⇒ (Bool → Bool) → α → α+{-# RULES+"Bitstream map/unstream fusion"+    ∀f s. map f (unstream s) = unstream (S.map f s)+  #-}+{-# INLINE [0] map #-}+map = basicMap++-- | /O(n)/ Reverse a 'Bitstream'.+reverse ∷ Bitstream α ⇒ α → α+{-# INLINE [0] reverse #-}+reverse = basicReverse++-- | /O(n)/ 'foldl', applied to a binary operator, a starting value+-- (typically the left-identity of the operator), and a 'Bitstream',+-- reduces the 'Bitstream' using the binary operator, from left to+-- right:+--+-- @+-- 'foldl' f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+-- @+--+-- The 'Bitstream' must be finite.+foldl ∷ Bitstream α ⇒ (β → Bool → β) → β → α → β+{-# RULES "Bitstream foldl/unstream fusion"+    ∀f β s. foldl f β (unstream s) = S.foldl f β s+  #-}+{-# INLINE [0] foldl #-}+foldl f β = S.foldl f β ∘ stream++-- | /O(n)/ 'foldl'' is a variant of 'foldl' that is strict on the+-- accumulator.+foldl' ∷ Bitstream α ⇒ (β → Bool → β) → β → α → β+{-# RULES "Bitstream foldl'/unstream fusion"+    ∀f β s. foldl' f β (unstream s) = S.foldl' f β s+  #-}+{-# INLINE [0] foldl' #-}+foldl' f β = S.foldl' f β ∘ stream++-- | /O(n)/ 'foldl1' is a variant of 'foldl' that has no starting+-- value argument, and thus must be applied to non-empty 'Bitstream's.+foldl1 ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → Bool+{-# RULES "Bitstream foldl1/unstream fusion"+    ∀f s. foldl1 f (unstream s) = S.foldl1 f s+  #-}+{-# INLINE [0] foldl1 #-}+foldl1 f = S.foldl1 f ∘ stream++-- | /O(n)/ A strict version of 'foldl1'.+foldl1' ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → Bool+{-# RULES "Bitstream foldl1'/unstream fusion"+    ∀f s. foldl1' f (unstream s) = S.foldl1' f s+  #-}+{-# INLINE [0] foldl1' #-}+foldl1' f = S.foldl1' f ∘ stream++-- | /O(n)/ 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a 'Bitstream',+-- reduces the 'Bitstream' using the binary operator, from right to+-- left:+--+-- @+-- 'foldr' f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)+-- @+foldr ∷ Bitstream α ⇒ (Bool → β → β) → β → α → β+{-# RULES "Bitstream foldr/unstream fusion"+    ∀f β s. foldr f β (unstream s) = S.foldr f β s+  #-}+{-# INLINE [0] foldr #-}+foldr f β = S.foldr f β ∘ stream++-- | /O(n)/ 'foldr1' is a variant of 'foldr' that has no starting+-- value argument, and thus must be applied to non-empty 'Bitstream's.+foldr1 ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → Bool+{-# RULES "Bitstream foldr1/unstream fusion"+    ∀f s. foldr1 f (unstream s) = S.foldr1 f s+  #-}+{-# INLINE [0] foldr1 #-}+foldr1 f = S.foldr1 f ∘ stream++-- | /O(n)/ Concatenate all 'Bitstream's in the list.+concat ∷ Bitstream α ⇒ [α] → α+{-# INLINE [0] concat #-}+concat = basicConcat+ -- | Map a function over a 'Bitstream' and concatenate the results. concatMap ∷ Bitstream α ⇒ (Bool → α) → α → α {-# RULES "Bitstream concatMap/unstream fusion"     ∀f s. concatMap f (unstream s) = unstream (S.concatMap f s)   #-}-{-# INLINE [1] concatMap #-}+{-# INLINE [0] concatMap #-} concatMap f = concat ∘ L.map f ∘ unpack  -- | /O(n)/ 'and' returns the conjunction of a 'Bool' list. For the@@ -382,7 +519,7 @@ {-# RULES "Bitstream and/unstream fusion"     ∀s. and (unstream s) = S.and s   #-}-{-# INLINE [1] and #-}+{-# INLINE [0] and #-} and = S.and ∘ stream  -- | /O(n)/ 'or' returns the disjunction of a 'Bool' list. For the@@ -394,7 +531,7 @@ {-# RULES "Bitstream or/unstream fusion"     ∀s. or (unstream s) = S.or s   #-}-{-# INLINE [1] or #-}+{-# INLINE [0] or #-} or = S.or ∘ stream  -- | /O(n)/ Applied to a predicate and a 'Bitstream', 'any' determines@@ -406,7 +543,7 @@ {-# RULES "Bitstream any/unstream fusion"     ∀f s. any f (unstream s) = S.or (S.map f s)   #-}-{-# INLINE [1] any #-}+{-# INLINE [0] any #-} any f = S.or ∘ S.map f ∘ stream  -- | /O(n)/ Applied to a predicate and a 'Bitstream', 'all' determines@@ -418,9 +555,29 @@ {-# RULES "Bitstream all/unstream fusion"     ∀f s. all f (unstream s) = S.and (S.map f s)   #-}-{-# INLINE [1] all #-}+{-# INLINE [0] all #-} all f = S.and ∘ S.map f ∘ stream +-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a 'Bitstream'+-- of successive reduced bits from the left:+--+-- @+-- 'scanl' f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+-- @+--+-- Note that+--+-- @+-- 'last' ('scanl' f z xs) == 'foldl' f z xs+-- @+scanl ∷ Bitstream α ⇒ (Bool → Bool → Bool) → Bool → α → α+{-# RULES+"Bitstream scanl/unstream fusion"+    ∀f b s. scanl f b (unstream s) = unstream (S.scanl f b s)+  #-}+{-# INLINE [0] scanl #-}+scanl = basicScanl+ -- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting -- value argument: --@@ -428,10 +585,7 @@ -- 'scanl1' f [x1, x2, ...] == [x1, x1 `f` x2, ...] -- @ scanl1 ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → α-{-# RULES "Bitstream scanl1/unstream fusion"-    ∀f s. scanl1 f (unstream s) = S.scanl1 f s-  #-}-{-# INLINE [1] scanl1 #-}+{-# INLINE [0] scanl1 #-} scanl1 f α     | null α    = α     | otherwise = scanl f (head α) (tail α)@@ -442,81 +596,20 @@ -- 'head' ('scanr' f z xs) == 'foldr' f z xs -- @ scanr ∷ Bitstream α ⇒ (Bool → Bool → Bool) → Bool → α → α-{-# INLINE [1] scanr #-}+{-# INLINE [0] scanr #-} scanr f b = reverse ∘ scanl (flip f) b ∘ reverse  -- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting -- value argument. scanr1 ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → α-{-# INLINE [1] scanr1 #-}+{-# INLINE [0] scanr1 #-} scanr1 f = reverse ∘ scanl1 (flip f) ∘ reverse --- | /O(n)/ 'foldl', applied to a binary operator, a starting value--- (typically the left-identity of the operator), and a 'Bitstream',--- reduces the 'Bitstream' using the binary operator, from left to--- right:------ @--- 'foldl' f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn--- @------ The 'Bitstream' must be finite.-foldl ∷ Bitstream α ⇒ (β → Bool → β) → β → α → β-{-# RULES "Bitstream foldl/unstream fusion"-    ∀f β s. foldl f β (unstream s) = S.foldl f β s-  #-}-{-# INLINE [1] foldl #-}-foldl f β = S.foldl f β ∘ stream---- | /O(n)/ 'foldl'' is a variant of 'foldl' that is strict on the--- accumulator.-foldl' ∷ Bitstream α ⇒ (β → Bool → β) → β → α → β-{-# RULES "Bitstream foldl'/unstream fusion"-    ∀f β s. foldl' f β (unstream s) = S.foldl' f β s-  #-}-{-# INLINE [1] foldl' #-}-foldl' f β = S.foldl' f β ∘ stream---- | /O(n)/ 'foldl1' is a variant of 'foldl' that has no starting--- value argument, and thus must be applied to non-empty 'Bitstream's.-foldl1 ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → Bool-{-# RULES "Bitstream foldl1/unstream fusion"-    ∀f s. foldl1 f (unstream s) = S.foldl1 f s-  #-}-{-# INLINE [1] foldl1 #-}-foldl1 f = S.foldl1 f ∘ stream---- | /O(n)/ A strict version of 'foldl1'.-foldl1' ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → Bool-{-# RULES "Bitstream foldl1'/unstream fusion"-    ∀f s. foldl1' f (unstream s) = S.foldl1' f s-  #-}-{-# INLINE [1] foldl1' #-}-foldl1' f = S.foldl1' f ∘ stream---- | /O(n)/ 'foldr', applied to a binary operator, a starting value--- (typically the right-identity of the operator), and a 'Bitstream',--- reduces the 'Bitstream' using the binary operator, from right to--- left:------ @--- 'foldr' f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)--- @-foldr ∷ Bitstream α ⇒ (Bool → β → β) → β → α → β-{-# RULES "Bitstream foldr/unstream fusion"-    ∀f β s. foldr f β (unstream s) = S.foldr f β s-  #-}-{-# INLINE [1] foldr #-}-foldr f β = S.foldr f β ∘ stream---- | /O(n)/ 'foldr1' is a variant of 'foldr' that has no starting--- value argument, and thus must be applied to non-empty 'Bitstream's.-foldr1 ∷ Bitstream α ⇒ (Bool → Bool → Bool) → α → Bool-{-# RULES "Bitstream foldr1/unstream fusion"-    ∀f s. foldr1 f (unstream s) = S.foldr1 f s-  #-}-{-# INLINE [1] foldr1 #-}-foldr1 f = S.foldr1 f ∘ stream+-- | /O(n)/ @'replicate' n x@ is a 'Bitstream' of length @n@ with @x@+-- the value of every bit.+replicate ∷ (Integral n, Bitstream α) ⇒ n → Bool → α+{-# INLINE replicate #-}+replicate n = unstream ∘ genericReplicate n  -- | /O(n)/ The 'unfoldr' function is a \`dual\' to 'foldr': while -- 'foldr' reduces a 'Bitstream' to a summary value, 'unfoldr' builds@@ -526,23 +619,56 @@ -- 'Bitstream' and @b@ is used as the next element in a recursive -- call. unfoldr ∷ Bitstream α ⇒ (β → Maybe (Bool, β)) → β → α-{-# INLINE [1] unfoldr #-}+{-# INLINE unfoldr #-} unfoldr f = unstream ∘ S.unfoldr f  -- | /O(n)/ 'unfoldrN' is a variant of 'unfoldr' but constructs a -- 'Bitstream' with at most @n@ bits.-unfoldrN ∷ (Bitstream α, Integral n) ⇒ n → (β → Maybe (Bool, β)) → β → α-{-# INLINE [1] unfoldrN #-}+unfoldrN ∷ (Integral n, Bitstream α) ⇒ n → (β → Maybe (Bool, β)) → β → α+{-# INLINE unfoldrN #-} unfoldrN n f = unstream ∘ genericUnfoldrN n f --- | /O(n)/ 'Bitstream' index (subscript) operator, starting from 0.-(!!) ∷ (Bitstream α, Integral n) ⇒ α → n → Bool-{-# RULES "Bitstream (!!)/unstream fusion"-    ∀s n. (unstream s) !! n = genericIndex s n+-- | /O(n)/ 'take' @n@, applied to a 'Bitstream' @xs@, returns the+-- prefix of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.+take ∷ (Integral n, Bitstream α) ⇒ n → α → α+{-# RULES+"Bitstream take/unstream fusion"+    ∀n s. take n (unstream s) = unstream (genericTake n s)   #-}-{-# INLINE [1] (!!) #-}-α !! n = genericIndex (stream α) n+{-# INLINE [0] take #-}+take = basicTake +-- | /O(n)/ 'drop' @n xs@ returns the suffix of @xs@ after the first+-- @n@ bits, or 'empty' if @n > 'length' xs@.+drop ∷ (Integral n, Bitstream α) ⇒ n → α → α+{-# RULES+"Bitstream drop/unstream fusion"+    ∀n s. drop n (unstream s) = unstream (genericDrop n s)+  #-}+{-# INLINE [0] drop #-}+drop = basicDrop++-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Bitstream'+-- @xs@, returns the longest prefix (possibly 'empty') of @xs@ of bits+-- that satisfy @p@.+takeWhile ∷ Bitstream α ⇒ (Bool → Bool) → α → α+{-# RULES+"Bitstream takeWhile/unstream fusion"+    ∀f s. takeWhile f (unstream s) = unstream (S.takeWhile f s)+  #-}+{-# INLINE [0] takeWhile #-}+takeWhile = basicTakeWhile++-- | /O(n)/ 'dropWhile' @p xs@ returns the suffix remaining after+-- 'takeWhile' @p xs@.+dropWhile ∷ Bitstream α ⇒ (Bool → Bool) → α → α+{-# RULES+"Bitstream dropWhile/unstream fusion"+    ∀f s. dropWhile f (unstream s) = unstream (S.dropWhile f s)+  #-}+{-# INLINE [0] dropWhile #-}+dropWhile = basicDropWhile+ -- | /O(n)/ 'span', applied to a predicate @p@ and a 'Bitstream' @xs@, -- returns a tuple where first element is longest prefix (possibly -- 'empty') of @xs@ of bits that satisfy @p@ and second element is the@@ -551,7 +677,7 @@ -- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p -- xs)@ span ∷ Bitstream α ⇒ (Bool → Bool) → α → (α, α)-{-# INLINE [1] span #-}+{-# INLINE span #-} span f α     = let hd = takeWhile f α           tl = drop (length hd ∷ Integer) α@@ -565,7 +691,7 @@ -- -- 'break' @p@ is equivalent to @'span' ('not' . p)@. break ∷ Bitstream α ⇒ (Bool → Bool) → α → (α, α)-{-# INLINE [1] break #-}+{-# INLINE break #-} break f = span ((¬) ∘ f)  -- | /O(n)/ 'elem' is the 'Bitstream' membership predicate, usually@@ -577,18 +703,46 @@ {-# RULES "Bitstream elem/unstream fusion"     ∀b s. elem b (unstream s) = S.elem b s   #-}-{-# INLINE [1] elem #-}+{-# INLINE [0] elem #-} elem True  = or elem False = (¬) ∘ and +-- | (∈) = 'elem'+--+-- U+2208, ELEMENT OF+(∈) ∷ Bitstream α ⇒ Bool → α → Bool+{-# INLINE (∈) #-}+(∈) = elem++-- | (∋) = 'flip' (∈)+--+-- U+220B, CONTAINS AS MEMBER+(∋) ∷ Bitstream α ⇒ α → Bool → Bool+{-# INLINE (∋) #-}+(∋) = flip elem+ -- | /O(n)/ 'notElem' is the negation of 'elem'. notElem ∷ Bitstream α ⇒ Bool → α → Bool {-# RULES "Bitstream notElem/unstream fusion"     ∀b s. notElem b (unstream s) = S.notElem b s   #-}-{-# INLINE [1] notElem #-}+{-# INLINE [0] notElem #-} notElem = ((¬) ∘) ∘ (∈) +-- | (∉) = 'notElem'+--+-- U+2209, NOT AN ELEMENT OF+(∉) ∷ Bitstream α ⇒ Bool → α → Bool+{-# INLINE (∉) #-}+(∉) = notElem++-- | (∌) = 'flip' (∉)+--+-- U+220C, DOES NOT CONTAIN AS MEMBER+(∌) ∷ Bitstream α ⇒ α → Bool → Bool+(∌) = flip notElem+{-# INLINE (∌) #-}+ -- | /O(n)/ The 'find' function takes a predicate and a 'Bitstream' -- and returns the bit in the 'Bitstream' matching the predicate, or -- 'Nothing' if there is no such bit.@@ -596,9 +750,34 @@ {-# RULES "Bitstream find/unstream fusion"     ∀f s. find f (unstream s) = S.find f s   #-}-{-# INLINE [1] find #-}+{-# INLINE [0] find #-} find f = S.find f ∘ stream +-- | /O(n)/ 'filter', applied to a predicate and a 'Bitstream',+-- returns the 'Bitstream' of those bits that satisfy the predicate.+filter ∷ Bitstream α ⇒ (Bool → Bool) → α → α+{-# RULES+"Bitstream filter/unstream fusion"+    ∀f s. filter f (unstream s) = unstream (S.filter f s)+  #-}+{-# INLINE [0] filter #-}+filter = basicFilter++-- | /O(n)/ The 'partition' function takes a predicate and a+-- 'Bitstream' and returns the pair of 'Bitstream's of bits which do+-- and do not satisfy the predicate, respectively.+partition ∷ Bitstream α ⇒ (Bool → Bool) → α → (α, α)+{-# INLINE [0] partition #-}+partition = basicPartition++-- | /O(n)/ 'Bitstream' index (subscript) operator, starting from 0.+(!!) ∷ (Bitstream α, Integral n) ⇒ α → n → Bool+{-# RULES "Bitstream (!!)/unstream fusion"+    ∀s n. (unstream s) !! n = genericIndex s n+  #-}+{-# INLINE [0] (!!) #-}+α !! n = genericIndex (stream α) n+ -- | /O(n)/ The 'elemIndex' function returns the index of the first -- bit in the given 'Bitstream' which is equal to the query bit, or -- 'Nothing' if there is no such bit.@@ -606,7 +785,7 @@ {-# RULES "Bitstream elemIndex/unstream fusion"     ∀b s. elemIndex b (unstream s) = genericFindIndex (≡ b) s   #-}-{-# INLINE [1] elemIndex #-}+{-# INLINE [0] elemIndex #-} elemIndex = findIndex ∘ (≡)  -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by@@ -620,7 +799,7 @@               $ S.filter ((≡ b) ∘ snd)               $ genericIndexed s   #-}-{-# INLINE [1] elemIndices #-}+{-# INLINE [0] elemIndices #-} elemIndices = findIndices ∘ (≡)  -- | /O(n)/ The 'findIndex' function takes a predicate and a@@ -631,7 +810,7 @@ {-# RULES "Bitstream findIndex/unstream fusion"     ∀f s. findIndex f (unstream s) = genericFindIndex f s   #-}-{-# INLINE [1] findIndex #-}+{-# INLINE [0] findIndex #-} findIndex f = genericFindIndex f ∘ stream  -- | /O(n)/ The 'findIndices' function extends 'findIndex', by@@ -645,7 +824,7 @@               $ S.filter (f ∘ snd)               $ genericIndexed s   #-}-{-# INLINE [1] findIndices #-}+{-# INLINE [0] findIndices #-} findIndices f     = S.toList     ∘ S.map fst@@ -661,7 +840,7 @@     zip (unstream s1) (unstream s2)         = S.toList (S.zip s1 s2)   #-}-{-# INLINE [1] zip #-}+{-# INLINE [0] zip #-} zip = zipWith (,)  -- | The 'zip3' function takes three 'Bitstream's and returns a list@@ -671,7 +850,7 @@     zip3 (unstream s1) (unstream s2) (unstream s3)         = S.toList (S.zip3 s1 s2 s3)   #-}-{-# INLINE [1] zip3 #-}+{-# INLINE [0] zip3 #-} zip3 = zipWith3 (,,)  -- | The 'zip4' function takes four lists and returns a list of@@ -681,7 +860,7 @@     zip4 (unstream s1) (unstream s2) (unstream s3) (unstream s4)         = S.toList (S.zip4 s1 s2 s3 s4)   #-}-{-# INLINE [1] zip4 #-}+{-# INLINE [0] zip4 #-} zip4 = zipWith4 (,,,)  -- | The 'zip5' function takes five 'Bitstream's and returns a list of@@ -691,7 +870,7 @@     zip5 (unstream s1) (unstream s2) (unstream s3) (unstream s4) (unstream s5)         = S.toList (S.zip5 s1 s2 s3 s4 s5)   #-}-{-# INLINE [1] zip5 #-}+{-# INLINE [0] zip5 #-} zip5 = zipWith5 (,,,,)  -- | The 'zip6' function takes six 'Bitstream's and returns a list of@@ -701,7 +880,7 @@     zip6 (unstream s1) (unstream s2) (unstream s3) (unstream s4) (unstream s5) (unstream s6)         = S.toList (S.zip6 s1 s2 s3 s4 s5 s6)   #-}-{-# INLINE [1] zip6 #-}+{-# INLINE [0] zip6 #-} zip6 = zipWith6 (,,,,,)  -- | /O(min(m, n))/ 'zipWith' generalises 'zip' by zipping with the@@ -712,7 +891,7 @@     zipWith f (unstream s1) (unstream s2)         = S.toList (S.zipWith f s1 s2)   #-}-{-# INLINEABLE [1] zipWith #-}+{-# INLINEABLE [0] zipWith #-} zipWith f α β = S.toList $                 S.zipWith f                      (stream α)@@ -726,7 +905,7 @@     zipWith3 f (unstream s1) (unstream s2) (unstream s3)         = S.toList (S.zipWith3 f s1 s2 s3)   #-}-{-# INLINEABLE [1] zipWith3 #-}+{-# INLINEABLE [0] zipWith3 #-} zipWith3 f α β γ = S.toList $                    S.zipWith3 f                         (stream α)@@ -741,7 +920,7 @@     zipWith4 f (unstream s1) (unstream s2) (unstream s3) (unstream s4)         = S.toList (S.zipWith4 f s1 s2 s3 s4)   #-}-{-# INLINEABLE [1] zipWith4 #-}+{-# INLINEABLE [0] zipWith4 #-} zipWith4 f α β γ δ = S.toList $                      S.zipWith4 f                           (stream α)@@ -757,7 +936,7 @@     zipWith5 f (unstream s1) (unstream s2) (unstream s3) (unstream s4) (unstream s5)         = S.toList (S.zipWith5 f s1 s2 s3 s4 s5)   #-}-{-# INLINEABLE [1] zipWith5 #-}+{-# INLINEABLE [0] zipWith5 #-} zipWith5 f α β γ δ ε = S.toList $                        S.zipWith5 f                             (stream α)@@ -774,7 +953,7 @@     zipWith6 f (unstream s1) (unstream s2) (unstream s3) (unstream s4) (unstream s5) (unstream s6)         = S.toList (S.zipWith6 f s1 s2 s3 s4 s5 s6)   #-}-{-# INLINEABLE [1] zipWith6 #-}+{-# INLINEABLE [0] zipWith6 #-} zipWith6 f α β γ δ ε ζ = S.toList $                          S.zipWith6 f                               (stream α)@@ -788,14 +967,14 @@ -- 'Bitstream' of first components and a 'Bitstream' of second -- components. unzip ∷ Bitstream α ⇒ [(Bool, Bool)] → (α, α)-{-# INLINEABLE [1] unzip #-}+{-# INLINEABLE unzip #-} unzip xs = ( unstream $ S.map fst $ S.fromList xs            , unstream $ S.map snd $ S.fromList xs )  -- | The 'unzip3' function takes a list of triples and returns three -- 'Bitstream's, analogous to 'unzip'. unzip3 ∷ Bitstream α ⇒ [(Bool, Bool, Bool)] → (α, α, α)-{-# INLINEABLE [1] unzip3 #-}+{-# INLINEABLE unzip3 #-} unzip3 xs = ( unstream $ S.map (\(α, _, _) → α) $ S.fromList xs             , unstream $ S.map (\(_, β, _) → β) $ S.fromList xs             , unstream $ S.map (\(_, _, γ) → γ) $ S.fromList xs )@@ -803,7 +982,7 @@ -- | The 'unzip4' function takes a list of quadruples and returns -- four 'Bitstream's, analogous to 'unzip'. unzip4 ∷ Bitstream α ⇒ [(Bool, Bool, Bool, Bool)] → (α, α, α, α)-{-# INLINEABLE [1] unzip4 #-}+{-# INLINEABLE unzip4 #-} unzip4 xs = ( unstream $ S.map (\(α, _, _, _) → α) $ S.fromList xs             , unstream $ S.map (\(_, β, _, _) → β) $ S.fromList xs             , unstream $ S.map (\(_, _, γ, _) → γ) $ S.fromList xs@@ -812,7 +991,7 @@ -- | The 'unzip5' function takes a list of five-tuples and returns -- five 'Bitstream's, analogous to 'unzip'. unzip5 ∷ Bitstream α ⇒ [(Bool, Bool, Bool, Bool, Bool)] → (α, α, α, α, α)-{-# INLINEABLE [1] unzip5 #-}+{-# INLINEABLE unzip5 #-} unzip5 xs = ( unstream $ S.map (\(α, _, _, _, _) → α) $ S.fromList xs             , unstream $ S.map (\(_, β, _, _, _) → β) $ S.fromList xs             , unstream $ S.map (\(_, _, γ, _, _) → γ) $ S.fromList xs@@ -822,62 +1001,10 @@ -- | The 'unzip6' function takes a list of six-tuples and returns six -- 'Bitstream's, analogous to 'unzip'. unzip6 ∷ Bitstream α ⇒ [(Bool, Bool, Bool, Bool, Bool, Bool)] → (α, α, α, α, α, α)-{-# INLINEABLE [1] unzip6 #-}+{-# INLINEABLE unzip6 #-} unzip6 xs = ( unstream $ S.map (\(α, _, _, _, _, _) → α) $ S.fromList xs             , unstream $ S.map (\(_, β, _, _, _, _) → β) $ S.fromList xs             , unstream $ S.map (\(_, _, γ, _, _, _) → γ) $ S.fromList xs             , unstream $ S.map (\(_, _, _, δ, _, _) → δ) $ S.fromList xs             , unstream $ S.map (\(_, _, _, _, ε, _) → ε) $ S.fromList xs             , unstream $ S.map (\(_, _, _, _, _, ζ) → ζ) $ S.fromList xs )--{-# RULES-"Bitstream stream/unstream fusion"-    ∀s. stream (unstream s) = s--"Bitstream unstream/stream fusion"-    ∀v. unstream (stream v) = v-  #-}--{-# RULES-"Bitstream cons/unstream fusion"-    ∀b s. cons b (unstream s) = unstream (S.cons b s)--"Bitstream cons'/unstream fusion"-    ∀b s. cons' b (unstream s) = unstream (S.cons b s)--"Bitstream snoc/unstream fusion"-    ∀s b. snoc (unstream s) b = unstream (S.snoc s b)--"Bitstream append/unstream fusion"-    ∀s1 s2. append (unstream s1) (unstream s2) = unstream (s1 S.++ s2)--"Bitstream tail/unstream fusion"-    ∀s. tail (unstream s) = unstream (S.tail s)--"Bitstream init/unstream fusion"-    ∀s. init (unstream s) = unstream (S.init s)--"Bitstream map/unstream fusion"-    ∀f s. map f (unstream s) = unstream (S.map f s)--"Bitstream scanl/unstream fusion"-    ∀f b s. scanl f b (unstream s) = unstream (S.scanl f b s)--"Bitstream scanl1/unstream fusion"-    ∀f s. scanl1 f (unstream s) = unstream (S.scanl1 f s)--"Bitstream take/unstream fusion"-    ∀n s. take n (unstream s) = unstream (genericTake n s)--"Bitstream drop/unstream fusion"-    ∀n s. drop n (unstream s) = unstream (genericDrop n s)--"Bitstream takeWhile/unstream fusion"-    ∀f s. takeWhile f (unstream s) = unstream (S.takeWhile f s)--"Bitstream dropWhile/unstream fusion"-    ∀f s. dropWhile f (unstream s) = unstream (S.dropWhile f s)--"Bitstream filter/unstream fusion"-    ∀f s. filter f (unstream s) = unstream (S.filter f s)-  #-}

@@ -4,24 +4,31 @@   #-} module Data.Bitstream.Internal     ( packPackets++    , lePacketsFromNBits+    , bePacketsFromNBits++    , lePacketsToBits+    , bePacketsToBits     )     where+import Data.Bits import Data.Bitstream.Generic import Data.Bitstream.Packet import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) import Data.Vector.Fusion.Stream.Size-import Prelude hiding (null)+import Prelude hiding (length, null) import Prelude.Unicode  packPackets ∷ (Bitstream (Packet d), Monad m) ⇒ Stream m Bool → Stream m (Packet d)-{-# INLINE packPackets #-}+{-# INLINEABLE packPackets #-} packPackets (Stream step s0 sz) = Stream step' ((∅), Just s0) sz'     where       sz' ∷ Size       {-# INLINE sz' #-}       sz' = case sz of-              Exact n → Exact (n+7 `div` 8)-              Max   n → Max   (n+7 `div` 8)+              Exact n → Exact ((n+7) `div` 8)+              Max   n → Max   ((n+7) `div` 8)               Unknown → Unknown       {-# INLINE step' #-}       step' (p, Just s)@@ -36,3 +43,84 @@                      | otherwise → return $ Yield p ((⊥)       , Nothing)       step' (_, Nothing)           = return Done++nOctets ∷ Integral n ⇒ n → Int+{-# INLINE nOctets #-}+nOctets nBits+    = (fromIntegral nBits + 7) `div` 8++lePacketsFromNBits ∷ ( Integral n+                     , Integral β+                     , Bits β+                     , Monad m+                     )+                   ⇒ n+                   → β+                   → Stream m (Packet Left)+{-# INLINEABLE lePacketsFromNBits #-}+lePacketsFromNBits n0 β0 = Stream step (n0, β0) (Exact (nOctets n0))+    where+      {-# INLINE step #-}+      step (n, β)+          | n > 0+              = let !n'  = min 8 n+                    !n'' = n - n'+                    !p   = fromNBits n' β+                    !β'  = β `shiftR` 8+                in+                  return $ Yield p (n'', β')+          | otherwise+              = return Done++bePacketsFromNBits ∷ ( Integral n+                     , Integral β+                     , Bits β+                     , Monad m+                     )+                   ⇒ n+                   → β+                   → Stream m (Packet Right)+{-# INLINEABLE bePacketsFromNBits #-}+bePacketsFromNBits n0 β = Stream step (n0, nOctets n0 ⋅ 8) (Exact (nOctets n0))+    where+      {-# INLINE step #-}+      step (n, r)+          | n > 0+              = let !r'  = r - 8+                    !n'  = n - fromIntegral r'+                    !n'' = n - n'+                    !p   = fromNBits n' (β `shiftR` r')+                in+                  return $ Yield p (n'', r')+          | otherwise+              = return Done++lePacketsToBits ∷ (Monad m, Bits β) ⇒ Stream m (Packet Left) → m β+{-# INLINEABLE lePacketsToBits #-}+lePacketsToBits (Stream step s0 _) = go (s0, 0, 0)+    where+      {-# INLINE go #-}+      go (s, o, n)+          = do r ← step s+               case r of+                 Yield p s' → let !n' = (toBits p `shiftL` o) .|. n+                                  !o' = o + length p+                              in+                                go (s', o', n')+                 Skip    s' → go (s', o, n)+                 Done       → return n++bePacketsToBits ∷ (Monad m, Bits β) ⇒ Stream m (Packet Right) → m β+{-# INLINEABLE bePacketsToBits #-}+bePacketsToBits (Stream step s0 _) = go (s0, 0)+    where+      {-# INLINE go #-}+      go (s, n)+          = do r ← step s+               case r of+                 Yield p s' → let !o  = length p+                                  !n' = (n `shiftL` o) .|. toBits p+                              in+                                go (s', n')+                 Skip    s' → go (s', n)+                 Done       → return n

@@ -1,6 +1,7 @@ {-# LANGUAGE     BangPatterns   , FlexibleContexts+  , FlexibleInstances   , ScopedTypeVariables   , UndecidableInstances   , UnicodeSyntax@@ -16,7 +17,7 @@ -- Lazy 'Bitstream's are made of possibly infinite list of strict -- 'SB.Bitstream's as chunks, and each chunks have at least 1 bit. module Data.Bitstream.Lazy-    ( -- * Types+    ( -- * Data types       Bitstream     , Left     , Right@@ -34,6 +35,11 @@     , fromByteString     , toByteString +    -- ** Converting from\/to 'Bits''+    , fromBits+    , fromNBits+    , toBits+       -- ** Converting from\/to 'S.Stream's     , stream     , unstream@@ -75,7 +81,7 @@     , any     , all -      -- * Building lists+      -- * Building 'Bitstream's       -- ** Scans     , scanl     , scanl1@@ -205,7 +211,7 @@           , " ]"           ] -instance G.Bitstream (Packet d) ⇒ Eq (Bitstream d) where+instance G.Bitstream (Bitstream d) ⇒ Eq (Bitstream d) where     {-# INLINE (==) #-}     x == y = stream x ≡ stream y @@ -220,7 +226,7 @@ --   , 'compare' z y -- 'LT' --   ] -- @-instance G.Bitstream (Packet d) ⇒ Ord (Bitstream d) where+instance G.Bitstream (Bitstream d) ⇒ Ord (Bitstream d) where     {-# INLINE compare #-}     x `compare` y = stream x `compare` stream y @@ -231,142 +237,319 @@ -- 'mappend' = 'append' -- 'mconcat' = 'concat' -- @-instance G.Bitstream (Packet d) ⇒ Monoid (Bitstream d) where+instance G.Bitstream (Bitstream d) ⇒ Monoid (Bitstream d) where     mempty  = (∅)     mappend = (⧺)     mconcat = concat -instance G.Bitstream (Packet d) ⇒ G.Bitstream (Bitstream d) where-    {-# INLINE [0] stream #-}-    stream-        = {-# CORE "Lazy Bitstream stream" #-}-          S.concatMap stream ∘ streamChunks+instance G.Bitstream (Bitstream Left) where+    {-# INLINE basicStream #-}+    basicStream = lazyStream -    {-# INLINE [0] unstream #-}-    unstream-        = {-# CORE "Lazy Bitstream unstream" #-}-          unId ∘ unstreamChunks ∘ packChunks ∘ packPackets+    {-# INLINE basicUnstream #-}+    basicUnstream = lazyUnstream -    {-# INLINE [2] cons #-}-    cons b = Chunk (singleton b)+    {-# INLINE basicCons #-}+    basicCons = lazyCons -    {-# INLINEABLE [2] cons' #-}-    cons' b Empty-        = Chunk (SB.singleton b) Empty-    cons' b (Chunk x xs)-        | length x < (chunkBits ∷ Int)-            = Chunk (b `cons` x) xs-        | otherwise-            = Chunk (singleton b) (Chunk x xs)+    {-# INLINE basicCons' #-}+    basicCons' = lazyCons' -    {-# INLINEABLE [2] snoc #-}-    snoc Empty b-        = Chunk (SB.singleton b) Empty-    snoc (Chunk x Empty) b-        | length x < (chunkBits ∷ Int)-            = Chunk (x `snoc` b) Empty-        | otherwise-            = Chunk x (Chunk (singleton b) Empty)-    snoc (Chunk x xs) b-        = Chunk x (xs `snoc` b)+    {-# INLINE basicSnoc #-}+    basicSnoc = lazySnoc -    {-# INLINE [2] append #-}-    append Empty ch        = ch-    append (Chunk x xs) ch = Chunk x (append xs ch)+    {-# INLINE basicAppend #-}+    basicAppend = lazyAppend -    {-# INLINEABLE [2] tail #-}-    tail Empty        = emptyStream-    tail (Chunk x xs) = case tail x of+    {-# INLINE basicTail #-}+    basicTail = lazyTail++    {-# INLINE basicInit #-}+    basicInit = lazyInit++    {-# INLINE basicMap #-}+    basicMap = lazyMap++    {-# INLINE basicReverse #-}+    basicReverse = lazyReverse++    {-# INLINE basicConcat #-}+    basicConcat = lazyConcat++    {-# INLINE basicScanl #-}+    basicScanl = lazyScanl++    {-# INLINE basicTake #-}+    basicTake = lazyTake++    {-# INLINE basicDrop #-}+    basicDrop = lazyDrop++    {-# INLINE basicTakeWhile #-}+    basicTakeWhile = lazyTakeWhile++    {-# INLINE basicDropWhile #-}+    basicDropWhile = lazyDropWhile++    {-# INLINE basicFilter #-}+    basicFilter = lazyFilter++    {-# INLINE basicFromNBits #-}+    basicFromNBits+        = ((unId ∘ unstreamChunks ∘ packChunks) ∘) ∘ lePacketsFromNBits++    {-# INLINE basicToBits #-}+    basicToBits = unId ∘ lePacketsToBits ∘ unpackChunks ∘ streamChunks++instance G.Bitstream (Bitstream Right) where+    {-# INLINE basicStream #-}+    basicStream = lazyStream++    {-# INLINE basicUnstream #-}+    basicUnstream = lazyUnstream++    {-# INLINE basicCons #-}+    basicCons = lazyCons++    {-# INLINE basicCons' #-}+    basicCons' = lazyCons'++    {-# INLINE basicSnoc #-}+    basicSnoc = lazySnoc++    {-# INLINE basicAppend #-}+    basicAppend = lazyAppend++    {-# INLINE basicTail #-}+    basicTail = lazyTail++    {-# INLINE basicInit #-}+    basicInit = lazyInit++    {-# INLINE basicMap #-}+    basicMap = lazyMap++    {-# INLINE basicReverse #-}+    basicReverse = lazyReverse++    {-# INLINE basicConcat #-}+    basicConcat = lazyConcat++    {-# INLINE basicScanl #-}+    basicScanl = lazyScanl++    {-# INLINE basicTake #-}+    basicTake = lazyTake++    {-# INLINE basicDrop #-}+    basicDrop = lazyDrop++    {-# INLINE basicTakeWhile #-}+    basicTakeWhile = lazyTakeWhile++    {-# INLINE basicDropWhile #-}+    basicDropWhile = lazyDropWhile++    {-# INLINE basicFilter #-}+    basicFilter = lazyFilter++    {-# INLINE basicFromNBits #-}+    basicFromNBits+        = ((unId ∘ unstreamChunks ∘ packChunks) ∘) ∘ bePacketsFromNBits++    {-# INLINE basicToBits #-}+    basicToBits = unId ∘ bePacketsToBits ∘ unpackChunks ∘ streamChunks++lazyStream ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → S.Stream Bool+{-# INLINE lazyStream #-}+lazyStream+    = {-# CORE "Lazy Bitstream stream" #-}+      S.concatMap stream ∘ streamChunks++lazyUnstream ∷ ( G.Bitstream (SB.Bitstream d)+               , G.Bitstream (Packet d)+               )+             ⇒ S.Stream Bool+             → Bitstream d+{-# INLINE lazyUnstream #-}+lazyUnstream+    = {-# CORE "Lazy Bitstream unstream" #-}+      unId ∘ unstreamChunks ∘ packChunks ∘ packPackets++lazyCons ∷ G.Bitstream (SB.Bitstream d) ⇒ Bool → Bitstream d → Bitstream d+{-# INLINE lazyCons #-}+lazyCons = Chunk ∘ singleton++lazyCons' ∷ G.Bitstream (SB.Bitstream d) ⇒ Bool → Bitstream d → Bitstream d+{-# INLINEABLE lazyCons' #-}+lazyCons' b Empty+    = Chunk (SB.singleton b) Empty+lazyCons' b (Chunk x xs)+    | length x < (chunkBits ∷ Int)+        = Chunk (b `cons` x) xs+    | otherwise+        = Chunk (singleton b) (Chunk x xs)++lazySnoc ∷ ( G.Bitstream (SB.Bitstream d)+           , G.Bitstream (Bitstream d)+           )+         ⇒ Bitstream d+         → Bool+         → Bitstream d+{-# INLINEABLE lazySnoc #-}+lazySnoc Empty b+    = Chunk (SB.singleton b) Empty+lazySnoc (Chunk x Empty) b+    | length x < (chunkBits ∷ Int)+        = Chunk (x `snoc` b) Empty+    | otherwise+        = Chunk x (Chunk (singleton b) Empty)+lazySnoc (Chunk x xs) b+    = Chunk x (xs `snoc` b)++lazyAppend ∷ G.Bitstream (Bitstream d) ⇒ Bitstream d → Bitstream d → Bitstream d+{-# INLINE lazyAppend #-}+lazyAppend Empty ch        = ch+lazyAppend (Chunk x xs) ch = Chunk x (append xs ch)++lazyTail ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bitstream d+{-# INLINEABLE lazyTail #-}+lazyTail Empty        = emptyStream+lazyTail (Chunk x xs) = case tail x of                           x' | null x'   → xs                              | otherwise → Chunk x' xs -    {-# INLINEABLE [2] init #-}-    init Empty           = emptyStream-    init (Chunk x Empty) = case init x of+lazyInit ∷ ( G.Bitstream (SB.Bitstream d)+           , G.Bitstream (Bitstream d)+           )+         ⇒ Bitstream d+         → Bitstream d+{-# INLINEABLE lazyInit #-}+lazyInit Empty           = emptyStream+lazyInit (Chunk x Empty) = case init x of                              x' | null x'   → Empty                                 | otherwise → Chunk x' Empty-    init (Chunk x xs   ) = Chunk x (init xs)--    {-# INLINE [2] map #-}-    map _ Empty        = Empty-    map f (Chunk x xs) = Chunk (map f x) (map f xs)+lazyInit (Chunk x xs   ) = Chunk x (init xs) -    {-# INLINEABLE [2] reverse #-}-    reverse ch0 = go ch0 Empty-        where-          {-# INLINE go #-}-          go Empty        ch = ch-          go (Chunk x xs) ch = go xs (Chunk (reverse x) ch)+lazyMap ∷ ( G.Bitstream (SB.Bitstream d)+          , G.Bitstream (Bitstream d)+          )+        ⇒ (Bool → Bool)+        → Bitstream d+        → Bitstream d+{-# INLINE lazyMap #-}+lazyMap _ Empty        = Empty+lazyMap f (Chunk x xs) = Chunk (map f x) (map f xs) -    {-# INLINE [2] scanl #-}-    scanl f b ch-        = Chunk (singleton b)-                (case ch of-                   Empty      → Empty-                   Chunk x xs → let h   = head x-                                    x'  = scanl f (f b h) (tail x)-                                    l   = last x'-                                    x'' = init x'-                                    xs' = scanl f l xs-                                in-                                  if null x''-                                  then xs'-                                  else Chunk x'' xs')+lazyReverse ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bitstream d+{-# INLINEABLE lazyReverse #-}+lazyReverse ch0 = go ch0 Empty+    where+      {-# INLINE go #-}+      go Empty        ch = ch+      go (Chunk x xs) ch = go xs (Chunk (reverse x) ch) -    {-# INLINE [2] concat #-}-    concat = fromChunks ∘ L.concatMap toChunks+lazyConcat ∷ G.Bitstream (SB.Bitstream d) ⇒ [Bitstream d] → Bitstream d+{-# INLINE lazyConcat #-}+lazyConcat = fromChunks ∘ L.concatMap toChunks -    {-# INLINEABLE replicate #-}-    replicate n b-        | n ≤ 0         = Empty-        | n < chunkBits = Chunk (replicate n b) Empty-        | otherwise     = Chunk x (replicate (n - chunkBits) b)-        where-          x = replicate (chunkBits ∷ Int) b+lazyScanl ∷ ( G.Bitstream (SB.Bitstream d)+            , G.Bitstream (Bitstream d)+            )+          ⇒ (Bool → Bool → Bool)+          → Bool+          → Bitstream d+          → Bitstream d+{-# INLINEABLE lazyScanl #-}+lazyScanl f b ch+    = Chunk (singleton b)+            (case ch of+               Empty      → Empty+               Chunk x xs → let h   = head x+                                x'  = scanl f (f b h) (tail x)+                                l   = last x'+                                x'' = init x'+                                xs' = scanl f l xs+                            in+                              if null x''+                              then xs'+                              else Chunk x'' xs') -    {-# INLINEABLE [2] take #-}-    take _ Empty        = Empty-    take n (Chunk x xs)-        | n ≤ 0         = Empty-        | n ≥ length x  = Chunk x (take (n - length x) xs)-        | otherwise     = Chunk (take n x) Empty+lazyTake ∷ ( Integral n+           , G.Bitstream (SB.Bitstream d)+           , G.Bitstream (Bitstream d)+           )+         ⇒ n+         → Bitstream d+         → Bitstream d+{-# INLINEABLE lazyTake #-}+lazyTake _ Empty        = Empty+lazyTake n (Chunk x xs)+    | n ≤ 0              = Empty+    | n ≥ length x       = Chunk x (take (n - length x) xs)+    | otherwise          = Chunk (take n x) Empty -    {-# INLINEABLE [2] drop #-}-    drop _ Empty       = Empty-    drop n (Chunk x xs)-        | n ≤ 0        = Chunk x xs-        | n ≥ length x = drop (n - length x) xs-        | otherwise    = Chunk (drop n x) xs+lazyDrop ∷ ( Integral n+           , G.Bitstream (SB.Bitstream d)+           , G.Bitstream (Bitstream d)+           )+         ⇒ n+         → Bitstream d+         → Bitstream d+{-# INLINEABLE lazyDrop #-}+lazyDrop _ Empty        = Empty+lazyDrop n (Chunk x xs)+    | n ≤ 0              = Chunk x xs+    | n ≥ length x       = drop (n - length x) xs+    | otherwise          = Chunk (drop n x) xs -    {-# INLINEABLE [2] takeWhile #-}-    takeWhile _ Empty        = Empty-    takeWhile f (Chunk x xs) = case takeWhile f x of+lazyTakeWhile ∷ ( G.Bitstream (SB.Bitstream d)+                , G.Bitstream (Bitstream d)+                )+              ⇒ (Bool → Bool)+              → Bitstream d+              → Bitstream d+{-# INLINEABLE lazyTakeWhile #-}+lazyTakeWhile _ Empty        = Empty+lazyTakeWhile f (Chunk x xs) = case takeWhile f x of                                  x' | x ≡ x'    → Chunk x' (takeWhile f xs)                                     | otherwise → Chunk x' Empty -    {-# INLINEABLE [2] dropWhile #-}-    dropWhile _ Empty        = Empty-    dropWhile f (Chunk x xs) = case dropWhile f x of+lazyDropWhile ∷ ( G.Bitstream (SB.Bitstream d)+                , G.Bitstream (Bitstream d)+                )+              ⇒ (Bool → Bool)+              → Bitstream d+              → Bitstream d+{-# INLINEABLE lazyDropWhile #-}+lazyDropWhile _ Empty        = Empty+lazyDropWhile f (Chunk x xs) = case dropWhile f x of                                  x' | null x'   → dropWhile f xs                                     | otherwise → Chunk x' xs -    {-# INLINEABLE [2] filter #-}-    filter _ Empty        = Empty-    filter f (Chunk x xs) = case filter f x of+lazyFilter ∷ ( G.Bitstream (SB.Bitstream d)+             , G.Bitstream (Bitstream d)+             )+           ⇒ (Bool → Bool)+           → Bitstream d+           → Bitstream d+{-# INLINEABLE lazyFilter #-}+lazyFilter _ Empty        = Empty+lazyFilter f (Chunk x xs) = case filter f x of                               x' | null x'   → filter f xs                                  | otherwise → Chunk x' (filter f xs) -lazyHead ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "head → lazyHead" [2]-    ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).+lazyHead ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool+{-# RULES "head → lazyHead" [1]+    ∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).     head v = lazyHead v #-} {-# INLINE lazyHead #-} lazyHead Empty       = emptyStream lazyHead (Chunk x _) = head x -lazyLast ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "last → lazyLast" [2]-    ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).+lazyLast ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool+{-# RULES "last → lazyLast" [1]+    ∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).     last v = lazyLast v #-} {-# INLINE lazyLast #-} lazyLast Empty           = emptyStream@@ -374,14 +557,14 @@ lazyLast (Chunk _ xs   ) = lazyLast xs  lazyNull ∷ Bitstream d → Bool-{-# RULES "null → lazyNull" [2] null = lazyNull #-}+{-# RULES "null → lazyNull" [1] null = lazyNull #-} {-# INLINE lazyNull #-} lazyNull Empty = True lazyNull _     = False -lazyLength ∷ (G.Bitstream (Packet d), Num n) ⇒ Bitstream d → n-{-# RULES "length → lazyLength" [2]-    ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).+lazyLength ∷ (G.Bitstream (SB.Bitstream d), Num n) ⇒ Bitstream d → n+{-# RULES "length → lazyLength" [1]+    ∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).     length v = lazyLength v #-} {-# INLINE lazyLength #-} lazyLength = go 0@@ -390,9 +573,9 @@       go !soFar Empty        = soFar       go !soFar (Chunk x xs) = go (soFar + length x) xs -lazyAnd ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "and → lazyAnd" [2]-    ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).+lazyAnd ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool+{-# RULES "and → lazyAnd" [1]+    ∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).     and v = lazyAnd v #-} {-# INLINEABLE lazyAnd #-} lazyAnd Empty        = False@@ -400,9 +583,9 @@     | and x          = lazyAnd xs     | otherwise      = False -lazyOr ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool-{-# RULES "or → lazyOr" [2]-    ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d).+lazyOr ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool+{-# RULES "or → lazyOr" [1]+    ∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).     or v = lazyOr v #-} {-# INLINEABLE lazyOr #-} lazyOr Empty        = True@@ -410,9 +593,14 @@     | or x          = True     | otherwise     = lazyOr xs -lazyIndex ∷ (G.Bitstream (Packet d), Integral n) ⇒ Bitstream d → n → Bool-{-# RULES "(!!) → lazyIndex" [2]-    ∀(v ∷ G.Bitstream (Packet d) ⇒ Bitstream d) n.+lazyIndex ∷ ( G.Bitstream (SB.Bitstream d)+            , Integral n+            )+          ⇒ Bitstream d+          → n+          → Bool+{-# RULES "(!!) → lazyIndex" [1]+    ∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d) n.     v !! n = lazyIndex v n #-} {-# INLINEABLE lazyIndex #-} lazyIndex ch0 i0@@ -435,7 +623,7 @@  -- | /O(n)/ Convert a list of chunks, strict 'SB.Bitstream's, into a -- lazy 'Bitstream'.-fromChunks ∷ G.Bitstream (Packet d) ⇒ [SB.Bitstream d] → Bitstream d+fromChunks ∷ G.Bitstream (SB.Bitstream d) ⇒ [SB.Bitstream d] → Bitstream d {-# INLINE fromChunks #-} fromChunks []     = Empty fromChunks (x:xs)@@ -450,7 +638,7 @@ toChunks (Chunk x xs) = x : toChunks xs  -- | /O(n)/ Convert a lazy 'LS.ByteString' into a lazy 'Bitstream'.-fromByteString ∷ G.Bitstream (Packet d) ⇒ LS.ByteString → Bitstream d+fromByteString ∷ G.Bitstream (SB.Bitstream d) ⇒ LS.ByteString → Bitstream d {-# INLINE fromByteString #-} fromByteString = fromChunks ∘ L.map SB.fromByteString ∘ LS.toChunks @@ -458,22 +646,32 @@ -- into a lazy 'LS.ByteString'. The resulting octets will be padded -- with zeroes if @bs@ is finite and its 'length' is not multiple of -- 8.-toByteString ∷ G.Bitstream (Packet d) ⇒ Bitstream d → LS.ByteString+toByteString ∷ ( G.Bitstream (SB.Bitstream d)+               , G.Bitstream (Packet d)+               )+             ⇒ Bitstream d+             → LS.ByteString {-# INLINE toByteString #-} toByteString = LS.fromChunks ∘ L.map SB.toByteString ∘ toChunks -streamChunks ∷ Monad m ⇒ Bitstream d → Stream m (SB.Bitstream d)-{-# INLINE [0] streamChunks #-}+streamChunks ∷ ( G.Bitstream (SB.Bitstream d)+               , Monad m+               )+             ⇒ Bitstream d+             → Stream m (SB.Bitstream d)+{-# NOINLINE streamChunks #-} streamChunks ch0 = Stream step ch0 Unknown     where       {-# INLINE step #-}       step Empty        = return Done       step (Chunk x xs) = return $ Yield x xs -unstreamChunks ∷ (G.Bitstream (Packet d), Monad m)+unstreamChunks ∷ ( G.Bitstream (SB.Bitstream d)+                 , Monad m+                 )                ⇒ Stream m (SB.Bitstream d)                → m (Bitstream d)-{-# INLINE [0] unstreamChunks #-}+{-# NOINLINE unstreamChunks #-} unstreamChunks (Stream step s0 _) = go s0     where       {-# INLINE go #-}@@ -495,26 +693,21 @@   #-}  -- Awful implementation to gain speed...-packChunks ∷ ∀m d. Monad m+packChunks ∷ ∀d m. (G.Bitstream (Packet d), Monad m)            ⇒ Stream m (Packet d)            → Stream m (SB.Bitstream d)-{-# INLINE packChunks #-}+{-# INLINEABLE packChunks #-} packChunks (Stream step s0 sz)-    = Stream step' (emptyChunk, 0, Just s0) sz'+    = Stream step' (emptyChunk, 0, 0, Just s0) sz'     where       emptyChunk ∷ New.New SV.Vector (Packet d)       {-# INLINE emptyChunk #-}       emptyChunk-          = New.create (MVector.new chunkSize)+          = New.create (MVector.unsafeNew chunkSize) -      newChunk ∷ New.New SV.Vector (Packet d)-               → Int-               → SB.Bitstream d-      {-# INLINE newChunk #-}-      newChunk ch len-          = SB.fromPackets-            $ GV.new-            $ New.apply (MVector.take len) ch+      singletonChunk ∷ Packet d → New.New SV.Vector (Packet d)+      {-# INLINE singletonChunk #-}+      singletonChunk = writePacket emptyChunk 0        writePacket ∷ New.New SV.Vector (Packet d)                   → Int@@ -524,33 +717,48 @@       writePacket ch len p           = New.modify (\mv → MVector.write mv len p) ch +      newChunk ∷ G.Bitstream (Packet d)+               ⇒ New.New SV.Vector (Packet d)+               → Int+               → Int+               → SB.Bitstream d+      {-# INLINE newChunk #-}+      newChunk ch cLen bLen+          = SB.unsafeFromPackets bLen+            $ GV.new+            $ New.apply (MVector.take cLen) ch+       sz' ∷ Size       {-# INLINE sz' #-}       sz' = case sz of-              Exact n → Exact (n + chunkSize - 1 `div` chunkSize)-              Max   n → Max   (n + chunkSize - 1 `div` chunkSize)+              Exact n → Exact ((n + chunkSize - 1) `div` chunkSize)+              Max   n → Max   ((n + chunkSize - 1) `div` chunkSize)               Unknown → Unknown        {-# INLINE step' #-}-      step' (ch, len, Just s)+      step' (ch, cLen, bLen, Just s)           = do r ← step s                case r of                  Yield p s'-                     | len ≡ chunkSize-                           → return $ Yield (newChunk ch len)-                                            (emptyChunk, 0, Just s')+                     | cLen ≡ chunkSize+                           → return $ Yield (newChunk ch cLen bLen)+                                            (singletonChunk p, 1, length p, Just s')                      | otherwise-                           → return $ Skip  (writePacket ch len p, len+1, Just s')-                 Skip s'   → return $ Skip  (ch             , len  , Just s')+                           → return $ Skip  (writePacket ch cLen p, cLen+1, bLen + length p, Just s')+                 Skip s'   → return $ Skip  (ch                   , cLen  , bLen           , Just s')                  Done-                     | len ≡ 0+                     | cLen ≡ 0                            → return Done                      | otherwise-                           → return $ Yield (newChunk ch len)-                                            ((⊥), (⊥), Nothing)-      step' (_, _, Nothing)+                           → return $ Yield (newChunk ch cLen bLen)+                                            ((⊥), (⊥), (⊥), Nothing)+      step' (_, _, _, Nothing)           = return Done +unpackChunks ∷ S.Stream (SB.Bitstream d) → S.Stream (Packet d)+{-# INLINE unpackChunks #-}+unpackChunks = S.concatMap SB.streamPackets+ -- | /O(n)/ Convert a @'Bitstream' 'Left'@ into a @'Bitstream' -- 'Right'@. Bit directions only affect octet-based operations such as -- 'toByteString'.@@ -600,25 +808,30 @@ repeat b = xs     where       xs = Chunk x xs-      x  = replicate (chunkBits ∷ Int) b+      x  = SB.fromPackets (SV.replicate chunkSize p)+      p  = pack (L.replicate 8 b)  -- | /O(n)/ 'cycle' ties a finite 'Bitstream' into a circular one, or -- equivalently, the infinite repetition of the original 'Bitstream'. -- It is the identity on infinite 'Bitstream's.-cycle ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bitstream d+cycle ∷ G.Bitstream (Bitstream d) ⇒ Bitstream d → Bitstream d {-# INLINE cycle #-} cycle Empty = emptyStream cycle ch    = ch ⧺ cycle ch  -- | /O(n)/ 'getContents' is equivalent to 'hGetContents' -- @stdin@. Will read /lazily/.-getContents ∷ G.Bitstream (Packet d) ⇒ IO (Bitstream d)+getContents ∷ G.Bitstream (SB.Bitstream d) ⇒ IO (Bitstream d) {-# INLINE getContents #-} getContents = fmap fromByteString LS.getContents  -- | /O(n)/ Write a 'Bitstream' to @stdout@, equivalent to 'hPut' -- @stdout@.-putBits ∷ G.Bitstream (Packet d) ⇒ Bitstream d → IO ()+putBits ∷ ( G.Bitstream (SB.Bitstream d)+          , G.Bitstream (Packet d)+          )+        ⇒ Bitstream d+        → IO () {-# INLINE putBits #-} putBits = LS.putStr ∘ toByteString @@ -626,7 +839,11 @@ -- -> 'Bitstream' d@ as its argument. The entire input from the stdin -- is lazily passed to this function as its argument, and the -- resulting 'Bitstream' is output on the stdout.-interact ∷ G.Bitstream (Packet d) ⇒ (Bitstream d → Bitstream d) → IO ()+interact ∷ ( G.Bitstream (SB.Bitstream d)+           , G.Bitstream (Packet d)+           )+         ⇒ (Bitstream d → Bitstream d)+         → IO () {-# INLINE interact #-} interact = LS.interact ∘ lift'     where@@ -634,17 +851,27 @@       lift' f = toByteString ∘ f ∘ fromByteString  -- | /O(n)/ Read an entire file lazily into a 'Bitstream'.-readFile ∷ G.Bitstream (Packet d) ⇒ FilePath → IO (Bitstream d)+readFile ∷ G.Bitstream (SB.Bitstream d) ⇒ FilePath → IO (Bitstream d) {-# INLINE readFile #-} readFile = fmap fromByteString ∘ LS.readFile  -- | /O(n)/ Write a 'Bitstream' to a file.-writeFile ∷ G.Bitstream (Packet d) ⇒ FilePath → Bitstream d → IO ()+writeFile ∷ ( G.Bitstream (SB.Bitstream d)+            , G.Bitstream (Packet d)+            )+          ⇒ FilePath+          → Bitstream d+          → IO () {-# INLINE writeFile #-} writeFile = (∘ toByteString) ∘ LS.writeFile  -- | /O(n)/ Append a 'Bitstream' to a file.-appendFile ∷ G.Bitstream (Packet d) ⇒ FilePath → Bitstream d → IO ()+appendFile ∷ ( G.Bitstream (SB.Bitstream d)+             , G.Bitstream (Packet d)+             )+           ⇒ FilePath+           → Bitstream d+           → IO () {-# INLINE appendFile #-} appendFile = (∘ toByteString) ∘ LS.appendFile @@ -653,7 +880,7 @@ -- size. -- -- Once EOF is encountered, the 'Handle' is closed.-hGetContents ∷ G.Bitstream (Packet d) ⇒ Handle → IO (Bitstream d)+hGetContents ∷ G.Bitstream (SB.Bitstream d) ⇒ Handle → IO (Bitstream d) {-# INLINE hGetContents #-} hGetContents = fmap fromByteString ∘ LS.hGetContents @@ -667,17 +894,27 @@ -- 'hGet' will behave as if EOF was reached. -- {-# INLINE hGet #-}-hGet ∷ G.Bitstream (Packet d) ⇒ Handle → Int → IO (Bitstream d)+hGet ∷ G.Bitstream (SB.Bitstream d) ⇒ Handle → Int → IO (Bitstream d) hGet = (fmap fromByteString ∘) ∘ LS.hGet  -- | /O(n)/ 'hGetNonBlocking' is similar to 'hGet', except that it -- will never block waiting for data to become available, instead it -- returns only whatever data is available. {-# INLINE hGetNonBlocking #-}-hGetNonBlocking ∷ G.Bitstream (Packet d) ⇒ Handle → Int → IO (Bitstream d)+hGetNonBlocking ∷ ( G.Bitstream (SB.Bitstream d)+                  , G.Bitstream (Packet d)+                  )+                ⇒ Handle+                → Int+                → IO (Bitstream d) hGetNonBlocking = (fmap fromByteString ∘) ∘ LS.hGetNonBlocking  -- | /O(n)/ Write a 'Bitstream' to the given 'Handle'.-hPut ∷ G.Bitstream (Packet d) ⇒ Handle → Bitstream d → IO ()+hPut ∷ ( G.Bitstream (SB.Bitstream d)+       , G.Bitstream (Packet d)+       )+     ⇒ Handle+     → Bitstream d+     → IO () {-# INLINE hPut #-} hPut = (∘ toByteString) ∘ LS.hPut

@@ -3,7 +3,6 @@   , EmptyDataDecls   , FlexibleContexts   , FlexibleInstances-  , RankNTypes   , UnicodeSyntax   #-} -- | For internal use only.@@ -45,6 +44,8 @@ -- --   * 10010100 => [False, False, True , False, True, False, False, True] --+-- 'Bits' operations (like 'toBits') treat a 'Left' bitstream as a+-- little-endian integer. data Left  -- | 'Right' bitstreams interpret an octet as a vector of bits whose@@ -54,6 +55,8 @@ -- --   * 10010100 => [True, False, False, True, False, True , False, False] --+-- 'Bits' operations (like 'toBits') treat a 'Right' bitstream as a+-- big-endian integer. data Right  -- | 'Packet's are strict 'Bitstream's having at most 8 bits.@@ -120,17 +123,18 @@           (oy `shiftR` (8-ny))  instance Bitstream (Packet Left) where-    {-# INLINE [0] stream #-}-    stream (Packet n o) = {-# CORE "Packet Left stream" #-}-                          Stream step 0 (Exact n)+    {-# INLINE basicStream #-}+    basicStream (Packet n o)+        = {-# CORE "Packet Left stream" #-}+          Stream step 0 (Exact n)         where           {-# INLINE step #-}           step !i               | i ≥ n     = return Done               | otherwise = return $! Yield (o `testBit` i) (i+1) -    {-# INLINE [0] unstream #-}-    unstream (Stream step s0 sz)+    {-# INLINE basicUnstream #-}+    basicUnstream (Stream step s0 sz)         = {-# CORE "Packet Left unstream" #-}           case upperBound sz of             Just n@@ -158,31 +162,31 @@                      Skip    s'      → safeConsume s' i o                      Done            → return $! Packet i o -    {-# INLINE [2] cons #-}-    cons b p+    {-# INLINE basicCons #-}+    basicCons b p         | full p    = packetOverflow         | otherwise = b `unsafeConsL` p -    {-# INLINE [2] snoc #-}-    snoc p b+    {-# INLINE basicSnoc #-}+    basicSnoc p b         | full p    = packetOverflow         | otherwise = p `unsafeSnocL` b -    {-# INLINE [2] append #-}-    append (Packet nx ox) (Packet ny oy)+    {-# INLINE basicAppend #-}+    basicAppend (Packet nx ox) (Packet ny oy)         | nx + ny > 8 = packetOverflow         | otherwise   = Packet (nx + ny) (ox .|. (oy `shiftL` nx)) -    {-# INLINE [2] tail #-}-    tail (Packet 0 _) = emptyNotAllowed-    tail (Packet n o) = Packet (n-1) (o `shiftR` 1)+    {-# INLINE basicTail #-}+    basicTail (Packet 0 _) = emptyNotAllowed+    basicTail (Packet n o) = Packet (n-1) (o `shiftR` 1) -    {-# INLINE [2] init #-}-    init (Packet 0 _) = emptyNotAllowed-    init (Packet n o) = Packet (n-1) o+    {-# INLINE basicInit #-}+    basicInit (Packet 0 _) = emptyNotAllowed+    basicInit (Packet n o) = Packet (n-1) o -    {-# INLINE [2] map #-}-    map f (Packet n o0) = Packet n (go 0 o0)+    {-# INLINE basicMap #-}+    basicMap f (Packet n o0) = Packet n (go 0 o0)         where           {-# INLINE go #-}           go i o@@ -190,21 +194,15 @@               | f (o `testBit` i) = go (i+1) (o `setBit`   i)               | otherwise         = go (i+1) (o `clearBit` i) -    {-# INLINE [2] reverse #-}-    reverse (Packet n o)+    {-# INLINE basicReverse #-}+    basicReverse (Packet n o)         = Packet n (reverseBits o `shiftR` (8-n)) -    {-# INLINE [1] scanl #-}-    scanl = scanlPacket--    {-# INLINE [2] replicate #-}-    replicate n b-        | n > 8     = packetOverflow-        | b         = Packet (fromIntegral n) (0xFF `shiftR` (8 - fromIntegral n))-        | otherwise = Packet (fromIntegral n) 0+    {-# INLINE basicScanl #-}+    basicScanl = scanlPacket -    {-# INLINE [2] take #-}-    take l (Packet n o)+    {-# INLINE basicTake #-}+    basicTake l (Packet n o)         | l ≤ 0      = (∅)         | otherwise             = let n' = fromIntegral (min (fromIntegral n) l)@@ -212,8 +210,8 @@               in                 Packet n' o' -    {-# INLINE [2] drop #-}-    drop l (Packet n o)+    {-# INLINE basicDrop #-}+    basicDrop l (Packet n o)         | l ≤ 0      = Packet n o         | otherwise             = let d  = fromIntegral (min (fromIntegral n) l)@@ -222,27 +220,43 @@               in                 Packet n' o' -    {-# INLINE [2] takeWhile #-}-    takeWhile = takeWhilePacket+    {-# INLINE basicTakeWhile #-}+    basicTakeWhile = takeWhilePacket -    {-# INLINE [2] dropWhile #-}-    dropWhile = dropWhilePacket+    {-# INLINE basicDropWhile #-}+    basicDropWhile = dropWhilePacket -    {-# INLINE [1] filter #-}-    filter = filterPacket+    {-# INLINE basicFilter #-}+    basicFilter = filterPacket +    {-# INLINEABLE basicFromNBits #-}+    basicFromNBits n β+        | n < 0     = (∅)+        | n > 8     = packetOverflow+        | n ≡ 8     = Packet (fromIntegral n) (fromIntegral β)+        | otherwise = let n' ∷ Int+                          n' = fromIntegral n+                          o  ∷ Word8+                          o  = fromIntegral (β .&. ((1 `shiftL` n') - 1))+                      in Packet n' o++    {-# INLINE basicToBits #-}+    basicToBits = fromIntegral ∘ toOctet++ instance Bitstream (Packet Right) where-    {-# INLINE [0] stream #-}-    stream (Packet n o) = {-# CORE "Packet Right stream" #-}-                          Stream step 0 (Exact n)+    {-# INLINE basicStream #-}+    basicStream (Packet n o)+        = {-# CORE "Packet Right stream" #-}+          Stream step 0 (Exact n)         where           {-# INLINE step #-}           step !i               | i ≥ n     = return Done               | otherwise = return $! Yield (o `testBit` (7-i)) (i+1) -    {-# INLINE [0] unstream #-}-    unstream (Stream step s0 sz)+    {-# INLINE basicUnstream #-}+    basicUnstream (Stream step s0 sz)         = {-# CORE "Packet Right unstream" #-}           case upperBound sz of             Just n@@ -270,31 +284,31 @@                      Skip    s'      → safeConsume s' i o                      Done            → return $! Packet i o -    {-# INLINE [2] cons #-}-    cons b p+    {-# INLINE basicCons #-}+    basicCons b p         | full p    = packetOverflow         | otherwise = b `unsafeConsR` p -    {-# INLINE [2] snoc #-}-    snoc p b+    {-# INLINE basicSnoc #-}+    basicSnoc p b         | full p    = packetOverflow         | otherwise = p `unsafeSnocR` b -    {-# INLINE [2] append #-}-    append (Packet nx ox) (Packet ny oy)+    {-# INLINE basicAppend #-}+    basicAppend (Packet nx ox) (Packet ny oy)         | nx + ny > 8 = packetOverflow         | otherwise   = Packet (nx + ny) (ox .|. (oy `shiftR` nx)) -    {-# INLINE [2] tail #-}-    tail (Packet 0 _) = emptyNotAllowed-    tail (Packet n o) = Packet (n-1) (o `shiftL` 1)+    {-# INLINE basicTail #-}+    basicTail (Packet 0 _) = emptyNotAllowed+    basicTail (Packet n o) = Packet (n-1) (o `shiftL` 1) -    {-# INLINE [2] init #-}-    init (Packet 0 _) = emptyNotAllowed-    init (Packet n o) = Packet (n-1) o+    {-# INLINE basicInit #-}+    basicInit (Packet 0 _) = emptyNotAllowed+    basicInit (Packet n o) = Packet (n-1) o -    {-# INLINE [2] map #-}-    map f (Packet n o0) = Packet n (go 0 o0)+    {-# INLINE basicMap #-}+    basicMap f (Packet n o0) = Packet n (go 0 o0)         where           {-# INLINE go #-}           go i o@@ -302,21 +316,15 @@               | f (o `testBit` (7-i)) = go (i+1) (o `setBit`   (7-i))               | otherwise             = go (i+1) (o `clearBit` (7-i)) -    {-# INLINE [2] reverse #-}-    reverse (Packet n o)+    {-# INLINE basicReverse #-}+    basicReverse (Packet n o)         = Packet n (reverseBits o `shiftL` (8-n)) -    {-# INLINE [1] scanl #-}-    scanl = scanlPacket--    {-# INLINE [2] replicate #-}-    replicate n b-        | n > 8     = packetOverflow-        | b         = Packet (fromIntegral n) (0xFF `shiftL` (8 - fromIntegral n))-        | otherwise = Packet (fromIntegral n) 0+    {-# INLINE basicScanl #-}+    basicScanl = scanlPacket -    {-# INLINE [2] take #-}-    take l (Packet n o)+    {-# INLINE basicTake #-}+    basicTake l (Packet n o)         | l ≤ 0      = (∅)         | otherwise             = let n' = fromIntegral (min (fromIntegral n) l)@@ -324,8 +332,8 @@               in                 Packet n' o' -    {-# INLINE [2] drop #-}-    drop l (Packet n o)+    {-# INLINE basicDrop #-}+    basicDrop l (Packet n o)         | l ≤ 0      = Packet n o         | otherwise             = let d  = fromIntegral (min (fromIntegral n) l)@@ -334,58 +342,76 @@               in                 Packet n' o' -    {-# INLINE [2] takeWhile #-}-    takeWhile = takeWhilePacket+    {-# INLINE basicTakeWhile #-}+    basicTakeWhile = takeWhilePacket -    {-# INLINE [2] dropWhile #-}-    dropWhile = dropWhilePacket+    {-# INLINE basicDropWhile #-}+    basicDropWhile = dropWhilePacket -    {-# INLINE [1] filter #-}-    filter = filterPacket+    {-# INLINE basicFilter #-}+    basicFilter = filterPacket +    {-# INLINEABLE basicFromNBits #-}+    basicFromNBits n β+        | n < 0     = (∅)+        | n > 8     = packetOverflow+        | n ≡ 8     = Packet (fromIntegral n) (fromIntegral β)+        | otherwise = let n' ∷ Int+                          n' = fromIntegral n+                          o  ∷ Word8+                          o  = fromIntegral ( (β .&. ((1 `shiftL` n') - 1))+                                              `shiftL`+                                              (8-n')+                                            )+                      in Packet n' o++    {-# INLINE basicToBits #-}+    basicToBits (Packet n o)+        = fromIntegral (o `shiftR` (8-n))+ packetHeadL ∷ Packet Left → Bool-{-# RULES "head → packetHeadL" [2] head = packetHeadL #-}+{-# RULES "head → packetHeadL" [1] head = packetHeadL #-} {-# INLINE packetHeadL #-} packetHeadL (Packet 0 _) = emptyNotAllowed packetHeadL (Packet _ o) = o `testBit` 0  packetHeadR ∷ Packet Right → Bool-{-# RULES "head → packetHeadR" [2] head = packetHeadR #-}+{-# RULES "head → packetHeadR" [1] head = packetHeadR #-} {-# INLINE packetHeadR #-} packetHeadR (Packet 0 _) = emptyNotAllowed packetHeadR (Packet _ o) = o `testBit` 7  packetLastL ∷ Packet Left → Bool-{-# RULES "last → packetLastL" [2] last = packetLastL #-}+{-# RULES "last → packetLastL" [1] last = packetLastL #-} {-# INLINE packetLastL #-} packetLastL (Packet 0 _) = emptyNotAllowed packetLastL (Packet n o) = o `testBit` (n-1)  packetLastR ∷ Packet Right → Bool-{-# RULES "head → packetLastR" [2] last = packetLastR #-}+{-# RULES "head → packetLastR" [1] last = packetLastR #-} {-# INLINE packetLastR #-} packetLastR (Packet 0 _) = emptyNotAllowed packetLastR (Packet n o) = o `testBit` (8-n)  packetAndL ∷ Packet Left → Bool-{-# RULES "and → packetAndL" [2] and = packetAndL #-}+{-# RULES "and → packetAndL" [1] and = packetAndL #-} {-# INLINE packetAndL #-} packetAndL (Packet n o) = (0xFF `shiftR` (8-n)) ≡ o  packetAndR ∷ Packet Right → Bool-{-# RULES "and → packetAndR" [2] and = packetAndR #-}+{-# RULES "and → packetAndR" [1] and = packetAndR #-} {-# INLINE packetAndR #-} packetAndR (Packet n o) = (0xFF `shiftL` (8-n)) ≡ o  packetIndexL ∷ Integral n ⇒ Packet Left → n → Bool-{-# RULES "(!!) → packetIndexL" [2] (!!) = packetIndexL #-}+{-# RULES "(!!) → packetIndexL" [1] (!!) = packetIndexL #-} {-# INLINE packetIndexL #-} packetIndexL p i     | i < 0 ∨ i ≥ length p = indexOutOfRange i     | otherwise            = unsafePacketIndexL p i  packetIndexR ∷ Integral n ⇒ Packet Right → n → Bool-{-# RULES "(!!) → packetIndexR" [2] (!!) = packetIndexR #-}+{-# RULES "(!!) → packetIndexR" [1] (!!) = packetIndexR #-} {-# INLINE packetIndexR #-} packetIndexR p i     | i < 0 ∨ i ≥ length p = indexOutOfRange i@@ -402,18 +428,18 @@     = o `testBit` (7 - fromIntegral i)  packetNull ∷ Packet d → Bool-{-# RULES "null → packetNull" [2] null = packetNull #-}+{-# RULES "null → packetNull" [1] null = packetNull #-} {-# INLINE packetNull #-} packetNull (Packet 0 _) = True packetNull _            = False  packetLength ∷ Num n ⇒ Packet d → n-{-# RULES "length → packetLength" [2] length = packetLength #-}+{-# RULES "length → packetLength" [1] length = packetLength #-} {-# INLINE packetLength #-} packetLength (Packet n _) = fromIntegral n  packetOr ∷ Packet d → Bool-{-# RULES "or → packetOr" [2] or = packetOr #-}+{-# RULES "or → packetOr" [1] or = packetOr #-} {-# INLINE packetOr #-} packetOr (Packet _ o) = o ≢ 0 

@@ -6,23 +6,21 @@         fusion. This is like @bytestring@ but stores bits instead of         bytes. -        NOTE: GHC 7.0.1 fails to fuse almost every cases of bitstream-        fusion, producing very large and not-so-fast object code. See:-        <http://hackage.haskell.org/trac/ghc/ticket/4397>--Version: 0.1+Version: 0.2 License: PublicDomain License-File: COPYING Author: PHO <pho at cielonegro dot org> Maintainer: PHO <pho at cielonegro dot org> Stability: experimental Homepage: http://cielonegro.org/Bitstream.html+Bug-Reports: http://static.cielonegro.org/ditz/bitstream/ Category: Data Tested-With: GHC == 7.0.1 Cabal-Version: >= 1.10 Build-Type: Simple Extra-Source-Files:     COPYING+    ChangeLog  Source-Repository head     Type: git