@@ -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,7 +60,11 @@ 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
@@ -77,6 +82,9 @@ module Data.Binary.Bits.Get
7782 -- ** Read in Blocks
7883 , bool
7984 , word8
85+ , word16
86+ , word32
87+ , word64
8088 , word16be
8189 , word32be
8290 , word64be
@@ -89,6 +97,9 @@ module Data.Binary.Bits.Get
8997
9098import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
9199import 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
92103
93104import Data.ByteString as B
94105import qualified Data.ByteString.Lazy as L
@@ -104,12 +115,8 @@ import Control.Applicative
104115import Control.Monad (when,foldM_)
105116
106117import Prelude as P
107−
108−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
109−import GHC.Base
110118import GHC.Word
111−#endif
112−
119+import GHC.Base (uncheckedShiftLWord8#, wordToWord8#, Int (..), andWord8#, Word8#, (-#), Int#, xorI#, eqWord8#, TYPE)
113120
114121-- $bitget
115122-- Parse bits using a monad.
@@ -158,197 +165,120 @@ import GHC.Word
158165-- @
159166
160167data S = S {-# UNPACK #-} !ByteString -- Input
161− {-# UNPACK #-} !Int -- Bit offset (0-7)
168+ {-# UNPACK #-} !Int -- Bit offset (0-7)
169+ !BitOrder -- Bit order
162170 deriving (Show)
163171
164−-- | A block that will be read with only one boundary check. Needs to know the
165−-- number of bits in advance.
166−data Block a = Block Int (S -> a)
167−
168−instance Functor Block where
169− fmap f (Block i p) = Block i (\s -> f (p s))
170−
171−instance Applicative Block where
172− pure a = Block 0 (\_ -> a)
173− (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
174− (Block i _) *> (Block j q) = Block (i+j) (q . incS i)
175− (Block i p) <* (Block j _) = Block (i+j) p
176−
177−-- | Get a block. Will be read with one single boundry check, and
178−-- therefore requires a statically known number of bits.
179−-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
180−-- 'byteString' and 'Applicative'.
181−block :: Block a -> BitGet a
182−block (Block i p) = do
183− ensureBits i
184− s <- getState
185− putState $! (incS i s)
186− return $! p s
187−
188−-- | Compute bit offset (equivalent to x `mod` 8 but faster)
189−bit_offset :: Int -> Int
190−bit_offset n = make_mask 3 .&. n
191−{-# INLINE bit_offset #-}
192−
193−-- | Compute byte offset (equivalent to x `div` 8 but faster)
194−byte_offset :: Int -> Int
195−byte_offset n = n `shiftR` 3
196−{-# INLINE byte_offset #-}
197−
198172-- | Increment the current bit offset
199173incS :: Int -> S -> S
200−incS o (S bs n) = S (unsafeDrop d bs) n'
174+incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
201175 where
202176 !o' = (n+o)
203177 !d = byte_offset o'
204178 !n' = bit_offset o'
205179
206−-- | make_mask 3 = 00000111
207−make_mask :: (Bits a, Num a) => Int -> a
208−make_mask n = (1 `shiftL` fromIntegral n) - 1
209−{-# SPECIALIZE make_mask :: Int -> Int #-}
210−{-# SPECIALIZE make_mask :: Int -> Word #-}
211−{-# SPECIALIZE make_mask :: Int -> Word8 #-}
212−{-# SPECIALIZE make_mask :: Int -> Word16 #-}
213−{-# SPECIALIZE make_mask :: Int -> Word32 #-}
214−{-# SPECIALIZE make_mask :: Int -> Word64 #-}
215−
216−-- | Keep only the n least-significant bits of the given value
217−mask :: (Bits a, Num a) => Int -> a -> a
218−mask n v = v .&. make_mask n
219−{-# INLINE mask #-}
220−
221−class FastBits a where
222− fastShiftR :: a -> Int -> a
223− fastShiftL :: a -> Int -> a
224−
225− {-# INLINE fastShift #-}
226− fastShift :: a -> Int -> a
227− fastShift x n
228− | n > 0 = fastShiftL x n
229− | n < 0 = fastShiftR x (negate n)
230− | otherwise = x
231−
232−instance FastBits Word8 where
233− fastShiftR = shiftr_w8
234− fastShiftL = shiftl_w8
235−
236−instance FastBits Word16 where
237− fastShiftR = shiftr_w16
238− fastShiftL = shiftl_w16
239−
240−instance FastBits Word32 where
241− fastShiftR = shiftr_w32
242− fastShiftL = shiftl_w32
243−
244−instance FastBits Word64 where
245− fastShiftR = shiftr_w64
246− fastShiftL = shiftl_w64
247−
248−-- | Bit order
249−--
250−-- E.g. two words of 5 bits: ABCDE, VWXYZ
251−-- - BB: ABCDEVWX YZxxxxxx
252−-- - LB: XYZABCDE xxxxxxVW
253−-- - BL: EDCBAZYX WVxxxxxx -- not implemented
254−-- - LL: XWVEDCBA xxxxxxZY -- not implemented
255−data BitOrder = BB | LB
256−
180+-- | Read a single bit
181+readBool :: S -> Bool
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
257187
258188-- | Read a single bit
259−readBool :: BitOrder -> S -> Bool
260−readBool BB (S bs n) = testBit (unsafeHead bs) (7-n)
261−readBool LB (S bs n) = testBit (unsafeHead bs) n
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+
262199
263200-- | Extract a range of bits from (ws :: ByteString)
264201--
265202-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
266−extract :: (Num a, Bits a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
203+extract :: (Num a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
267204extract bo bs o n
268205 | n == 0 = 0
269206 | B.length bs == 0 = error "Empty ByteString"
270− | otherwise = mask n (foldlWithIndex' f 0 bs)
207+ | otherwise = rev . mask n . foldlWithIndex' f 0 $ bs
271208 where
272− -- foldl' with index
273− foldlWithIndex' f b = fst . B.foldl' g (b,0)
274− where g (b,i) w = (f b w i, (i+1))
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))
275212
276213 -- 'or' correctly shifted words
277− f b w i = b .|. (fromIntegral w `fastShift` off i)
214+ f b w i = b .|. (fromIntegral w `fastShift` off i)
278215
279216 -- co-offset
280− r = B.length bs * 8 - (o + n)
217+ r = B.length bs * 8 - (o + n)
281218
282219 -- shift offset depending on the byte position (0..B.length-1)
283− off i = case bo of
220+ off i = case bo of
221+ LL -> 8*i - o
284222 LB -> 8*i - o
285223 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
286232
287233
288234-- | Generic readWord
289−readWord :: (Num a, Bits a, FastBits a) => BitOrder -> Int -> S -> a
290−readWord bo n (S bs o)
235+readWord :: (Num a, FastBits a) => Int -> S -> a
236+readWord n (S bs o bo)
291237 | n == 0 = 0
292− | o+n <= 8 = extract bo (unsafeTake 1 bs) o n
293− | o+n <= 16 = extract bo (unsafeTake 2 bs) o n
294− | o+n <= 24 = extract bo (unsafeTake 3 bs) o n
295− | o+n <= 32 = extract bo (unsafeTake 4 bs) o n
296− | o+n <= 40 = extract bo (unsafeTake 5 bs) o n
297− | o+n <= 48 = extract bo (unsafeTake 6 bs) o n
298− | o+n <= 56 = extract bo (unsafeTake 7 bs) o n
299− | o+n <= 64 = extract bo (unsafeTake 8 bs) o n
300− | otherwise = extract bo (unsafeTake ((o+n+7) `div` 8) bs) o n
301−
302−readWordChecked :: (Num a, Bits a, FastBits a) => Int -> BitOrder -> Int -> S -> a
303−readWordChecked m bo n s
304− | n > m = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
305− | otherwise = readWord bo n s
306−
307−{-# INLINE readWord8 #-}
308−readWord8 :: BitOrder -> Int -> S -> Word8
309−readWord8 = readWordChecked 8
238+ | otherwise = extract bo (unsafeTake nbytes bs) o n
239+ where nbytes = byte_offset (o+n+7)
310240
311−{-# INLINE readWord16 #-}
312−readWord16 :: BitOrder -> Int -> S -> Word16
313−readWord16 = readWordChecked 16
314−
315−{-# INLINE readWord32 #-}
316−readWord32 :: BitOrder -> Int -> S -> Word32
317−readWord32 = readWordChecked 32
318−
319−{-# INLINE readWord64 #-}
320−readWord64 :: BitOrder -> Int -> S -> Word64
321−readWord64 = readWordChecked 64
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
322247
323248-- | Read the given number of bytes and return them in Big-Endian order
324−readByteString :: BitOrder -> Int -> S -> ByteString
325−readByteString bo n (S bs o)
326− | o == 0 = unsafeTake n bs
327− | otherwise = unsafePerformIO $ do
328− let len = n+1
329− ptr <- mallocBytes len
330− case bo of
331− BB -> do
332− let f r i = do
333− let
334− w = unsafeIndex bs (len-i)
335− w' = (w `fastShiftL` o) .|. r
336− r' = w `fastShiftR` (8-o)
337− poke (ptr `plusPtr` (len-i)) w'
338− return r'
339− foldM_ f 0 [1..len]
340− unsafeInit <$> unsafePackMallocCStringLen (ptr,len)
341−
342− LB -> do
343− let f r i = do
344− let
345− w = unsafeIndex bs (i-1)
346− w' = (w `fastShiftL` (8-o)) .|. r
347− r' = w `fastShiftR` o
348− poke (ptr `plusPtr` (len-i)) w'
349− return r'
350− foldM_ f 0 [1..len]
351− unsafeTail <$> unsafePackMallocCStringLen (ptr,len)
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
255+readByteString :: Int -> S -> ByteString
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)
281+
352282
353283------------------------------------------------------------------------
354284-- | 'BitGet' is a monad, applicative and a functor. See 'runBitGet'
@@ -357,7 +287,6 @@ newtype BitGet a = B { runState :: S -> Get (S,a) }
357287
358288instance Monad BitGet where
359289 return x = B $ \s -> return (s,x)
360− fail str = B $ \(S inp n) -> putBackState inp n >> fail str
361290 (B f) >>= g = B $ \s -> do (s',a) <- f s
362291 runState (g a) s'
363292
@@ -368,25 +297,51 @@ instance Applicative BitGet where
368297 pure x = return x
369298 fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
370299
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+
371323-- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
372324-- been partially consumed it will be discarded once 'runBitGet' is finished.
373325runBitGet :: BitGet a -> Get a
374326runBitGet bg = do
375327 s <- mkInitState
376− ((S str' n),a) <- runState bg s
377− putBackState str' n
328+ (s',a) <- runState bg s
329+ putBackState s'
378330 return a
379331
380332mkInitState :: Get S
381333mkInitState = do
382− str <- get
334+ bs <- get
383335 put B.empty
384− return (S str 0)
336+ return (S bs 0 BB)
385337
386−putBackState :: B.ByteString -> Int -> Get ()
387−putBackState bs n = do
338+putBackState :: S -> Get ()
339+putBackState (S bs o _) = do
388340 remaining <- get
389− 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)
390345
391346getState :: BitGet S
392347getState = B $ \s -> return (s,s)
@@ -394,52 +349,66 @@ getState = B $ \s -> return (s,s)
394349putState :: S -> BitGet ()
395350putState s = B $ \_ -> return (s,())
396351
352+withState :: (S -> S) -> BitGet ()
353+withState f = do
354+ s <- getState
355+ putState $! f s
356+
397357-- | Make sure there are at least @n@ bits.
398358ensureBits :: Int -> BitGet ()
399359ensureBits n = do
400− (S bs o) <- getState
360+ (S bs o bo) <- getState
401361 if n <= (B.length bs * 8 - o)
402362 then return ()
403363 else do let currentBits = B.length bs * 8 - o
404− let byteCount = (n - currentBits + 7) `div` 8
364+ let byteCount = byte_offset (n - currentBits + 7)
405365 B $ \_ -> do B.ensureN byteCount
406366 bs' <- B.get
407367 put B.empty
408− return (S (bs`append`bs') o, ())
409−
410−-- | Skip the given number of bits
411−skipBits :: Int -> BitGet ()
412−skipBits n = do
413− ensureBits n
414− s <- getState
415− putState $! (incS n s)
368+ return (S (bs`append`bs') o bo, ())
416369
417−-- | Skip bits if necessary to align to the next byte
418−alignByte :: BitGet ()
419−alignByte = do
420− (S _ n) <- getState
421− when (n /= 0) $
422− skipBits (8-n)
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)
423376
424377-- | Get 1 bit as a 'Bool'.
425378getBool :: BitGet Bool
426379getBool = block bool
427380
381+-- | Get 1 bit as a 'Bool'.
382+getBool# :: BitGet Int
383+getBool# = block bool#
384+
428385-- | Get @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
429386getWord8 :: Int -> BitGet Word8
430387getWord8 n = block (word8 n)
431388
432389-- | Get @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
390+getWord16 :: Int -> BitGet Word16
391+getWord16 n = block (word16 n)
392+
433393getWord16be :: Int -> BitGet Word16
434−getWord16be n = block (word16be n)
394+getWord16be = getWord16
395+{-# DEPRECATED getWord16be "Use 'getWord16' instead" #-}
435396
436397-- | Get @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
398+getWord32 :: Int -> BitGet Word32
399+getWord32 n = block (word32 n)
400+
437401getWord32be :: Int -> BitGet Word32
438−getWord32be n = block (word32be n)
402+getWord32be = getWord32
403+{-# DEPRECATED getWord32be "Use 'getWord32' instead" #-}
439404
440405-- | Get @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
406+getWord64 :: Int -> BitGet Word64
407+getWord64 n = block (word64 n)
408+
441409getWord64be :: Int -> BitGet Word64
442−getWord64be n = block (word64be n)
410+getWord64be = getWord64
411+{-# DEPRECATED getWord64be "Use 'getWord64' instead" #-}
443412
444413-- | Get @n@ bytes as a 'ByteString'.
445414getByteString :: Int -> BitGet ByteString
@@ -448,94 +417,80 @@ getByteString n = block (byteString n)
448417-- | Get @n@ bytes as a lazy ByteString.
449418getLazyByteString :: Int -> BitGet L.ByteString
450419getLazyByteString n = do
451− (S _ o) <- getState
420+ (S _ o bo) <- getState
452421 case o of
453− 0 -> B $ \ (S bs o') -> do
454− putBackState bs o'
422+ 0 -> B $ \s -> do
423+ putBackState s
455424 lbs <- B.getLazyByteString (fromIntegral n)
456− return (S B.empty 0, lbs)
425+ return (S B.empty 0 bo, lbs)
457426 _ -> L.fromChunks . (:[]) <$> Data.Binary.Bits.Get.getByteString n
458427
459−-- | Test whether all input has been consumed, i.e. there are no remaining
460−-- undecoded bytes.
461−isEmpty :: BitGet Bool
462−isEmpty = B $ \ (S bs o) -> if B.null bs
463− then B.isEmpty >>= \e -> return (S bs o, e)
464− else return (S bs o, False)
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
465455
466456-- | Read a 1 bit 'Bool'.
467457bool :: Block Bool
468−bool = Block 1 (readBool BB)
458+bool = Block 1 readBool
459+
460+-- | Read a 1 bit 'Bool'.
461+bool# :: Block Int
462+bool# = Block 1 readBool#
469463
470464-- | Read @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
471465word8 :: Int -> Block Word8
472−word8 n = Block n (readWord8 BB n)
466+word8 n = Block n (readWordChecked 8 n)
473467
474468-- | 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+
475472word16be :: Int -> Block Word16
476−word16be n = Block n (readWord16 BB n)
473+word16be = word16
474+{-# DEPRECATED word16be "Use 'word16' instead" #-}
477475
478476-- | 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+
479480word32be :: Int -> Block Word32
480−word32be n = Block n (readWord32 BB n)
481+word32be = word32
482+{-# DEPRECATED word32be "Use 'word32' instead" #-}
481483
482484-- | 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+
483488word64be :: Int -> Block Word64
484−word64be n = Block n (readWord64 BB n)
489+word64be = word64
490+{-# DEPRECATED word64be "Use 'word64' instead" #-}
485491
486492-- | Read @n@ bytes as a 'ByteString'.
487493byteString :: Int -> Block ByteString
488−byteString n | n > 0 = Block (n*8) (readByteString BB n)
494+byteString n | n > 0 = Block (n*8) (readByteString n)
489495 | otherwise = Block 0 (\_ -> B.empty)
490496
491−------------------------------------------------------------------------
492−-- Unchecked shifts, from the package binary
493−
494−shiftl_w8 :: Word8 -> Int -> Word8
495−shiftl_w16 :: Word16 -> Int -> Word16
496−shiftl_w32 :: Word32 -> Int -> Word32
497−shiftl_w64 :: Word64 -> Int -> Word64
498−
499−shiftr_w8 :: Word8 -> Int -> Word8
500−shiftr_w16 :: Word16 -> Int -> Word16
501−shiftr_w32 :: Word32 -> Int -> Word32
502−shiftr_w64 :: Word64 -> Int -> Word64
503−
504−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
505−shiftl_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftL#` i)
506−shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i)
507−shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i)
508−
509−shiftr_w8 (W8# w) (I# i) = W8# (w `uncheckedShiftRL#` i)
510−shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
511−shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
512−
513−
514−#if WORD_SIZE_IN_BITS < 64
515−shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)
516−shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
517−
518−#if __GLASGOW_HASKELL__ <= 606
519−-- Exported by GHC.Word in GHC 6.8 and higher
520−foreign import ccall unsafe "stg_uncheckedShiftL64"
521− uncheckedShiftL64# :: Word64# -> Int# -> Word64#
522−foreign import ccall unsafe "stg_uncheckedShiftRL64"
523− uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
524−#endif
525−
526−#else
527−shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
528−shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
529−#endif
530−
531−#else
532−shiftl_w8 = shiftL
533−shiftl_w16 = shiftL
534−shiftl_w32 = shiftL
535−shiftl_w64 = shiftL
536−
537−shiftr_w8 = shiftR
538−shiftr_w16 = shiftR
539−shiftr_w32 = shiftR
540−shiftr_w64 = shiftR
541−#endif