[project @ 2002-04-24 16:31:37 by simonmar]
[packages/base.git] / Data / Bits.hs
1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Data.Bits
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/core/LICENSE)
7 --
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
11 --
12 -- $Id: Bits.hs,v 1.5 2002/04/24 16:31:39 simonmar Exp $
13 --
14 -- Bitwise operations.
15 --
16 -----------------------------------------------------------------------------
17
18 module Data.Bits (
19 Bits(
20 (.&.), (.|.), xor, -- :: a -> a -> a
21 complement, -- :: a -> a
22 shift, -- :: a -> Int -> a
23 rotate, -- :: a -> Int -> a
24 bit, -- :: Int -> a
25 setBit, -- :: a -> Int -> a
26 clearBit, -- :: a -> Int -> a
27 complementBit, -- :: a -> Int -> a
28 testBit, -- :: a -> Int -> Bool
29 bitSize, -- :: a -> Int
30 isSigned -- :: a -> Bool
31 ),
32 shiftL, shiftR, -- :: Bits a => a -> Int -> a
33 rotateL, rotateR, -- :: Bits a => a -> Int -> a
34 -- instance Bits Int
35 -- instance Bits Integer
36 ) where
37
38 -- Defines the @Bits@ class containing bit-based operations.
39 -- See library document for details on the semantics of the
40 -- individual operations.
41
42 #ifdef __GLASGOW_HASKELL__
43 #include "MachDeps.h"
44 import GHC.Num
45 import GHC.Real
46 import GHC.Base
47 #endif
48
49 --ADR: The fixity for .|. conflicts with that for .|. in Fran.
50 -- Removing all fixities is a fairly safe fix; fixing the "one fixity
51 -- per symbol per program" limitation in Hugs would take a lot longer.
52 #ifndef __HUGS__
53 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
54 infixl 7 .&.
55 infixl 6 `xor`
56 infixl 5 .|.
57 #endif
58
59 class Num a => Bits a where
60 (.&.), (.|.), xor :: a -> a -> a
61 complement :: a -> a
62 shift :: a -> Int -> a
63 rotate :: a -> Int -> a
64 bit :: Int -> a
65 setBit :: a -> Int -> a
66 clearBit :: a -> Int -> a
67 complementBit :: a -> Int -> a
68 testBit :: a -> Int -> Bool
69 bitSize :: a -> Int
70 isSigned :: a -> Bool
71
72 bit i = 1 `shift` i
73 x `setBit` i = x .|. bit i
74 x `clearBit` i = x .&. complement (bit i)
75 x `complementBit` i = x `xor` bit i
76 x `testBit` i = (x .&. bit i) /= 0
77
78 shiftL, shiftR :: Bits a => a -> Int -> a
79 rotateL, rotateR :: Bits a => a -> Int -> a
80 x `shiftL` i = x `shift` i
81 x `shiftR` i = x `shift` (-i)
82 x `rotateL` i = x `rotate` i
83 x `rotateR` i = x `rotate` (-i)
84
85 #ifdef __GLASGOW_HASKELL__
86 instance Bits Int where
87 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
88 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
89 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
90 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
91 (I# x#) `shift` (I# i#)
92 | i# >=# 0# = I# (x# `iShiftL#` i#)
93 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
94 (I# x#) `rotate` (I# i#) =
95 I# (word2Int# ((x'# `shiftL#` i'#) `or#`
96 (x'# `shiftRL#` (wsib -# i'#))))
97 where
98 x'# = int2Word# x#
99 i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
100 wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
101 bitSize _ = WORD_SIZE_IN_BITS
102 isSigned _ = True
103
104 instance Bits Integer where
105 (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
106 x@(S# _) .&. y = toBig x .&. y
107 x .&. y@(S# _) = x .&. toBig y
108 (J# s1 d1) .&. (J# s2 d2) =
109 case andInteger# s1 d1 s2 d2 of
110 (# s, d #) -> J# s d
111
112 (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
113 x@(S# _) .|. y = toBig x .|. y
114 x .|. y@(S# _) = x .|. toBig y
115 (J# s1 d1) .|. (J# s2 d2) =
116 case orInteger# s1 d1 s2 d2 of
117 (# s, d #) -> J# s d
118
119 (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
120 x@(S# _) `xor` y = toBig x `xor` y
121 x `xor` y@(S# _) = x `xor` toBig y
122 (J# s1 d1) `xor` (J# s2 d2) =
123 case xorInteger# s1 d1 s2 d2 of
124 (# s, d #) -> J# s d
125
126 complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
127 complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
128
129 shift x i | i >= 0 = x * 2^i
130 | otherwise = x `div` 2^(-i)
131
132 rotate x i = shift x i -- since an Integer never wraps around
133
134 bitSize _ = error "Bits.bitSize(Integer)"
135 isSigned _ = True
136 #endif