18110b55a83c4dacd828bada73574ac26257ea8d
[ghc.git] / libraries / base / Data / Bits.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
3
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : Data.Bits
7 -- Copyright : (c) The University of Glasgow 2001
8 -- License : BSD-style (see the file libraries/base/LICENSE)
9 --
10 -- Maintainer : libraries@haskell.org
11 -- Stability : experimental
12 -- Portability : portable
13 --
14 -- This module defines bitwise operations for signed and unsigned
15 -- integers. Instances of the class 'Bits' for the 'Int' and
16 -- 'Integer' types are available from this module, and instances for
17 -- explicitly sized integral types are available from the
18 -- "Data.Int" and "Data.Word" modules.
19 --
20 -----------------------------------------------------------------------------
21
22 module Data.Bits (
23 Bits(
24 (.&.), (.|.), xor,
25 complement,
26 shift,
27 rotate,
28 zeroBits,
29 bit,
30 setBit,
31 clearBit,
32 complementBit,
33 testBit,
34 bitSizeMaybe,
35 bitSize,
36 isSigned,
37 shiftL, shiftR,
38 unsafeShiftL, unsafeShiftR,
39 rotateL, rotateR,
40 popCount
41 ),
42 FiniteBits(
43 finiteBitSize,
44 countLeadingZeros,
45 countTrailingZeros
46 ),
47
48 bitDefault,
49 testBitDefault,
50 popCountDefault,
51 toIntegralSized
52 ) where
53
54 -- Defines the @Bits@ class containing bit-based operations.
55 -- See library document for details on the semantics of the
56 -- individual operations.
57
58 #include "MachDeps.h"
59
60 import Data.Maybe
61 import GHC.Enum
62 import GHC.Num
63 import GHC.Base
64 import GHC.Real
65
66 #if defined(MIN_VERSION_integer_gmp)
67 import GHC.Integer.GMP.Internals (bitInteger, popCountInteger)
68 #endif
69
70 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
71 infixl 7 .&.
72 infixl 6 `xor`
73 infixl 5 .|.
74
75 {-# DEPRECATED bitSize "Use 'bitSizeMaybe' or 'finiteBitSize' instead" #-} -- deprecated in 7.8
76
77 -- | The 'Bits' class defines bitwise operations over integral types.
78 --
79 -- * Bits are numbered from 0 with bit 0 being the least
80 -- significant bit.
81 class Eq a => Bits a where
82 {-# MINIMAL (.&.), (.|.), xor, complement,
83 (shift | (shiftL, shiftR)),
84 (rotate | (rotateL, rotateR)),
85 bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-}
86
87 -- | Bitwise \"and\"
88 (.&.) :: a -> a -> a
89
90 -- | Bitwise \"or\"
91 (.|.) :: a -> a -> a
92
93 -- | Bitwise \"xor\"
94 xor :: a -> a -> a
95
96 {-| Reverse all the bits in the argument -}
97 complement :: a -> a
98
99 {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
100 or right by @-i@ bits otherwise.
101 Right shifts perform sign extension on signed number types;
102 i.e. they fill the top bits with 1 if the @x@ is negative
103 and with 0 otherwise.
104
105 An instance can define either this unified 'shift' or 'shiftL' and
106 'shiftR', depending on which is more convenient for the type in
107 question. -}
108 shift :: a -> Int -> a
109
110 x `shift` i | i<0 = x `shiftR` (-i)
111 | i>0 = x `shiftL` i
112 | otherwise = x
113
114 {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
115 or right by @-i@ bits otherwise.
116
117 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
118
119 An instance can define either this unified 'rotate' or 'rotateL' and
120 'rotateR', depending on which is more convenient for the type in
121 question. -}
122 rotate :: a -> Int -> a
123
124 x `rotate` i | i<0 = x `rotateR` (-i)
125 | i>0 = x `rotateL` i
126 | otherwise = x
127
128 {-
129 -- Rotation can be implemented in terms of two shifts, but care is
130 -- needed for negative values. This suggested implementation assumes
131 -- 2's-complement arithmetic. It is commented out because it would
132 -- require an extra context (Ord a) on the signature of 'rotate'.
133 x `rotate` i | i<0 && isSigned x && x<0
134 = let left = i+bitSize x in
135 ((x `shift` i) .&. complement ((-1) `shift` left))
136 .|. (x `shift` left)
137 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
138 | i==0 = x
139 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
140 -}
141
142 -- | 'zeroBits' is the value with all bits unset.
143 --
144 -- The following laws ought to hold (for all valid bit indices @/n/@):
145 --
146 -- * @'clearBit' 'zeroBits' /n/ == 'zeroBits'@
147 -- * @'setBit' 'zeroBits' /n/ == 'bit' /n/@
148 -- * @'testBit' 'zeroBits' /n/ == False@
149 -- * @'popCount' 'zeroBits' == 0@
150 --
151 -- This method uses @'clearBit' ('bit' 0) 0@ as its default
152 -- implementation (which ought to be equivalent to 'zeroBits' for
153 -- types which possess a 0th bit).
154 --
155 -- @since 4.7.0.0
156 zeroBits :: a
157 zeroBits = clearBit (bit 0) 0
158
159 -- | @bit /i/@ is a value with the @/i/@th bit set and all other bits clear.
160 --
161 -- Can be implemented using `bitDefault' if @a@ is also an
162 -- instance of 'Num'.
163 --
164 -- See also 'zeroBits'.
165 bit :: Int -> a
166
167 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
168 setBit :: a -> Int -> a
169
170 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
171 clearBit :: a -> Int -> a
172
173 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
174 complementBit :: a -> Int -> a
175
176 -- | Return 'True' if the @n@th bit of the argument is 1
177 --
178 -- Can be implemented using `testBitDefault' if @a@ is also an
179 -- instance of 'Num'.
180 testBit :: a -> Int -> Bool
181
182 {-| Return the number of bits in the type of the argument. The actual
183 value of the argument is ignored. Returns Nothing
184 for types that do not have a fixed bitsize, like 'Integer'.
185
186 @since 4.7.0.0
187 -}
188 bitSizeMaybe :: a -> Maybe Int
189
190 {-| Return the number of bits in the type of the argument. The actual
191 value of the argument is ignored. The function 'bitSize' is
192 undefined for types that do not have a fixed bitsize, like 'Integer'.
193
194 Default implementation based upon 'bitSizeMaybe' provided since
195 4.12.0.0.
196 -}
197 bitSize :: a -> Int
198 bitSize b = fromMaybe (error "bitSize is undefined") (bitSizeMaybe b)
199
200 {-| Return 'True' if the argument is a signed type. The actual
201 value of the argument is ignored -}
202 isSigned :: a -> Bool
203
204 {-# INLINE setBit #-}
205 {-# INLINE clearBit #-}
206 {-# INLINE complementBit #-}
207 x `setBit` i = x .|. bit i
208 x `clearBit` i = x .&. complement (bit i)
209 x `complementBit` i = x `xor` bit i
210
211 {-| Shift the argument left by the specified number of bits
212 (which must be non-negative).
213
214 An instance can define either this and 'shiftR' or the unified
215 'shift', depending on which is more convenient for the type in
216 question. -}
217 shiftL :: a -> Int -> a
218 {-# INLINE shiftL #-}
219 x `shiftL` i = x `shift` i
220
221 {-| Shift the argument left by the specified number of bits. The
222 result is undefined for negative shift amounts and shift amounts
223 greater or equal to the 'bitSize'.
224
225 Defaults to 'shiftL' unless defined explicitly by an instance.
226
227 @since 4.5.0.0 -}
228 unsafeShiftL :: a -> Int -> a
229 {-# INLINE unsafeShiftL #-}
230 x `unsafeShiftL` i = x `shiftL` i
231
232 {-| Shift the first argument right by the specified number of bits. The
233 result is undefined for negative shift amounts and shift amounts
234 greater or equal to the 'bitSize'.
235
236 Right shifts perform sign extension on signed number types;
237 i.e. they fill the top bits with 1 if the @x@ is negative
238 and with 0 otherwise.
239
240 An instance can define either this and 'shiftL' or the unified
241 'shift', depending on which is more convenient for the type in
242 question. -}
243 shiftR :: a -> Int -> a
244 {-# INLINE shiftR #-}
245 x `shiftR` i = x `shift` (-i)
246
247 {-| Shift the first argument right by the specified number of bits, which
248 must be non-negative and smaller than the number of bits in the type.
249
250 Right shifts perform sign extension on signed number types;
251 i.e. they fill the top bits with 1 if the @x@ is negative
252 and with 0 otherwise.
253
254 Defaults to 'shiftR' unless defined explicitly by an instance.
255
256 @since 4.5.0.0 -}
257 unsafeShiftR :: a -> Int -> a
258 {-# INLINE unsafeShiftR #-}
259 x `unsafeShiftR` i = x `shiftR` i
260
261 {-| Rotate the argument left by the specified number of bits
262 (which must be non-negative).
263
264 An instance can define either this and 'rotateR' or the unified
265 'rotate', depending on which is more convenient for the type in
266 question. -}
267 rotateL :: a -> Int -> a
268 {-# INLINE rotateL #-}
269 x `rotateL` i = x `rotate` i
270
271 {-| Rotate the argument right by the specified number of bits
272 (which must be non-negative).
273
274 An instance can define either this and 'rotateL' or the unified
275 'rotate', depending on which is more convenient for the type in
276 question. -}
277 rotateR :: a -> Int -> a
278 {-# INLINE rotateR #-}
279 x `rotateR` i = x `rotate` (-i)
280
281 {-| Return the number of set bits in the argument. This number is
282 known as the population count or the Hamming weight.
283
284 Can be implemented using `popCountDefault' if @a@ is also an
285 instance of 'Num'.
286
287 @since 4.5.0.0 -}
288 popCount :: a -> Int
289
290 -- |The 'FiniteBits' class denotes types with a finite, fixed number of bits.
291 --
292 -- @since 4.7.0.0
293 class Bits b => FiniteBits b where
294 -- | Return the number of bits in the type of the argument.
295 -- The actual value of the argument is ignored. Moreover, 'finiteBitSize'
296 -- is total, in contrast to the deprecated 'bitSize' function it replaces.
297 --
298 -- @
299 -- 'finiteBitSize' = 'bitSize'
300 -- 'bitSizeMaybe' = 'Just' . 'finiteBitSize'
301 -- @
302 --
303 -- @since 4.7.0.0
304 finiteBitSize :: b -> Int
305
306 -- | Count number of zero bits preceding the most significant set bit.
307 --
308 -- @
309 -- 'countLeadingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
310 -- @
311 --
312 -- 'countLeadingZeros' can be used to compute log base 2 via
313 --
314 -- @
315 -- logBase2 x = 'finiteBitSize' x - 1 - 'countLeadingZeros' x
316 -- @
317 --
318 -- Note: The default implementation for this method is intentionally
319 -- naive. However, the instances provided for the primitive
320 -- integral types are implemented using CPU specific machine
321 -- instructions.
322 --
323 -- @since 4.8.0.0
324 countLeadingZeros :: b -> Int
325 countLeadingZeros x = (w-1) - go (w-1)
326 where
327 go i | i < 0 = i -- no bit set
328 | testBit x i = i
329 | otherwise = go (i-1)
330
331 w = finiteBitSize x
332
333 -- | Count number of zero bits following the least significant set bit.
334 --
335 -- @
336 -- 'countTrailingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
337 -- 'countTrailingZeros' . 'negate' = 'countTrailingZeros'
338 -- @
339 --
340 -- The related
341 -- <http://en.wikipedia.org/wiki/Find_first_set find-first-set operation>
342 -- can be expressed in terms of 'countTrailingZeros' as follows
343 --
344 -- @
345 -- findFirstSet x = 1 + 'countTrailingZeros' x
346 -- @
347 --
348 -- Note: The default implementation for this method is intentionally
349 -- naive. However, the instances provided for the primitive
350 -- integral types are implemented using CPU specific machine
351 -- instructions.
352 --
353 -- @since 4.8.0.0
354 countTrailingZeros :: b -> Int
355 countTrailingZeros x = go 0
356 where
357 go i | i >= w = i
358 | testBit x i = i
359 | otherwise = go (i+1)
360
361 w = finiteBitSize x
362
363
364 -- The defaults below are written with lambdas so that e.g.
365 -- bit = bitDefault
366 -- is fully applied, so inlining will happen
367
368 -- | Default implementation for 'bit'.
369 --
370 -- Note that: @bitDefault i = 1 `shiftL` i@
371 --
372 -- @since 4.6.0.0
373 bitDefault :: (Bits a, Num a) => Int -> a
374 bitDefault = \i -> 1 `shiftL` i
375 {-# INLINE bitDefault #-}
376
377 -- | Default implementation for 'testBit'.
378 --
379 -- Note that: @testBitDefault x i = (x .&. bit i) /= 0@
380 --
381 -- @since 4.6.0.0
382 testBitDefault :: (Bits a, Num a) => a -> Int -> Bool
383 testBitDefault = \x i -> (x .&. bit i) /= 0
384 {-# INLINE testBitDefault #-}
385
386 -- | Default implementation for 'popCount'.
387 --
388 -- This implementation is intentionally naive. Instances are expected to provide
389 -- an optimized implementation for their size.
390 --
391 -- @since 4.6.0.0
392 popCountDefault :: (Bits a, Num a) => a -> Int
393 popCountDefault = go 0
394 where
395 go !c 0 = c
396 go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant
397 {-# INLINABLE popCountDefault #-}
398
399
400 -- | Interpret 'Bool' as 1-bit bit-field
401 --
402 -- @since 4.7.0.0
403 instance Bits Bool where
404 (.&.) = (&&)
405
406 (.|.) = (||)
407
408 xor = (/=)
409
410 complement = not
411
412 shift x 0 = x
413 shift _ _ = False
414
415 rotate x _ = x
416
417 bit 0 = True
418 bit _ = False
419
420 testBit x 0 = x
421 testBit _ _ = False
422
423 bitSizeMaybe _ = Just 1
424
425 bitSize _ = 1
426
427 isSigned _ = False
428
429 popCount False = 0
430 popCount True = 1
431
432 -- | @since 4.7.0.0
433 instance FiniteBits Bool where
434 finiteBitSize _ = 1
435 countTrailingZeros x = if x then 0 else 1
436 countLeadingZeros x = if x then 0 else 1
437
438 -- | @since 2.01
439 instance Bits Int where
440 {-# INLINE shift #-}
441 {-# INLINE bit #-}
442 {-# INLINE testBit #-}
443
444 zeroBits = 0
445
446 bit = bitDefault
447
448 testBit = testBitDefault
449
450 (I# x#) .&. (I# y#) = I# (x# `andI#` y#)
451 (I# x#) .|. (I# y#) = I# (x# `orI#` y#)
452 (I# x#) `xor` (I# y#) = I# (x# `xorI#` y#)
453 complement (I# x#) = I# (notI# x#)
454 (I# x#) `shift` (I# i#)
455 | isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#)
456 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
457 (I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
458 (I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
459 (I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
460 (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
461
462 {-# INLINE rotate #-} -- See Note [Constant folding for rotate]
463 (I# x#) `rotate` (I# i#) =
464 I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#)))
465 where
466 !i'# = i# `andI#` (wsib -# 1#)
467 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
468 bitSizeMaybe i = Just (finiteBitSize i)
469 bitSize i = finiteBitSize i
470
471 popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
472
473 isSigned _ = True
474
475 -- | @since 4.6.0.0
476 instance FiniteBits Int where
477 finiteBitSize _ = WORD_SIZE_IN_BITS
478 countLeadingZeros (I# x#) = I# (word2Int# (clz# (int2Word# x#)))
479 countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#)))
480
481 -- | @since 2.01
482 instance Bits Word where
483 {-# INLINE shift #-}
484 {-# INLINE bit #-}
485 {-# INLINE testBit #-}
486
487 (W# x#) .&. (W# y#) = W# (x# `and#` y#)
488 (W# x#) .|. (W# y#) = W# (x# `or#` y#)
489 (W# x#) `xor` (W# y#) = W# (x# `xor#` y#)
490 complement (W# x#) = W# (x# `xor#` mb#)
491 where !(W# mb#) = maxBound
492 (W# x#) `shift` (I# i#)
493 | isTrue# (i# >=# 0#) = W# (x# `shiftL#` i#)
494 | otherwise = W# (x# `shiftRL#` negateInt# i#)
495 (W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#)
496 (W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
497 (W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#)
498 (W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
499 (W# x#) `rotate` (I# i#)
500 | isTrue# (i'# ==# 0#) = W# x#
501 | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
502 where
503 !i'# = i# `andI#` (wsib -# 1#)
504 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
505 bitSizeMaybe i = Just (finiteBitSize i)
506 bitSize i = finiteBitSize i
507 isSigned _ = False
508 popCount (W# x#) = I# (word2Int# (popCnt# x#))
509 bit = bitDefault
510 testBit = testBitDefault
511
512 -- | @since 4.6.0.0
513 instance FiniteBits Word where
514 finiteBitSize _ = WORD_SIZE_IN_BITS
515 countLeadingZeros (W# x#) = I# (word2Int# (clz# x#))
516 countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#))
517
518 -- | @since 2.01
519 instance Bits Integer where
520 (.&.) = andInteger
521 (.|.) = orInteger
522 xor = xorInteger
523 complement = complementInteger
524 shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
525 | otherwise = shiftRInteger x (negateInt# i#)
526 testBit x (I# i) = testBitInteger x i
527 zeroBits = 0
528
529 #if defined(MIN_VERSION_integer_gmp)
530 bit (I# i#) = bitInteger i#
531 popCount x = I# (popCountInteger x)
532 #else
533 bit = bitDefault
534 popCount = popCountDefault
535 #endif
536
537 rotate x i = shift x i -- since an Integer never wraps around
538
539 bitSizeMaybe _ = Nothing
540 bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"
541 isSigned _ = True
542
543 #if defined(MIN_VERSION_integer_gmp)
544 -- | @since 4.8.0
545 instance Bits Natural where
546 (.&.) = andNatural
547 (.|.) = orNatural
548 xor = xorNatural
549 complement _ = errorWithoutStackTrace
550 "Bits.complement: Natural complement undefined"
551 shift x i
552 | i >= 0 = shiftLNatural x i
553 | otherwise = shiftRNatural x (negate i)
554 testBit x i = testBitNatural x i
555 zeroBits = wordToNaturalBase 0##
556 clearBit x i = x `xor` (bit i .&. x)
557
558 bit (I# i#) = bitNatural i#
559 popCount x = popCountNatural x
560
561 rotate x i = shift x i -- since an Natural never wraps around
562
563 bitSizeMaybe _ = Nothing
564 bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Natural)"
565 isSigned _ = False
566 #else
567 -- | @since 4.8.0.0
568 instance Bits Natural where
569 Natural n .&. Natural m = Natural (n .&. m)
570 {-# INLINE (.&.) #-}
571 Natural n .|. Natural m = Natural (n .|. m)
572 {-# INLINE (.|.) #-}
573 xor (Natural n) (Natural m) = Natural (xor n m)
574 {-# INLINE xor #-}
575 complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
576 {-# INLINE complement #-}
577 shift (Natural n) = Natural . shift n
578 {-# INLINE shift #-}
579 rotate (Natural n) = Natural . rotate n
580 {-# INLINE rotate #-}
581 bit = Natural . bit
582 {-# INLINE bit #-}
583 setBit (Natural n) = Natural . setBit n
584 {-# INLINE setBit #-}
585 clearBit (Natural n) = Natural . clearBit n
586 {-# INLINE clearBit #-}
587 complementBit (Natural n) = Natural . complementBit n
588 {-# INLINE complementBit #-}
589 testBit (Natural n) = testBit n
590 {-# INLINE testBit #-}
591 bitSizeMaybe _ = Nothing
592 {-# INLINE bitSizeMaybe #-}
593 bitSize = errorWithoutStackTrace "Natural: bitSize"
594 {-# INLINE bitSize #-}
595 isSigned _ = False
596 {-# INLINE isSigned #-}
597 shiftL (Natural n) = Natural . shiftL n
598 {-# INLINE shiftL #-}
599 shiftR (Natural n) = Natural . shiftR n
600 {-# INLINE shiftR #-}
601 rotateL (Natural n) = Natural . rotateL n
602 {-# INLINE rotateL #-}
603 rotateR (Natural n) = Natural . rotateR n
604 {-# INLINE rotateR #-}
605 popCount (Natural n) = popCount n
606 {-# INLINE popCount #-}
607 zeroBits = Natural 0
608
609 #endif
610
611 -----------------------------------------------------------------------------
612
613 -- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using
614 -- the size of the types as measured by 'Bits' methods.
615 --
616 -- A simpler version of this function is:
617 --
618 -- > toIntegral :: (Integral a, Integral b) => a -> Maybe b
619 -- > toIntegral x
620 -- > | toInteger x == y = Just (fromInteger y)
621 -- > | otherwise = Nothing
622 -- > where
623 -- > y = toInteger x
624 --
625 -- This version requires going through 'Integer', which can be inefficient.
626 -- However, @toIntegralSized@ is optimized to allow GHC to statically determine
627 -- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and
628 -- avoid going through 'Integer' for many types. (The implementation uses
629 -- 'fromIntegral', which is itself optimized with rules for @base@ types but may
630 -- go through 'Integer' for some type pairs.)
631 --
632 -- @since 4.8.0.0
633
634 toIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b
635 toIntegralSized x -- See Note [toIntegralSized optimization]
636 | maybe True (<= x) yMinBound
637 , maybe True (x <=) yMaxBound = Just y
638 | otherwise = Nothing
639 where
640 y = fromIntegral x
641
642 xWidth = bitSizeMaybe x
643 yWidth = bitSizeMaybe y
644
645 yMinBound
646 | isBitSubType x y = Nothing
647 | isSigned x, not (isSigned y) = Just 0
648 | isSigned x, isSigned y
649 , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type
650 | otherwise = Nothing
651
652 yMaxBound
653 | isBitSubType x y = Nothing
654 | isSigned x, not (isSigned y)
655 , Just xW <- xWidth, Just yW <- yWidth
656 , xW <= yW+1 = Nothing -- Max bound beyond a's domain
657 | Just yW <- yWidth = if isSigned y
658 then Just (bit (yW-1)-1)
659 else Just (bit yW-1)
660 | otherwise = Nothing
661 {-# INLINABLE toIntegralSized #-}
662
663 -- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured
664 -- by 'bitSizeMaybe' and 'isSigned'.
665 isBitSubType :: (Bits a, Bits b) => a -> b -> Bool
666 isBitSubType x y
667 -- Reflexive
668 | xWidth == yWidth, xSigned == ySigned = True
669
670 -- Every integer is a subset of 'Integer'
671 | ySigned, Nothing == yWidth = True
672 | not xSigned, not ySigned, Nothing == yWidth = True
673
674 -- Sub-type relations between fixed-with types
675 | xSigned == ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <= yW
676 | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW < yW
677
678 | otherwise = False
679 where
680 xWidth = bitSizeMaybe x
681 xSigned = isSigned x
682
683 yWidth = bitSizeMaybe y
684 ySigned = isSigned y
685 {-# INLINE isBitSubType #-}
686
687 {- Note [Constant folding for rotate]
688 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
689 The INLINE on the Int instance of rotate enables it to be constant
690 folded. For example:
691 sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
692 goes to:
693 Main.$wfold =
694 \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
695 case ww1_sOb of wild_XM {
696 __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
697 10000000 -> ww_sO7
698 whereas before it was left as a call to $wrotate.
699
700 All other Bits instances seem to inline well enough on their
701 own to enable constant folding; for example 'shift':
702 sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
703 goes to:
704 Main.$wfold =
705 \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
706 case ww1_sOf of wild_XM {
707 __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
708 10000000 -> ww_sOb
709 }
710 -}
711
712 -- Note [toIntegralSized optimization]
713 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
714 -- The code in 'toIntegralSized' relies on GHC optimizing away statically
715 -- decidable branches.
716 --
717 -- If both integral types are statically known, GHC will be able optimize the
718 -- code significantly (for @-O1@ and better).
719 --
720 -- For instance (as of GHC 7.8.1) the following definitions:
721 --
722 -- > w16_to_i32 = toIntegralSized :: Word16 -> Maybe Int32
723 -- >
724 -- > i16_to_w16 = toIntegralSized :: Int16 -> Maybe Word16
725 --
726 -- are translated into the following (simplified) /GHC Core/ language:
727 --
728 -- > w16_to_i32 = \x -> Just (case x of _ { W16# x# -> I32# (word2Int# x#) })
729 -- >
730 -- > i16_to_w16 = \x -> case eta of _
731 -- > { I16# b1 -> case tagToEnum# (<=# 0 b1) of _
732 -- > { False -> Nothing
733 -- > ; True -> Just (W16# (narrow16Word# (int2Word# b1)))
734 -- > }
735 -- > }