99d9ea06537ffcf9cbfd6e27b3b6773e4e25502c
[packages/containers.git] / Utils / Containers / Internal / BitQueue.hs
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE BangPatterns #-}
3
4 #include "containers.h"
5
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module : Utils.Containers.Internal.BitQueue
9 -- Copyright : (c) David Feuer 2016
10 -- License : BSD-style
11 -- Maintainer : libraries@haskell.org
12 -- Portability : portable
13 --
14 -- = WARNING
15 --
16 -- This module is considered __internal__.
17 --
18 -- The Package Versioning Policy __does not apply__.
19 --
20 -- The contents of this module may change __in any way whatsoever__
21 -- and __without any warning__ between minor versions of this package.
22 --
23 -- Authors importing this module are expected to track development
24 -- closely.
25 --
26 -- = Description
27 --
28 -- An extremely light-weight, fast, and limited representation of a string of
29 -- up to (2*WORDSIZE - 2) bits. In fact, there are two representations,
30 -- misleadingly named bit queue builder and bit queue. The builder supports
31 -- only `emptyQB`, creating an empty builder, and `snocQB`, enqueueing a bit.
32 -- The bit queue builder is then turned into a bit queue using `buildQ`, after
33 -- which bits can be removed one by one using `unconsQ`. If the size limit is
34 -- exceeded, further operations will silently produce nonsense.
35 -----------------------------------------------------------------------------
36
37 module Utils.Containers.Internal.BitQueue
38 ( BitQueue
39 , BitQueueB
40 , emptyQB
41 , snocQB
42 , buildQ
43 , unconsQ
44 , toListQ
45 ) where
46
47 #if !MIN_VERSION_base(4,8,0)
48 import Data.Word (Word)
49 #endif
50 import Utils.Containers.Internal.BitUtil (shiftLL, shiftRL, wordSize)
51 import Data.Bits ((.|.), (.&.), testBit)
52 #if MIN_VERSION_base(4,8,0)
53 import Data.Bits (countTrailingZeros)
54 #else
55 import Data.Bits (popCount)
56 #endif
57
58 #if !MIN_VERSION_base(4,8,0)
59 countTrailingZeros :: Word -> Int
60 countTrailingZeros x = popCount ((x .&. (-x)) - 1)
61 {-# INLINE countTrailingZeros #-}
62 #endif
63
64 -- A bit queue builder. We represent a double word using two words
65 -- because we don't currently have access to proper double words.
66 data BitQueueB = BQB {-# UNPACK #-} !Word
67 {-# UNPACK #-} !Word
68
69 newtype BitQueue = BQ BitQueueB deriving Show
70
71 -- Intended for debugging.
72 instance Show BitQueueB where
73 show (BQB hi lo) = "BQ"++
74 show (map (testBit hi) [(wordSize - 1),(wordSize - 2)..0]
75 ++ map (testBit lo) [(wordSize - 1),(wordSize - 2)..0])
76
77 -- | Create an empty bit queue builder. This is represented as a single guard
78 -- bit in the most significant position.
79 emptyQB :: BitQueueB
80 emptyQB = BQB (1 `shiftLL` (wordSize - 1)) 0
81 {-# INLINE emptyQB #-}
82
83 -- Shift the double word to the right by one bit.
84 shiftQBR1 :: BitQueueB -> BitQueueB
85 shiftQBR1 (BQB hi lo) = BQB hi' lo' where
86 lo' = (lo `shiftRL` 1) .|. (hi `shiftLL` (wordSize - 1))
87 hi' = hi `shiftRL` 1
88 {-# INLINE shiftQBR1 #-}
89
90 -- | Enqueue a bit. This works by shifting the queue right one bit,
91 -- then setting the most significant bit as requested.
92 {-# INLINE snocQB #-}
93 snocQB :: BitQueueB -> Bool -> BitQueueB
94 snocQB bq b = case shiftQBR1 bq of
95 BQB hi lo -> BQB (hi .|. (fromIntegral (fromEnum b) `shiftLL` (wordSize - 1))) lo
96
97 -- | Convert a bit queue builder to a bit queue. This shifts in a new
98 -- guard bit on the left, and shifts right until the old guard bit falls
99 -- off.
100 {-# INLINE buildQ #-}
101 buildQ :: BitQueueB -> BitQueue
102 buildQ (BQB hi 0) = BQ (BQB 0 lo') where
103 zeros = countTrailingZeros hi
104 lo' = ((hi `shiftRL` 1) .|. (1 `shiftLL` (wordSize - 1))) `shiftRL` zeros
105 buildQ (BQB hi lo) = BQ (BQB hi' lo') where
106 zeros = countTrailingZeros lo
107 lo1 = (lo `shiftRL` 1) .|. (hi `shiftLL` (wordSize - 1))
108 hi1 = (hi `shiftRL` 1) .|. (1 `shiftLL` (wordSize - 1))
109 lo' = (lo1 `shiftRL` zeros) .|. (hi1 `shiftLL` (wordSize - zeros))
110 hi' = hi1 `shiftRL` zeros
111
112 -- Test if the queue is empty, which occurs when theres
113 -- nothing left but a guard bit in the least significant
114 -- place.
115 nullQ :: BitQueue -> Bool
116 nullQ (BQ (BQB 0 1)) = True
117 nullQ _ = False
118 {-# INLINE nullQ #-}
119
120 -- | Dequeue an element, or discover the queue is empty.
121 unconsQ :: BitQueue -> Maybe (Bool, BitQueue)
122 unconsQ q | nullQ q = Nothing
123 unconsQ (BQ bq@(BQB _ lo)) = Just (hd, BQ tl)
124 where
125 !hd = (lo .&. 1) /= 0
126 !tl = shiftQBR1 bq
127 {-# INLINE unconsQ #-}
128
129 -- | Convert a bit queue to a list of bits by unconsing.
130 -- This is used to test that the queue functions properly.
131 toListQ :: BitQueue -> [Bool]
132 toListQ bq = case unconsQ bq of
133 Nothing -> []
134 Just (hd, tl) -> hd : toListQ tl