Built-in Natural literals in Core
[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 bitSize :: a -> Int
195
196 {-| Return 'True' if the argument is a signed type. The actual
197 value of the argument is ignored -}
198 isSigned :: a -> Bool
199
200 {-# INLINE setBit #-}
201 {-# INLINE clearBit #-}
202 {-# INLINE complementBit #-}
203 x `setBit` i = x .|. bit i
204 x `clearBit` i = x .&. complement (bit i)
205 x `complementBit` i = x `xor` bit i
206
207 {-| Shift the argument left by the specified number of bits
208 (which must be non-negative).
209
210 An instance can define either this and 'shiftR' or the unified
211 'shift', depending on which is more convenient for the type in
212 question. -}
213 shiftL :: a -> Int -> a
214 {-# INLINE shiftL #-}
215 x `shiftL` i = x `shift` i
216
217 {-| Shift the argument left by the specified number of bits. The
218 result is undefined for negative shift amounts and shift amounts
219 greater or equal to the 'bitSize'.
220
221 Defaults to 'shiftL' unless defined explicitly by an instance.
222
223 @since 4.5.0.0 -}
224 unsafeShiftL :: a -> Int -> a
225 {-# INLINE unsafeShiftL #-}
226 x `unsafeShiftL` i = x `shiftL` i
227
228 {-| Shift the first argument right by the specified number of bits. The
229 result is undefined for negative shift amounts and shift amounts
230 greater or equal to the 'bitSize'.
231
232 Right shifts perform sign extension on signed number types;
233 i.e. they fill the top bits with 1 if the @x@ is negative
234 and with 0 otherwise.
235
236 An instance can define either this and 'shiftL' or the unified
237 'shift', depending on which is more convenient for the type in
238 question. -}
239 shiftR :: a -> Int -> a
240 {-# INLINE shiftR #-}
241 x `shiftR` i = x `shift` (-i)
242
243 {-| Shift the first argument right by the specified number of bits, which
244 must be non-negative and smaller than the number of bits in the type.
245
246 Right shifts perform sign extension on signed number types;
247 i.e. they fill the top bits with 1 if the @x@ is negative
248 and with 0 otherwise.
249
250 Defaults to 'shiftR' unless defined explicitly by an instance.
251
252 @since 4.5.0.0 -}
253 unsafeShiftR :: a -> Int -> a
254 {-# INLINE unsafeShiftR #-}
255 x `unsafeShiftR` i = x `shiftR` i
256
257 {-| Rotate the argument left by the specified number of bits
258 (which must be non-negative).
259
260 An instance can define either this and 'rotateR' or the unified
261 'rotate', depending on which is more convenient for the type in
262 question. -}
263 rotateL :: a -> Int -> a
264 {-# INLINE rotateL #-}
265 x `rotateL` i = x `rotate` i
266
267 {-| Rotate the argument right by the specified number of bits
268 (which must be non-negative).
269
270 An instance can define either this and 'rotateL' or the unified
271 'rotate', depending on which is more convenient for the type in
272 question. -}
273 rotateR :: a -> Int -> a
274 {-# INLINE rotateR #-}
275 x `rotateR` i = x `rotate` (-i)
276
277 {-| Return the number of set bits in the argument. This number is
278 known as the population count or the Hamming weight.
279
280 Can be implemented using `popCountDefault' if @a@ is also an
281 instance of 'Num'.
282
283 @since 4.5.0.0 -}
284 popCount :: a -> Int
285
286 -- |The 'FiniteBits' class denotes types with a finite, fixed number of bits.
287 --
288 -- @since 4.7.0.0
289 class Bits b => FiniteBits b where
290 -- | Return the number of bits in the type of the argument.
291 -- The actual value of the argument is ignored. Moreover, 'finiteBitSize'
292 -- is total, in contrast to the deprecated 'bitSize' function it replaces.
293 --
294 -- @
295 -- 'finiteBitSize' = 'bitSize'
296 -- 'bitSizeMaybe' = 'Just' . 'finiteBitSize'
297 -- @
298 --
299 -- @since 4.7.0.0
300 finiteBitSize :: b -> Int
301
302 -- | Count number of zero bits preceding the most significant set bit.
303 --
304 -- @
305 -- 'countLeadingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
306 -- @
307 --
308 -- 'countLeadingZeros' can be used to compute log base 2 via
309 --
310 -- @
311 -- logBase2 x = 'finiteBitSize' x - 1 - 'countLeadingZeros' x
312 -- @
313 --
314 -- Note: The default implementation for this method is intentionally
315 -- naive. However, the instances provided for the primitive
316 -- integral types are implemented using CPU specific machine
317 -- instructions.
318 --
319 -- @since 4.8.0.0
320 countLeadingZeros :: b -> Int
321 countLeadingZeros x = (w-1) - go (w-1)
322 where
323 go i | i < 0 = i -- no bit set
324 | testBit x i = i
325 | otherwise = go (i-1)
326
327 w = finiteBitSize x
328
329 -- | Count number of zero bits following the least significant set bit.
330 --
331 -- @
332 -- 'countTrailingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
333 -- 'countTrailingZeros' . 'negate' = 'countTrailingZeros'
334 -- @
335 --
336 -- The related
337 -- <http://en.wikipedia.org/wiki/Find_first_set find-first-set operation>
338 -- can be expressed in terms of 'countTrailingZeros' as follows
339 --
340 -- @
341 -- findFirstSet x = 1 + 'countTrailingZeros' x
342 -- @
343 --
344 -- Note: The default implementation for this method is intentionally
345 -- naive. However, the instances provided for the primitive
346 -- integral types are implemented using CPU specific machine
347 -- instructions.
348 --
349 -- @since 4.8.0.0
350 countTrailingZeros :: b -> Int
351 countTrailingZeros x = go 0
352 where
353 go i | i >= w = i
354 | testBit x i = i
355 | otherwise = go (i+1)
356
357 w = finiteBitSize x
358
359
360 -- The defaults below are written with lambdas so that e.g.
361 -- bit = bitDefault
362 -- is fully applied, so inlining will happen
363
364 -- | Default implementation for 'bit'.
365 --
366 -- Note that: @bitDefault i = 1 `shiftL` i@
367 --
368 -- @since 4.6.0.0
369 bitDefault :: (Bits a, Num a) => Int -> a
370 bitDefault = \i -> 1 `shiftL` i
371 {-# INLINE bitDefault #-}
372
373 -- | Default implementation for 'testBit'.
374 --
375 -- Note that: @testBitDefault x i = (x .&. bit i) /= 0@
376 --
377 -- @since 4.6.0.0
378 testBitDefault :: (Bits a, Num a) => a -> Int -> Bool
379 testBitDefault = \x i -> (x .&. bit i) /= 0
380 {-# INLINE testBitDefault #-}
381
382 -- | Default implementation for 'popCount'.
383 --
384 -- This implementation is intentionally naive. Instances are expected to provide
385 -- an optimized implementation for their size.
386 --
387 -- @since 4.6.0.0
388 popCountDefault :: (Bits a, Num a) => a -> Int
389 popCountDefault = go 0
390 where
391 go !c 0 = c
392 go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant
393 {-# INLINABLE popCountDefault #-}
394
395
396 -- | Interpret 'Bool' as 1-bit bit-field
397 --
398 -- @since 4.7.0.0
399 instance Bits Bool where
400 (.&.) = (&&)
401
402 (.|.) = (||)
403
404 xor = (/=)
405
406 complement = not
407
408 shift x 0 = x
409 shift _ _ = False
410
411 rotate x _ = x
412
413 bit 0 = True
414 bit _ = False
415
416 testBit x 0 = x
417 testBit _ _ = False
418
419 bitSizeMaybe _ = Just 1
420
421 bitSize _ = 1
422
423 isSigned _ = False
424
425 popCount False = 0
426 popCount True = 1
427
428 -- | @since 4.7.0.0
429 instance FiniteBits Bool where
430 finiteBitSize _ = 1
431 countTrailingZeros x = if x then 0 else 1
432 countLeadingZeros x = if x then 0 else 1
433
434 -- | @since 2.01
435 instance Bits Int where
436 {-# INLINE shift #-}
437 {-# INLINE bit #-}
438 {-# INLINE testBit #-}
439
440 zeroBits = 0
441
442 bit = bitDefault
443
444 testBit = testBitDefault
445
446 (I# x#) .&. (I# y#) = I# (x# `andI#` y#)
447 (I# x#) .|. (I# y#) = I# (x# `orI#` y#)
448 (I# x#) `xor` (I# y#) = I# (x# `xorI#` y#)
449 complement (I# x#) = I# (notI# x#)
450 (I# x#) `shift` (I# i#)
451 | isTrue# (i# >=# 0#) = I# (x# `iShiftL#` i#)
452 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
453 (I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
454 (I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
455 (I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
456 (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
457
458 {-# INLINE rotate #-} -- See Note [Constant folding for rotate]
459 (I# x#) `rotate` (I# i#) =
460 I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#)))
461 where
462 !i'# = i# `andI#` (wsib -# 1#)
463 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
464 bitSizeMaybe i = Just (finiteBitSize i)
465 bitSize i = finiteBitSize i
466
467 popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
468
469 isSigned _ = True
470
471 -- | @since 4.6.0.0
472 instance FiniteBits Int where
473 finiteBitSize _ = WORD_SIZE_IN_BITS
474 countLeadingZeros (I# x#) = I# (word2Int# (clz# (int2Word# x#)))
475 countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#)))
476
477 -- | @since 2.01
478 instance Bits Word where
479 {-# INLINE shift #-}
480 {-# INLINE bit #-}
481 {-# INLINE testBit #-}
482
483 (W# x#) .&. (W# y#) = W# (x# `and#` y#)
484 (W# x#) .|. (W# y#) = W# (x# `or#` y#)
485 (W# x#) `xor` (W# y#) = W# (x# `xor#` y#)
486 complement (W# x#) = W# (x# `xor#` mb#)
487 where !(W# mb#) = maxBound
488 (W# x#) `shift` (I# i#)
489 | isTrue# (i# >=# 0#) = W# (x# `shiftL#` i#)
490 | otherwise = W# (x# `shiftRL#` negateInt# i#)
491 (W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#)
492 (W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
493 (W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#)
494 (W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
495 (W# x#) `rotate` (I# i#)
496 | isTrue# (i'# ==# 0#) = W# x#
497 | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
498 where
499 !i'# = i# `andI#` (wsib -# 1#)
500 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
501 bitSizeMaybe i = Just (finiteBitSize i)
502 bitSize i = finiteBitSize i
503 isSigned _ = False
504 popCount (W# x#) = I# (word2Int# (popCnt# x#))
505 bit = bitDefault
506 testBit = testBitDefault
507
508 -- | @since 4.6.0.0
509 instance FiniteBits Word where
510 finiteBitSize _ = WORD_SIZE_IN_BITS
511 countLeadingZeros (W# x#) = I# (word2Int# (clz# x#))
512 countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#))
513
514 -- | @since 2.01
515 instance Bits Integer where
516 (.&.) = andInteger
517 (.|.) = orInteger
518 xor = xorInteger
519 complement = complementInteger
520 shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
521 | otherwise = shiftRInteger x (negateInt# i#)
522 testBit x (I# i) = testBitInteger x i
523 zeroBits = 0
524
525 #if defined(MIN_VERSION_integer_gmp)
526 bit (I# i#) = bitInteger i#
527 popCount x = I# (popCountInteger x)
528 #else
529 bit = bitDefault
530 popCount = popCountDefault
531 #endif
532
533 rotate x i = shift x i -- since an Integer never wraps around
534
535 bitSizeMaybe _ = Nothing
536 bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"
537 isSigned _ = True
538
539 #if defined(MIN_VERSION_integer_gmp)
540 -- | @since 4.8.0
541 instance Bits Natural where
542 (.&.) = andNatural
543 (.|.) = orNatural
544 xor = xorNatural
545 complement _ = errorWithoutStackTrace
546 "Bits.complement: Natural complement undefined"
547 shift x i
548 | i >= 0 = shiftLNatural x i
549 | otherwise = shiftRNatural x (negate i)
550 testBit x i = testBitNatural x i
551 zeroBits = wordToNaturalBase 0##
552 clearBit x i = x `xor` (bit i .&. x)
553
554 bit (I# i#) = bitNatural i#
555 popCount x = popCountNatural x
556
557 rotate x i = shift x i -- since an Natural never wraps around
558
559 bitSizeMaybe _ = Nothing
560 bitSize _ = errorWithoutStackTrace "Data.Bits.bitSize(Natural)"
561 isSigned _ = False
562 #else
563 -- | @since 4.8.0.0
564 instance Bits Natural where
565 Natural n .&. Natural m = Natural (n .&. m)
566 {-# INLINE (.&.) #-}
567 Natural n .|. Natural m = Natural (n .|. m)
568 {-# INLINE (.|.) #-}
569 xor (Natural n) (Natural m) = Natural (xor n m)
570 {-# INLINE xor #-}
571 complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
572 {-# INLINE complement #-}
573 shift (Natural n) = Natural . shift n
574 {-# INLINE shift #-}
575 rotate (Natural n) = Natural . rotate n
576 {-# INLINE rotate #-}
577 bit = Natural . bit
578 {-# INLINE bit #-}
579 setBit (Natural n) = Natural . setBit n
580 {-# INLINE setBit #-}
581 clearBit (Natural n) = Natural . clearBit n
582 {-# INLINE clearBit #-}
583 complementBit (Natural n) = Natural . complementBit n
584 {-# INLINE complementBit #-}
585 testBit (Natural n) = testBit n
586 {-# INLINE testBit #-}
587 bitSizeMaybe _ = Nothing
588 {-# INLINE bitSizeMaybe #-}
589 bitSize = errorWithoutStackTrace "Natural: bitSize"
590 {-# INLINE bitSize #-}
591 isSigned _ = False
592 {-# INLINE isSigned #-}
593 shiftL (Natural n) = Natural . shiftL n
594 {-# INLINE shiftL #-}
595 shiftR (Natural n) = Natural . shiftR n
596 {-# INLINE shiftR #-}
597 rotateL (Natural n) = Natural . rotateL n
598 {-# INLINE rotateL #-}
599 rotateR (Natural n) = Natural . rotateR n
600 {-# INLINE rotateR #-}
601 popCount (Natural n) = popCount n
602 {-# INLINE popCount #-}
603 zeroBits = Natural 0
604
605 #endif
606
607 -----------------------------------------------------------------------------
608
609 -- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using
610 -- the size of the types as measured by 'Bits' methods.
611 --
612 -- A simpler version of this function is:
613 --
614 -- > toIntegral :: (Integral a, Integral b) => a -> Maybe b
615 -- > toIntegral x
616 -- > | toInteger x == y = Just (fromInteger y)
617 -- > | otherwise = Nothing
618 -- > where
619 -- > y = toInteger x
620 --
621 -- This version requires going through 'Integer', which can be inefficient.
622 -- However, @toIntegralSized@ is optimized to allow GHC to statically determine
623 -- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and
624 -- avoid going through 'Integer' for many types. (The implementation uses
625 -- 'fromIntegral', which is itself optimized with rules for @base@ types but may
626 -- go through 'Integer' for some type pairs.)
627 --
628 -- @since 4.8.0.0
629
630 toIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b
631 toIntegralSized x -- See Note [toIntegralSized optimization]
632 | maybe True (<= x) yMinBound
633 , maybe True (x <=) yMaxBound = Just y
634 | otherwise = Nothing
635 where
636 y = fromIntegral x
637
638 xWidth = bitSizeMaybe x
639 yWidth = bitSizeMaybe y
640
641 yMinBound
642 | isBitSubType x y = Nothing
643 | isSigned x, not (isSigned y) = Just 0
644 | isSigned x, isSigned y
645 , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type
646 | otherwise = Nothing
647
648 yMaxBound
649 | isBitSubType x y = Nothing
650 | isSigned x, not (isSigned y)
651 , Just xW <- xWidth, Just yW <- yWidth
652 , xW <= yW+1 = Nothing -- Max bound beyond a's domain
653 | Just yW <- yWidth = if isSigned y
654 then Just (bit (yW-1)-1)
655 else Just (bit yW-1)
656 | otherwise = Nothing
657 {-# INLINABLE toIntegralSized #-}
658
659 -- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured
660 -- by 'bitSizeMaybe' and 'isSigned'.
661 isBitSubType :: (Bits a, Bits b) => a -> b -> Bool
662 isBitSubType x y
663 -- Reflexive
664 | xWidth == yWidth, xSigned == ySigned = True
665
666 -- Every integer is a subset of 'Integer'
667 | ySigned, Nothing == yWidth = True
668 | not xSigned, not ySigned, Nothing == yWidth = True
669
670 -- Sub-type relations between fixed-with types
671 | xSigned == ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <= yW
672 | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW < yW
673
674 | otherwise = False
675 where
676 xWidth = bitSizeMaybe x
677 xSigned = isSigned x
678
679 yWidth = bitSizeMaybe y
680 ySigned = isSigned y
681 {-# INLINE isBitSubType #-}
682
683 {- Note [Constant folding for rotate]
684 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
685 The INLINE on the Int instance of rotate enables it to be constant
686 folded. For example:
687 sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
688 goes to:
689 Main.$wfold =
690 \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
691 case ww1_sOb of wild_XM {
692 __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
693 10000000 -> ww_sO7
694 whereas before it was left as a call to $wrotate.
695
696 All other Bits instances seem to inline well enough on their
697 own to enable constant folding; for example 'shift':
698 sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
699 goes to:
700 Main.$wfold =
701 \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
702 case ww1_sOf of wild_XM {
703 __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
704 10000000 -> ww_sOb
705 }
706 -}
707
708 -- Note [toIntegralSized optimization]
709 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
710 -- The code in 'toIntegralSized' relies on GHC optimizing away statically
711 -- decidable branches.
712 --
713 -- If both integral types are statically known, GHC will be able optimize the
714 -- code significantly (for @-O1@ and better).
715 --
716 -- For instance (as of GHC 7.8.1) the following definitions:
717 --
718 -- > w16_to_i32 = toIntegralSized :: Word16 -> Maybe Int32
719 -- >
720 -- > i16_to_w16 = toIntegralSized :: Int16 -> Maybe Word16
721 --
722 -- are translated into the following (simplified) /GHC Core/ language:
723 --
724 -- > w16_to_i32 = \x -> Just (case x of _ { W16# x# -> I32# (word2Int# x#) })
725 -- >
726 -- > i16_to_w16 = \x -> case eta of _
727 -- > { I16# b1 -> case tagToEnum# (<=# 0 b1) of _
728 -- > { False -> Nothing
729 -- > ; True -> Just (W16# (narrow16Word# (int2Word# b1)))
730 -- > }
731 -- > }