module Data.Bits (
Bits(
(.&.), (.|.), xor,
complement,
shift,
rotate,
bit,
setBit,
clearBit,
complementBit,
testBit,
bitSize,
isSigned,
shiftL, shiftR,
unsafeShiftL, unsafeShiftR,
rotateL, rotateR,
popCount
)
) where
#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
#include "MachDeps.h"
#endif
#ifdef __GLASGOW_HASKELL__
import GHC.Num
import GHC.Base
#endif
#ifdef __HUGS__
import Hugs.Bits
#endif
infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
infixl 7 .&.
infixl 6 `xor`
infixl 5 .|.
class (Eq a, Num a) => Bits a where
(.&.) :: a -> a -> a
(.|.) :: a -> a -> a
xor :: a -> a -> a
complement :: a -> a
shift :: a -> Int -> a
x `shift` i | i<0 = x `shiftR` (i)
| i>0 = x `shiftL` i
| otherwise = x
rotate :: a -> Int -> a
x `rotate` i | i<0 = x `rotateR` (i)
| i>0 = x `rotateL` i
| otherwise = x
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
bit i = 1 `shiftL` 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
shiftL :: a -> Int -> a
x `shiftL` i = x `shift` i
unsafeShiftL :: a -> Int -> a
x `unsafeShiftL` i = x `shiftL` i
shiftR :: a -> Int -> a
x `shiftR` i = x `shift` (i)
unsafeShiftR :: a -> Int -> a
x `unsafeShiftR` i = x `shiftR` i
rotateL :: a -> Int -> a
x `rotateL` i = x `rotate` i
rotateR :: a -> Int -> a
x `rotateR` i = x `rotate` (i)
popCount :: a -> Int
popCount = go 0
where
go !c 0 = c
go c w = go (c+1) (w .&. w 1)
instance Bits Int where
#ifdef __GLASGOW_HASKELL__
(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#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
(I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
(I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
(I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
(I# x#) `rotate` (I# i#) =
I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
(x'# `uncheckedShiftRL#` (wsib -# i'#))))
where
!x'# = int2Word# x#
!i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
!wsib = WORD_SIZE_IN_BITS#
bitSize _ = WORD_SIZE_IN_BITS
popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
#else /* !__GLASGOW_HASKELL__ */
#ifdef __HUGS__
(.&.) = primAndInt
(.|.) = primOrInt
xor = primXorInt
complement = primComplementInt
shift = primShiftInt
bit = primBitInt
testBit = primTestInt
bitSize _ = SIZEOF_HSINT*8
#elif defined(__NHC__)
(.&.) = nhc_primIntAnd
(.|.) = nhc_primIntOr
xor = nhc_primIntXor
complement = nhc_primIntCompl
shiftL = nhc_primIntLsh
shiftR = nhc_primIntRsh
bitSize _ = 32
#endif /* __NHC__ */
x `rotate` i
| i<0 && x<0 = let left = i+bitSize x in
((x `shift` i) .&. complement ((1) `shift` left))
.|. (x `shift` left)
| i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
| i==0 = x
| i>0 = (x `shift` i) .|. (x `shift` (ibitSize x))
#endif /* !__GLASGOW_HASKELL__ */
isSigned _ = True
#ifdef __NHC__
foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
foreign import ccall nhc_primIntOr :: Int -> Int -> Int
foreign import ccall nhc_primIntXor :: Int -> Int -> Int
foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
foreign import ccall nhc_primIntCompl :: Int -> Int
#endif /* __NHC__ */
instance Bits Integer where
#if defined(__GLASGOW_HASKELL__)
(.&.) = andInteger
(.|.) = orInteger
xor = xorInteger
complement = complementInteger
shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
| otherwise = shiftRInteger x (negateInt# i#)
#else
x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
| otherwise = x `posAnd` y
x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
| otherwise = x `posOr` y
x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
| x<0 = complement (complement x `posXOr` y)
| y<0 = complement (x `posXOr` complement y)
| otherwise = x `posXOr` y
complement a = 1 a
shift x i | i >= 0 = x * 2^i
| otherwise = x `div` 2^(i)
#endif
rotate x i = shift x i
bitSize _ = error "Data.Bits.bitSize(Integer)"
isSigned _ = True
#if !defined(__GLASGOW_HASKELL__)
posAnd, posOr, posXOr :: Integer -> Integer -> Integer
posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
longZipWith f xs [] = xs
longZipWith f [] ys = ys
longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
toInts :: Integer -> [Int]
toInts n
| n == 0 = []
| otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
where mkInt n | n > toInteger(maxBound::Int) = fromInteger (nnumInts)
| otherwise = fromInteger n
fromInts :: [Int] -> Integer
fromInts = foldr catInt 0
where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
numInts = toInteger (maxBound::Int) toInteger (minBound::Int) + 1
#endif /* !__GLASGOW_HASKELL__ */
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4