1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Bits
-- Copyright : (c) The University of Glasgow 2001
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : portable
--
-- This module defines bitwise operations for signed and unsigned
-- integers. Instances of the class 'Bits' for the 'Int' and
-- 'Integer' types are available from this module, and instances for
-- explicitly sized integral types are available from the
-- "Int" and "Word" modules.
--
-----------------------------------------------------------------------------
module Data.Bits (
-- * The 'Bits' class
Bits(
(.&.), (.|.), xor, -- :: a -> a -> a
complement, -- :: a -> a
shift, -- :: a -> Int -> a
rotate, -- :: a -> Int -> a
bit, -- :: Int -> a
setBit, -- :: a -> Int -> a
clearBit, -- :: a -> Int -> a
complementBit, -- :: a -> Int -> a
testBit, -- :: a -> Int -> Bool
bitSize, -- :: a -> Int
isSigned -- :: a -> Bool
),
-- * Shifts and rotates
-- $shifts
shiftL, shiftR, -- :: Bits a => a -> Int -> a
rotateL, rotateR, -- :: Bits a => a -> Int -> a
-- instance Bits Int
-- instance Bits Integer
) where
-- Defines the @Bits@ class containing bit-based operations.
-- See library document for details on the semantics of the
-- individual operations.
#ifdef __GLASGOW_HASKELL__
#include "MachDeps.h"
import GHC.Num
import GHC.Real
import GHC.Base
#endif
--ADR: The fixity for .|. conflicts with that for .|. in Fran.
-- Removing all fixities is a fairly safe fix; fixing the "one fixity
-- per symbol per program" limitation in Hugs would take a lot longer.
#ifndef __HUGS__
infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
infixl 7 .&.
infixl 6 `xor`
infixl 5 .|.
#endif
{-|
The 'Bits' class defines bitwise operations over integral types.
* Bits are numbered from 0 with bit 0 being the least
significant bit.
-}
class Num a => Bits a where
-- | Bitwise \"and\"
(.&.) :: a -> a -> a
-- | Bitwise \"or\"
(.|.) :: a -> a -> a
-- | Bitwise \"xor\"
xor :: a -> a -> a
{-| Reverse all the bits in the argument -}
complement :: a -> a
{-| Signed shift the argument left by the specified number of bits.
Right shifts are specified by giving a negative value. -}
shift :: a -> Int -> a
{-| Signed rotate the argument left by the specified number of bits.
Right rotates are specified by giving a negative value.
'rotate' is well defined only if 'bitSize' is also well defined
('bitSize' is undefined for 'Integer', for example).
-}
rotate :: a -> Int -> a
-- | @bit i@ is a value with the @i@th bit set
bit :: Int -> a
-- | @x \`setBit\` i@ is the same as @x .|. bit i@
setBit :: a -> Int -> a
-- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
clearBit :: a -> Int -> a
-- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
complementBit :: a -> Int -> a
-- | Return 'True' if the @n@th bit of the argument is 1
testBit :: a -> Int -> Bool
{-| Return the number of bits in the type of the argument. The actual
value of the argument is ignored -}
bitSize :: a -> Int
{-| Return 'True' if the argument is a signed type. The actual
value of the argument is ignored -}
isSigned :: a -> Bool
bit i = 1 `shift` i
x `setBit` i = x .|. bit i
x `clearBit` i = x .&. complement (bit i)
x `complementBit` i = x `xor` bit i
x `testBit` i = (x .&. bit i) /= 0
-- $shifts
-- These functions might sometimes be more convenient than the unified
-- versions 'shift' and 'rotate'.
shiftL, shiftR :: Bits a => a -> Int -> a
rotateL, rotateR :: Bits a => a -> Int -> a
x `shiftL` i = x `shift` i
x `shiftR` i = x `shift` (-i)
x `rotateL` i = x `rotate` i
x `rotateR` i = x `rotate` (-i)
#ifdef __GLASGOW_HASKELL__
instance Bits Int where
(I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
(I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
(I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I# x#) `shift` (I# i#)
| i# >=# 0# = I# (x# `iShiftL#` i#)
| otherwise = I# (x# `iShiftRA#` negateInt# i#)
(I# x#) `rotate` (I# i#) =
I# (word2Int# ((x'# `shiftL#` i'#) `or#`
(x'# `shiftRL#` (wsib -# i'#))))
where
x'# = int2Word# x#
i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
bitSize _ = WORD_SIZE_IN_BITS
isSigned _ = True
instance Bits Integer where
(S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
x@(S# _) .&. y = toBig x .&. y
x .&. y@(S# _) = x .&. toBig y
(J# s1 d1) .&. (J# s2 d2) =
case andInteger# s1 d1 s2 d2 of
(# s, d #) -> J# s d
(S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
x@(S# _) .|. y = toBig x .|. y
x .|. y@(S# _) = x .|. toBig y
(J# s1 d1) .|. (J# s2 d2) =
case orInteger# s1 d1 s2 d2 of
(# s, d #) -> J# s d
(S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
x@(S# _) `xor` y = toBig x `xor` y
x `xor` y@(S# _) = x `xor` toBig y
(J# s1 d1) `xor` (J# s2 d2) =
case xorInteger# s1 d1 s2 d2 of
(# s, d #) -> J# s d
complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
shift x i | i >= 0 = x * 2^i
| otherwise = x `div` 2^(-i)
rotate x i = shift x i -- since an Integer never wraps around
bitSize _ = error "Bits.bitSize(Integer)"
isSigned _ = True
#endif
|
