1{-# LANGUAGE CPP #-} 2{-# LANGUAGE MagicHash #-} 3{-# LANGUAGE UnboxedTuples #-} 4{-# LANGUAGE DeriveDataTypeable #-} 5module Basement.Types.Word256 6 ( Word256(..) 7 , (+) 8 , (-) 9 , (*) 10 , quot 11 , rem 12 , bitwiseAnd 13 , bitwiseOr 14 , bitwiseXor 15 , complement 16 , shiftL 17 , shiftR 18 , rotateL 19 , rotateR 20 , popCount 21 , fromNatural 22 ) where 23 24import GHC.Prim 25import GHC.Word 26import GHC.Types 27import qualified Prelude (fromInteger, show, Num(..), quot, rem, mod) 28import Data.Bits hiding (complement, popCount, bit, testBit 29 , rotateL, rotateR, shiftL, shiftR) 30import qualified Data.Bits as Bits 31import Data.Function (on) 32import Foreign.C 33import Foreign.Ptr 34import Foreign.Storable 35 36import Basement.Compat.Base 37import Basement.Compat.Natural 38import Basement.Compat.Primitive (bool#) 39import Basement.Numerical.Conversion 40import Basement.Numerical.Number 41 42#include "MachDeps.h" 43 44-- | 256 bits Word 45data Word256 = Word256 {-# UNPACK #-} !Word64 46 {-# UNPACK #-} !Word64 47 {-# UNPACK #-} !Word64 48 {-# UNPACK #-} !Word64 49 deriving (Eq, Typeable) 50 51instance Show Word256 where 52 show w = Prelude.show (toNatural w) 53instance Enum Word256 where 54 toEnum i = Word256 0 0 0 $ int64ToWord64 (intToInt64 i) 55 fromEnum (Word256 _ _ _ a0) = wordToInt (word64ToWord a0) 56 succ (Word256 a3 a2 a1 a0) 57 | a0 == maxBound = 58 if a1 == maxBound 59 then if a2 == maxBound 60 then Word256 (succ a3) 0 0 0 61 else Word256 a3 (succ a2) 0 0 62 else Word256 a3 a2 (succ a1) 0 63 | otherwise = Word256 a3 a2 a1 (succ a0) 64 pred (Word256 a3 a2 a1 a0) 65 | a0 == minBound = 66 if a1 == minBound 67 then if a2 == minBound 68 then Word256 (pred a3) maxBound maxBound maxBound 69 else Word256 a3 (pred a2) maxBound maxBound 70 else Word256 a3 a2 (pred a1) maxBound 71 | otherwise = Word256 a3 a2 a1 (pred a0) 72instance Bounded Word256 where 73 minBound = Word256 minBound minBound minBound minBound 74 maxBound = Word256 maxBound maxBound maxBound maxBound 75instance Ord Word256 where 76 compare (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) = 77 compareEq a3 b3 $ compareEq a2 b2 $ compareEq a1 b1 $ compare a0 b0 78 where compareEq x y next = 79 case compare x y of 80 EQ -> next 81 r -> r 82 (<) (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) = 83 compareLt a3 b3 $ compareLt a2 b2 $ compareLt a1 b1 (a0 < b0) 84 where compareLt x y next = 85 case compare x y of 86 EQ -> next 87 r -> r == LT 88instance Storable Word256 where 89 sizeOf _ = 32 90 alignment _ = 32 91 peek p = Word256 <$> peek (castPtr p ) 92 <*> peek (castPtr p `plusPtr` 8) 93 <*> peek (castPtr p `plusPtr` 16) 94 <*> peek (castPtr p `plusPtr` 24) 95 poke p (Word256 a3 a2 a1 a0) = do 96 poke (castPtr p ) a3 97 poke (castPtr p `plusPtr` 8 ) a2 98 poke (castPtr p `plusPtr` 16) a1 99 poke (castPtr p `plusPtr` 24) a0 100 101instance Integral Word256 where 102 fromInteger = literal 103instance HasNegation Word256 where 104 negate = complement 105 106instance IsIntegral Word256 where 107 toInteger (Word256 a3 a2 a1 a0) = 108 (toInteger a3 `Bits.unsafeShiftL` 192) Bits..|. 109 (toInteger a2 `Bits.unsafeShiftL` 128) Bits..|. 110 (toInteger a1 `Bits.unsafeShiftL` 64) Bits..|. 111 toInteger a0 112instance IsNatural Word256 where 113 toNatural (Word256 a3 a2 a1 a0) = 114 (toNatural a3 `Bits.unsafeShiftL` 192) Bits..|. 115 (toNatural a2 `Bits.unsafeShiftL` 128) Bits..|. 116 (toNatural a1 `Bits.unsafeShiftL` 64) Bits..|. 117 toNatural a0 118 119instance Prelude.Num Word256 where 120 abs w = w 121 signum w@(Word256 a3 a2 a1 a0) 122 | a3 == 0 && a2 == 0 && a1 == 0 && a0 == 0 = w 123 | otherwise = Word256 0 0 0 1 124 fromInteger = literal 125 (+) = (+) 126 (-) = (-) 127 (*) = (*) 128 129instance Bits.Bits Word256 where 130 (.&.) = bitwiseAnd 131 (.|.) = bitwiseOr 132 xor = bitwiseXor 133 complement = complement 134 shiftL = shiftL 135 shiftR = shiftR 136 rotateL = rotateL 137 rotateR = rotateR 138 bitSize _ = 256 139 bitSizeMaybe _ = Just 256 140 isSigned _ = False 141 testBit = testBit 142 bit = bit 143 popCount = popCount 144 145-- | Add 2 Word256 146(+) :: Word256 -> Word256 -> Word256 147#if WORD_SIZE_IN_BITS < 64 148(+) = applyBiWordOnNatural (Prelude.+) 149#else 150(+) (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) 151 (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = 152 Word256 (W64# s3) (W64# s2) (W64# s1) (W64# s0) 153 where 154 !(# c0, s0 #) = plusWord2# a0 b0 155 !(# c1, s1 #) = plusWord3# a1 b1 c0 156 !(# c2, s2 #) = plusWord3# a2 b2 c1 157 !s3 = plusWord3NoCarry# a3 b3 c2 158 159 plusWord3NoCarry# a b c = plusWord# (plusWord# a b) c 160 plusWord3# a b c 161 | bool# (eqWord# carry 0##) = plusWord2# x c 162 | otherwise = 163 case plusWord2# x c of 164 (# carry2, x' #) 165 | bool# (eqWord# carry2 0##) -> (# carry, x' #) 166 | otherwise -> (# plusWord# carry carry2, x' #) 167 where 168 (# carry, x #) = plusWord2# a b 169#endif 170 171-- temporary available until native operation available 172applyBiWordOnNatural :: (Natural -> Natural -> Natural) 173 -> Word256 174 -> Word256 175 -> Word256 176applyBiWordOnNatural f = (fromNatural .) . (f `on` toNatural) 177 178-- | Subtract 2 Word256 179(-) :: Word256 -> Word256 -> Word256 180(-) a b 181 | a >= b = applyBiWordOnNatural (Prelude.-) a b 182 | otherwise = complement (applyBiWordOnNatural (Prelude.-) b a) + 1 183 184-- | Multiplication 185(*) :: Word256 -> Word256 -> Word256 186(*) = applyBiWordOnNatural (Prelude.*) 187 188-- | Division 189quot :: Word256 -> Word256 -> Word256 190quot = applyBiWordOnNatural Prelude.quot 191 192-- | Modulo 193rem :: Word256 -> Word256 -> Word256 194rem = applyBiWordOnNatural Prelude.rem 195 196-- | Bitwise and 197bitwiseAnd :: Word256 -> Word256 -> Word256 198bitwiseAnd (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) = 199 Word256 (a3 Bits..&. b3) (a2 Bits..&. b2) (a1 Bits..&. b1) (a0 Bits..&. b0) 200 201-- | Bitwise or 202bitwiseOr :: Word256 -> Word256 -> Word256 203bitwiseOr (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) = 204 Word256 (a3 Bits..|. b3) (a2 Bits..|. b2) (a1 Bits..|. b1) (a0 Bits..|. b0) 205 206-- | Bitwise xor 207bitwiseXor :: Word256 -> Word256 -> Word256 208bitwiseXor (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) = 209 Word256 (a3 `Bits.xor` b3) (a2 `Bits.xor` b2) (a1 `Bits.xor` b1) (a0 `Bits.xor` b0) 210 211-- | Bitwise complement 212complement :: Word256 -> Word256 213complement (Word256 a3 a2 a1 a0) = 214 Word256 (Bits.complement a3) (Bits.complement a2) (Bits.complement a1) (Bits.complement a0) 215 216-- | Population count 217popCount :: Word256 -> Int 218popCount (Word256 a3 a2 a1 a0) = 219 Bits.popCount a3 Prelude.+ 220 Bits.popCount a2 Prelude.+ 221 Bits.popCount a1 Prelude.+ 222 Bits.popCount a0 223 224-- | Bitwise Shift Left 225shiftL :: Word256 -> Int -> Word256 226shiftL w@(Word256 a3 a2 a1 a0) n 227 | n < 0 || n > 255 = Word256 0 0 0 0 228 | n == 0 = w 229 | n == 64 = Word256 a2 a1 a0 0 230 | n == 128 = Word256 a1 a0 0 0 231 | n == 192 = Word256 a0 0 0 0 232 | n < 64 = mkWordShift a3 a2 a1 a0 n 233 | n < 128 = mkWordShift a2 a1 a0 0 (n Prelude.- 64) 234 | n < 192 = mkWordShift a1 a0 0 0 (n Prelude.- 128) 235 | otherwise = mkWordShift a0 0 0 0 (n Prelude.- 192) 236 where 237 mkWordShift :: Word64 -> Word64 -> Word64 -> Word64 -> Int -> Word256 238 mkWordShift w x y z s = 239 Word256 (comb64 w s x s') (comb64 x s y s') (comb64 y s z s') (z `Bits.unsafeShiftL` s) 240 where s' = inv64 s 241 242-- | Bitwise Shift Right 243shiftR :: Word256 -> Int -> Word256 244shiftR w@(Word256 a3 a2 a1 a0) n 245 | n < 0 || n > 255 = Word256 0 0 0 0 246 | n == 0 = w 247 | n == 64 = Word256 0 a3 a2 a1 248 | n == 128 = Word256 0 0 a3 a2 249 | n == 192 = Word256 0 0 0 a3 250 | n < 64 = mkWordShift a3 a2 a1 a0 n 251 | n < 128 = mkWordShift 0 a3 a2 a1 (n Prelude.- 64) 252 | n < 192 = mkWordShift 0 0 a3 a2 (n Prelude.- 128) 253 | otherwise = Word256 0 0 0 (a3 `Bits.unsafeShiftR` (n Prelude.- 192)) 254 where 255 mkWordShift :: Word64 -> Word64 -> Word64 -> Word64 -> Int -> Word256 256 mkWordShift w x y z s = 257 Word256 (w `Bits.unsafeShiftR` s) (comb64 w s' x s) (comb64 x s' y s) (comb64 y s' z s) 258 where s' = inv64 s 259 260-- | Bitwise rotate Left 261rotateL :: Word256 -> Int -> Word256 262rotateL (Word256 a3 a2 a1 a0) n' 263 | n == 0 = Word256 a3 a2 a1 a0 264 | n == 192 = Word256 a0 a3 a2 a1 265 | n == 128 = Word256 a1 a0 a3 a2 266 | n == 64 = Word256 a2 a1 a0 a3 267 | n < 64 = Word256 (comb64 a3 n a2 (inv64 n)) (comb64 a2 n a1 (inv64 n)) 268 (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a3 (inv64 n)) 269 | n < 128 = let n = n Prelude.- 64 in Word256 270 (comb64 a2 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n)) 271 (comb64 a0 n a3 (inv64 n)) (comb64 a3 n a2 (inv64 n)) 272 | n < 192 = let n = n Prelude.- 128 in Word256 273 (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a3 (inv64 n)) 274 (comb64 a3 n a2 (inv64 n)) (comb64 a2 n a1 (inv64 n)) 275 | otherwise = let n = n Prelude.- 192 in Word256 276 (comb64 a0 n a3 (inv64 n)) (comb64 a3 n a2 (inv64 n)) 277 (comb64 a2 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n)) 278 where 279 n :: Int 280 n | n' >= 0 = n' `Prelude.mod` 256 281 | otherwise = 256 Prelude.- (n' `Prelude.mod` 256) 282 283-- | Bitwise rotate Left 284rotateR :: Word256 -> Int -> Word256 285rotateR w n = rotateL w (256 Prelude.- n) 286 287inv64 :: Int -> Int 288inv64 i = 64 Prelude.- i 289 290comb64 :: Word64 -> Int -> Word64 -> Int -> Word64 291comb64 x i y j = 292 (x `Bits.unsafeShiftL` i) .|. (y `Bits.unsafeShiftR` j) 293 294-- | Test bit 295testBit :: Word256 -> Int -> Bool 296testBit (Word256 a3 a2 a1 a0) n 297 | n < 0 || n > 255 = False 298 | n > 191 = Bits.testBit a3 (n Prelude.- 192) 299 | n > 127 = Bits.testBit a2 (n Prelude.- 128) 300 | n > 63 = Bits.testBit a1 (n Prelude.- 64) 301 | otherwise = Bits.testBit a0 n 302 303-- | bit 304bit :: Int -> Word256 305bit n 306 | n < 0 || n > 255 = Word256 0 0 0 0 307 | n > 191 = Word256 (Bits.bit (n Prelude.- 192)) 0 0 0 308 | n > 127 = Word256 0 (Bits.bit (n Prelude.- 128)) 0 0 309 | n > 63 = Word256 0 0 (Bits.bit (n Prelude.- 64)) 0 310 | otherwise = Word256 0 0 0 (Bits.bit n) 311 312literal :: Integer -> Word256 313literal i = Word256 314 (Prelude.fromInteger (i `Bits.unsafeShiftR` 192)) 315 (Prelude.fromInteger (i `Bits.unsafeShiftR` 128)) 316 (Prelude.fromInteger (i `Bits.unsafeShiftR` 64)) 317 (Prelude.fromInteger i) 318 319fromNatural :: Natural -> Word256 320fromNatural n = Word256 321 (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 192)) 322 (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 128)) 323 (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 64)) 324 (Prelude.fromInteger $ naturalToInteger n) 325