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