@@ -4,6 +4,7 @@
44-- |
55-- Module : Data.Binary.Bits.Get
66-- Copyright : (c) Lennart Kolmodin 2010-2011
7+-- (c) Sylvain Henry 2015
78-- License : BSD3-style (see LICENSE)
89--
910-- Maintainer : kolmodin@gmail.com
@@ -59,11 +60,19 @@ module Data.Binary.Bits.Get
5960
6061 -- ** Get bytes
6162 , getBool
63+ , getBool#
6264 , getWord8
65+ , getWord16
66+ , getWord32
67+ , getWord64
6368 , getWord16be
6469 , getWord32be
6570 , getWord64be
6671
72+ -- ** Skip bits
73+ , skipBits
74+ , alignByte
75+
6776 -- * Blocks
6877
6978 -- $blocks
@@ -73,6 +82,9 @@ module Data.Binary.Bits.Get
7382 -- ** Read in Blocks
7483 , bool
7584 , word8
85+ , word16
86+ , word32
87+ , word64
7688 , word16be
7789 , word32be
7890 , word64be
@@ -83,24 +95,28 @@ module Data.Binary.Bits.Get
8395
8496 ) where
8597
86−import Data.Binary.Get as B ( runGet, Get, getByteString, getLazyByteString, isEmpty )
98+import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
8799import Data.Binary.Get.Internal as B ( get, put, ensureN )
100+import Data.Binary.Bits.BitOrder
101+import Data.Binary.Bits.Internal
102+import Data.Binary.Bits.Alignment
88103
89104import Data.ByteString as B
90105import qualified Data.ByteString.Lazy as L
91106import Data.ByteString.Unsafe
107+import Foreign.Marshal.Alloc (mallocBytes)
108+import Foreign.Ptr
109+import Foreign.Storable (poke)
110+import System.IO.Unsafe (unsafePerformIO)
92111
93112import Data.Bits
94113import Data.Word
95114import Control.Applicative
115+import Control.Monad (when,foldM_)
96116
97117import Prelude as P
98−
99−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
100−import GHC.Base
101118import GHC.Word
102−#endif
103−
119+import GHC.Base (uncheckedShiftLWord8#, wordToWord8#, Int (..), andWord8#, Word8#, (-#), Int#, xorI#, eqWord8#, TYPE)
104120
105121-- $bitget
106122-- Parse bits using a monad.
@@ -149,191 +165,120 @@ import GHC.Word
149165-- @
150166
151167data S = S {-# UNPACK #-} !ByteString -- Input
152− {-# UNPACK #-} !Int -- Bit offset (0-7)
168+ {-# UNPACK #-} !Int -- Bit offset (0-7)
169+ !BitOrder -- Bit order
153170 deriving (Show)
154171
155−-- | A block that will be read with only one boundry check. Needs to know the
156−-- number of bits in advance.
157−data Block a = Block Int (S -> a)
158−
159−instance Functor Block where
160− fmap f (Block i p) = Block i (\s -> f (p s))
161−
162−instance Applicative Block where
163− pure a = Block 0 (\_ -> a)
164− (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
165− (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
166− (Block i p) <* (Block j _) = Block (i+j) p
167−
168−-- | Get a block. Will be read with one single boundry check, and
169−-- therefore requires a statically known number of bits.
170−-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
171−-- 'byteString' and 'Applicative'.
172−block :: Block a -> BitGet a
173−block (Block i p) = do
174− ensureBits i
175− s <- getState
176− putState $! (incS i s)
177− return $! p s
178−
172+-- | Increment the current bit offset
179173incS :: Int -> S -> S
180−incS o (S bs n) =
181− let !o' = (n+o)
182− !d = o' `shiftR` 3
183− !n' = o' .&. make_mask 3
184− in S (unsafeDrop d bs) n'
185−
186−-- | make_mask 3 = 00000111
187−make_mask :: (Bits a, Num a) => Int -> a
188−make_mask n = (1 `shiftL` fromIntegral n) - 1
189−{-# SPECIALIZE make_mask :: Int -> Int #-}
190−{-# SPECIALIZE make_mask :: Int -> Word #-}
191−{-# SPECIALIZE make_mask :: Int -> Word8 #-}
192−{-# SPECIALIZE make_mask :: Int -> Word16 #-}
193−{-# SPECIALIZE make_mask :: Int -> Word32 #-}
194−{-# SPECIALIZE make_mask :: Int -> Word64 #-}
195−
196−bit_offset :: Int -> Int
197−bit_offset n = make_mask 3 .&. n
198−
199−byte_offset :: Int -> Int
200−byte_offset n = n `shiftR` 3
174+incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
175+ where
176+ !o' = (n+o)
177+ !d = byte_offset o'
178+ !n' = bit_offset o'
201179
180+-- | Read a single bit
202181readBool :: S -> Bool
203−readBool (S bs n) = testBit (unsafeHead bs) (7-n)
204−
205−{-# INLINE readWord8 #-}
206−readWord8 :: Int -> S -> Word8
207−readWord8 n (S bs o)
208− -- no bits at all, return 0
209− | n == 0 = 0
210−
211− -- all bits are in the same byte
212− -- we just need to shift and mask them right
213− | n <= 8 - o = let w = unsafeHead bs
214− m = make_mask n
215− w' = (w `shiftr_w8` (8 - o - n)) .&. m
216− in w'
217−
218− -- the bits are in two different bytes
219− -- make a word16 using both bytes, and then shift and mask
220− | n <= 8 = let w = (fromIntegral (unsafeHead bs) `shiftl_w16` 8) .|.
221− (fromIntegral (unsafeIndex bs 1))
222− m = make_mask n
223− w' = (w `shiftr_w16` (16 - o - n)) .&. m
224− in fromIntegral w'
225−
226−{-# INLINE readWord16be #-}
227−readWord16be :: Int -> S -> Word16
228−readWord16be n s@(S bs o)
229−
230− -- 8 or fewer bits, use readWord8
231− | n <= 8 = fromIntegral (readWord8 n s)
232−
233− -- handle 9 or more bits, stored in two bytes
234−
235− -- no offset, plain and simple 16 bytes
236− | o == 0 && n == 16 = let msb = fromIntegral (unsafeHead bs)
237− lsb = fromIntegral (unsafeIndex bs 1)
238− w = (msb `shiftl_w16` 8) .|. lsb
239− in w
240−
241− -- no offset, but not full 16 bytes
242− | o == 0 = let msb = fromIntegral (unsafeHead bs)
243− lsb = fromIntegral (unsafeIndex bs 1)
244− w = (msb `shiftl_w16` (n-8)) .|. (lsb `shiftr_w16` (16-n))
245− in w
246−
247− -- with offset, and n=9-16
248− | n <= 16 = readWithOffset s shiftl_w16 shiftr_w16 n
249−
250− | otherwise = error "readWord16be: tried to read more than 16 bits"
251−
252−{-# INLINE readWord32be #-}
253−readWord32be :: Int -> S -> Word32
254−readWord32be n s@(S _ o)
255− -- 8 or fewer bits, use readWord8
256− | n <= 8 = fromIntegral (readWord8 n s)
257−
258− -- 16 or fewer bits, use readWord16be
259− | n <= 16 = fromIntegral (readWord16be n s)
260−
261− | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
262−
263− | n <= 32 = readWithOffset s shiftl_w32 shiftr_w32 n
264−
265− | otherwise = error "readWord32be: tried to read more than 32 bits"
266−
267−
268−{-# INLINE readWord64be #-}
269−readWord64be :: Int -> S -> Word64
270−readWord64be n s@(S _ o)
271− -- 8 or fewer bits, use readWord8
272− | n <= 8 = fromIntegral (readWord8 n s)
273−
274− -- 16 or fewer bits, use readWord16be
275− | n <= 16 = fromIntegral (readWord16be n s)
276−
277− | o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
278−
279− | n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
280−
281− | otherwise = error "readWord64be: tried to read more than 64 bits"
282−
283−
182+readBool (S bs o bo) = case bo of
183+ BB -> testBit (unsafeHead bs) (7-o)
184+ BL -> testBit (unsafeHead bs) (7-o)
185+ LL -> testBit (unsafeHead bs) o
186+ LB -> testBit (unsafeHead bs) o
187+
188+-- | Read a single bit
189+readBool# :: S -> Int
190+readBool# (S bs (I# o) bo) = case bo of
191+ BB -> testBit# (7# -# o)
192+ BL -> testBit# (7# -# o)
193+ LL -> testBit# o
194+ LB -> testBit# o
195+ where
196+ !(W8# w) = unsafeHead bs
197+ testBit# n = I# (((w `andWord8#` (wordToWord8# 1## `uncheckedShiftLWord8#` n)) `eqWord8#` wordToWord8# 0##) `xorI#` 1#)
198+
199+
200+-- | Extract a range of bits from (ws :: ByteString)
201+--
202+-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
203+extract :: (Num a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
204+extract bo bs o n
205+ | n == 0 = 0
206+ | B.length bs == 0 = error "Empty ByteString"
207+ | otherwise = rev . mask n . foldlWithIndex' f 0 $ bs
208+ where
209+ -- B.foldl' with index
210+ foldlWithIndex' op b = fst . B.foldl' g (b,0)
211+ where g (b',i) w = (op b' w i, (i+1))
212+
213+ -- 'or' correctly shifted words
214+ f b w i = b .|. (fromIntegral w `fastShift` off i)
215+
216+ -- co-offset
217+ r = B.length bs * 8 - (o + n)
218+
219+ -- shift offset depending on the byte position (0..B.length-1)
220+ off i = case bo of
221+ LL -> 8*i - o
222+ LB -> 8*i - o
223+ BB -> (B.length bs -1 - i) * 8 - r
224+ BL -> (B.length bs -1 - i) * 8 - r
225+
226+ -- reverse bits if necessary
227+ rev = case bo of
228+ LB -> reverseBits n
229+ BL -> reverseBits n
230+ BB -> id
231+ LL -> id
232+
233+
234+-- | Generic readWord
235+readWord :: (Num a, FastBits a) => Int -> S -> a
236+readWord n (S bs o bo)
237+ | n == 0 = 0
238+ | otherwise = extract bo (unsafeTake nbytes bs) o n
239+ where nbytes = byte_offset (o+n+7)
240+
241+-- | Check that the number of bits to read is not greater than the first parameter
242+{-# INLINE readWordChecked #-}
243+readWordChecked :: (Num a, FastBits a) => Int -> Int -> S -> a
244+readWordChecked m n s
245+ | n > m = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
246+ | otherwise = readWord n s
247+
248+-- | Read the given number of bytes and return them in Big-Endian order
249+--
250+-- Examples:
251+-- BB: xxxABCDE FGHIJKLM NOPxxxxx -> ABCDEFGH IJKLMNOP
252+-- LL: LMNOPxxx DEFGHIJK xxxxxABC -> ABCDEFGH IJKLMNOP
253+-- BL: xxxPONML KJIHGFED CBAxxxxx -> ABCDEFGH IJKLMNOP
254+-- LB: EDCBAxxx MLKJIHGF xxxxxPON -> ABCDEFGH IJKLMNOP
284255readByteString :: Int -> S -> ByteString
285−readByteString n s@(S bs o)
286− -- no offset, easy.
287− | o == 0 = unsafeTake n bs
288− -- offset. ugg. this is really naive and slow. but also pretty easy :)
289− | otherwise = B.pack (P.map (readWord8 8) (P.take n (iterate (incS 8) s)))
290−
291−readWithoutOffset :: (Bits a, Num a)
292− => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
293−readWithoutOffset (S bs o) shifterL shifterR n
294− | o /= 0 = error "readWithoutOffset: there is an offset"
295−
296− | bit_offset n == 0 && byte_offset n <= 4 =
297− let segs = byte_offset n
298− bn 0 = fromIntegral (unsafeHead bs)
299− bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
300−
301− in bn (segs-1)
302−
303− | n <= 64 = let segs = byte_offset n
304− o' = bit_offset (n - 8 + o)
305−
306− bn 0 = fromIntegral (unsafeHead bs)
307− bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
308−
309− msegs = bn (segs-1) `shifterL` o'
310−
311− last = (fromIntegral (unsafeIndex bs segs)) `shifterR` (8 - o')
256+readByteString n (S bs o bo) =
257+ let
258+ bs' = unsafeTake (n+1) bs
259+ bs'' = unsafeTake n bs
260+ rev = B.map (reverseBits 8)
261+ in case (o,bo) of
262+ (0,BB) -> bs''
263+ (0,LL) -> B.reverse bs''
264+ (0,LB) -> rev bs''
265+ (0,BL) -> rev . B.reverse $ bs''
266+ (_,LL) -> readByteString n (S (B.reverse bs') (8-o) BB)
267+ (_,BL) -> rev . B.reverse $ readByteString n (S bs' o BB)
268+ (_,LB) -> rev . B.reverse $ readByteString n (S bs' o LL)
269+ (_,BB) -> unsafePerformIO $ do
270+ let len = n+1
271+ ptr <- mallocBytes len
272+ let f r i = do
273+ let
274+ w = unsafeIndex bs (len-i)
275+ w' = (w `fastShiftL` o) .|. r
276+ r' = w `fastShiftR` (8-o)
277+ poke (ptr `plusPtr` (len-i)) w'
278+ return r'
279+ foldM_ f 0 [1..len]
280+ unsafeInit <$> unsafePackMallocCStringLen (ptr,len)
312281
313− w = msegs .|. last
314− in w
315−
316−readWithOffset :: (Bits a, Num a)
317− => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
318−readWithOffset (S bs o) shifterL shifterR n
319− | n <= 64 = let bits_in_msb = 8 - o
320− (n',top) = (n - bits_in_msb
321− , (fromIntegral (unsafeHead bs) .&. make_mask bits_in_msb) `shifterL` n')
322−
323− segs = byte_offset n'
324−
325− bn 0 = 0
326− bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
327−
328− o' = bit_offset n'
329−
330− mseg = bn segs `shifterL` o'
331−
332− last | o' > 0 = (fromIntegral (unsafeIndex bs (segs + 1))) `shifterR` (8 - o')
333− | otherwise = 0
334−
335− w = top .|. mseg .|. last
336− in w
337282
338283------------------------------------------------------------------------
339284-- | 'BitGet' is a monad, applicative and a functor. See 'runBitGet'
@@ -342,7 +287,6 @@ newtype BitGet a = B { runState :: S -> Get (S,a) }
342287
343288instance Monad BitGet where
344289 return x = B $ \s -> return (s,x)
345− fail str = B $ \(S inp n) -> putBackState inp n >> fail str
346290 (B f) >>= g = B $ \s -> do (s',a) <- f s
347291 runState (g a) s'
348292
@@ -353,25 +297,51 @@ instance Applicative BitGet where
353297 pure x = return x
354298 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
355299
300+instance BitOrderable BitGet where
301+ setBitOrder bo = do
302+ (S bs o _) <- getState
303+ putState (S bs o bo)
304+
305+ getBitOrder = do
306+ (S _ _ bo) <- getState
307+ return bo
308+
309+instance Alignable BitGet where
310+ -- | Skip the given number of bits
311+ skipBits n = do
312+ ensureBits n
313+ withState (incS n)
314+
315+ -- | Skip bits if necessary to align to the next byte
316+ alignByte = do
317+ (S _ o _) <- getState
318+ when (o /= 0) $
319+ skipBits (8-o)
320+
321+
322+
356323-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
357324-- been partially consumed it will be discarded once 'runBitGet' is finished.
358325runBitGet :: BitGet a -> Get a
359326runBitGet bg = do
360327 s <- mkInitState
361− ((S str' n),a) <- runState bg s
362− putBackState str' n
328+ (s',a) <- runState bg s
329+ putBackState s'
363330 return a
364331
365332mkInitState :: Get S
366333mkInitState = do
367− str <- get
334+ bs <- get
368335 put B.empty
369− return (S str 0)
336+ return (S bs 0 BB)
370337
371−putBackState :: B.ByteString -> Int -> Get ()
372−putBackState bs n = do
338+putBackState :: S -> Get ()
339+putBackState (S bs o _) = do
373340 remaining <- get
374− put (B.drop (if n==0 then 0 else 1) bs `B.append` remaining)
341+ let bs' = case o of
342+ 0 -> bs
343+ _ -> unsafeDrop 1 bs
344+ put (bs' `B.append` remaining)
375345
376346getState :: BitGet S
377347getState = B $ \s -> return (s,s)
@@ -379,38 +349,66 @@ getState = B $ \s -> return (s,s)
379349putState :: S -> BitGet ()
380350putState s = B $ \_ -> return (s,())
381351
352+withState :: (S -> S) -> BitGet ()
353+withState f = do
354+ s <- getState
355+ putState $! f s
356+
382357-- | Make sure there are at least @n@ bits.
383358ensureBits :: Int -> BitGet ()
384359ensureBits n = do
385− (S bs o) <- getState
360+ (S bs o bo) <- getState
386361 if n <= (B.length bs * 8 - o)
387362 then return ()
388363 else do let currentBits = B.length bs * 8 - o
389− let byteCount = (n - currentBits + 7) `div` 8
364+ let byteCount = byte_offset (n - currentBits + 7)
390365 B $ \_ -> do B.ensureN byteCount
391366 bs' <- B.get
392367 put B.empty
393− return (S (bs`append`bs') o, ())
368+ return (S (bs`append`bs') o bo, ())
369+
370+-- | Test whether all input has been consumed, i.e. there are no remaining
371+-- undecoded bytes.
372+isEmpty :: BitGet Bool
373+isEmpty = B $ \ (S bs o bo) -> if B.null bs
374+ then B.isEmpty >>= \e -> return (S bs o bo, e)
375+ else return (S bs o bo, False)
394376
395377-- | Get 1 bit as a 'Bool'.
396378getBool :: BitGet Bool
397379getBool = block bool
398380
381+-- | Get 1 bit as a 'Bool'.
382+getBool# :: BitGet Int
383+getBool# = block bool#
384+
399385-- | Get @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
400386getWord8 :: Int -> BitGet Word8
401387getWord8 n = block (word8 n)
402388
403389-- | Get @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
390+getWord16 :: Int -> BitGet Word16
391+getWord16 n = block (word16 n)
392+
404393getWord16be :: Int -> BitGet Word16
405−getWord16be n = block (word16be n)
394+getWord16be = getWord16
395+{-# DEPRECATED getWord16be "Use 'getWord16' instead" #-}
406396
407397-- | Get @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
398+getWord32 :: Int -> BitGet Word32
399+getWord32 n = block (word32 n)
400+
408401getWord32be :: Int -> BitGet Word32
409−getWord32be n = block (word32be n)
402+getWord32be = getWord32
403+{-# DEPRECATED getWord32be "Use 'getWord32' instead" #-}
410404
411405-- | Get @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
406+getWord64 :: Int -> BitGet Word64
407+getWord64 n = block (word64 n)
408+
412409getWord64be :: Int -> BitGet Word64
413−getWord64be n = block (word64be n)
410+getWord64be = getWord64
411+{-# DEPRECATED getWord64be "Use 'getWord64' instead" #-}
414412
415413-- | Get @n@ bytes as a 'ByteString'.
416414getByteString :: Int -> BitGet ByteString
@@ -419,86 +417,80 @@ getByteString n = block (byteString n)
419417-- | Get @n@ bytes as a lazy ByteString.
420418getLazyByteString :: Int -> BitGet L.ByteString
421419getLazyByteString n = do
422− (S _ o) <- getState
420+ (S _ o bo) <- getState
423421 case o of
424− 0 -> B $ \ (S bs o') -> do
425− putBackState bs o'
422+ 0 -> B $ \s -> do
423+ putBackState s
426424 lbs <- B.getLazyByteString (fromIntegral n)
427− return (S B.empty 0, lbs)
425+ return (S B.empty 0 bo, lbs)
428426 _ -> L.fromChunks . (:[]) <$> Data.Binary.Bits.Get.getByteString n
429427
430−-- | Test whether all input has been consumed, i.e. there are no remaining
431−-- undecoded bytes.
432−isEmpty :: BitGet Bool
433−isEmpty = B $ \ (S bs o) -> B.isEmpty >>= \e -> return (S bs o, e)
428+
429+
430+
431+
432+-- | A block that will be read with only one boundary check. Needs to know the
433+-- number of bits in advance.
434+data Block a = Block Int (S -> a)
435+
436+instance Functor Block where
437+ fmap f (Block i p) = Block i (\s -> f (p s))
438+
439+instance Applicative Block where
440+ pure a = Block 0 (\_ -> a)
441+ (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
442+ (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
443+ (Block i p) <* (Block j _) = Block (i+j) p
444+
445+-- | Get a block. Will be read with one single boundry check, and
446+-- therefore requires a statically known number of bits.
447+-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
448+-- 'byteString' and 'Applicative'.
449+block :: Block a -> BitGet a
450+block (Block i p) = do
451+ ensureBits i
452+ s <- getState
453+ putState $! (incS i s)
454+ return $! p s
434455
435456-- | Read a 1 bit 'Bool'.
436457bool :: Block Bool
437458bool = Block 1 readBool
438459
460+-- | Read a 1 bit 'Bool'.
461+bool# :: Block Int
462+bool# = Block 1 readBool#
463+
439464-- | Read @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
440465word8 :: Int -> Block Word8
441−word8 n = Block n (readWord8 n)
466+word8 n = Block n (readWordChecked 8 n)
442467
443468-- | Read @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
469+word16 :: Int -> Block Word16
470+word16 n = Block n (readWordChecked 16 n)
471+
444472word16be :: Int -> Block Word16
445−word16be n = Block n (readWord16be n)
473+word16be = word16
474+{-# DEPRECATED word16be "Use 'word16' instead" #-}
446475
447476-- | Read @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
477+word32 :: Int -> Block Word32
478+word32 n = Block n (readWordChecked 32 n)
479+
448480word32be :: Int -> Block Word32
449−word32be n = Block n (readWord32be n)
481+word32be = word32
482+{-# DEPRECATED word32be "Use 'word32' instead" #-}
450483
451484-- | Read @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
485+word64 :: Int -> Block Word64
486+word64 n = Block n (readWordChecked 64 n)
487+
452488word64be :: Int -> Block Word64
453−word64be n = Block n (readWord64be n)
489+word64be = word64
490+{-# DEPRECATED word64be "Use 'word64' instead" #-}
454491
455492-- | Read @n@ bytes as a 'ByteString'.
456493byteString :: Int -> Block ByteString
457494byteString n | n > 0 = Block (n*8) (readByteString n)
458495 | otherwise = Block 0 (\_ -> B.empty)
459496
460−------------------------------------------------------------------------
461−-- Unchecked shifts, from the package binary
462−
463−shiftl_w16 :: Word16 -> Int -> Word16
464−shiftl_w32 :: Word32 -> Int -> Word32
465−shiftl_w64 :: Word64 -> Int -> Word64
466−
467−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
468−shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
469−shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
470−shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
471−
472−shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
473−shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
474−shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
475−
476−
477−#if WORD_SIZE_IN_BITS < 64
478−shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)
479−shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
480−
481−#if __GLASGOW_HASKELL__ <= 606
482−-- Exported by GHC.Word in GHC 6.8 and higher
483−foreign import ccall unsafe "stg_uncheckedShiftL64"
484− uncheckedShiftL64# :: Word64# -> Int# -> Word64#
485−foreign import ccall unsafe "stg_uncheckedShiftRL64"
486− uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
487−#endif
488−
489−#else
490−shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
491−shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
492−#endif
493−
494−#else
495−shiftl_w8 = shiftL
496−shiftl_w16 = shiftL
497−shiftl_w32 = shiftL
498−shiftl_w64 = shiftL
499−
500−shiftr_w8 = shiftR
501−shiftr_w16 = shiftR
502−shiftr_w32 = shiftR
503−shiftr_w64 = shiftR
504−#endif