packages feed

wide-word (empty) → 0.1.0.0

raw patch · 8 files changed

+1020/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, ghc-prim, hspec, wide-word

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for wide-word++## 0.1.0.0  -- 2017-01-06++* First version. Released on an unsuspecting world.
+ Data/WideWord.hs view
@@ -0,0 +1,6 @@+module Data.WideWord+  ( module X+  ) where++import Data.WideWord.Int128 as X+import Data.WideWord.Word128 as X
+ Data/WideWord/Int128.hs view
@@ -0,0 +1,455 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}++-----------------------------------------------------------------------------+---- |+---- Module      :  Data.WideWord.Int128+----+---- Maintainer  :  erikd@mega-nerd.com+---- Stability   :  experimental+---- Portability :  non-portable (GHC extensions and primops)+----+---- This module provides an opaque signed 128 bit value with the usual set+---- of typeclass instances one would expect for a fixed width unsigned integer+---- type.+---- Operations like addition, subtraction and multiplication etc provide a+---- "modulo 2^128" result as one would expect from a fixed width unsigned word.+-------------------------------------------------------------------------------++#include <MachDeps.h>++module Data.WideWord.Int128+  ( Int128 (..)+  , byteSwapInt128+  , showHexInt128+  , zeroInt128+  ) where++import Data.Bits (Bits (..), FiniteBits (..), shiftL)++import Data.WideWord.Word128++import Numeric++import Foreign.Ptr (Ptr, castPtr)+import Foreign.Storable (Storable (..))++import GHC.Enum (predError, succError)+import GHC.Int+import GHC.Prim+import GHC.Real ((%))+import GHC.Word+++data Int128 = Int128+  { int128Hi64 :: {-# UNPACK #-} !Word64+  , int128Lo64 :: {-# UNPACK #-} !Word64+  }+  deriving Eq+++byteSwapInt128 :: Int128 -> Int128+byteSwapInt128 (Int128 a1 a0) = Int128 (byteSwap64 a1) (byteSwap64 a0)+++showHexInt128 :: Int128 -> String+showHexInt128 (Int128 a1 a0)+  | a1 == 0 = showHex a0 ""+  | otherwise = showHex a1 zeros ++ showHex a0 ""+  where+    h0 = showHex a0 ""+    zeros = replicate (16 - length h0) '0'++instance Show Int128 where+  show = show . toInteger++instance Read Int128 where+  readsPrec p s = [(fromInteger128 (x :: Integer), r) | (x, r) <- readsPrec p s]++instance Ord Int128 where+  compare = compare128++instance Bounded Int128 where+  minBound = Int128 0x8000000000000000 0+  maxBound = Int128 0x7fffffffffffffff maxBound++instance Enum Int128 where+  succ = succ128+  pred = pred128+  toEnum = toEnum128+  fromEnum = fromEnum128++instance Num Int128 where+  (+) = plus128+  (-) = minus128+  (*) = times128+  negate = negate128+  abs = abs128+  signum = signum128+  fromInteger = fromInteger128++instance Bits Int128 where+  (.&.) = and128+  (.|.) = or128+  xor = xor128+  complement = complement128+  shiftL = shiftL128+  unsafeShiftL = shiftL128+  shiftR = shiftR128+  unsafeShiftR = shiftR128+  rotateL = rotateL128+  rotateR = rotateR128++  bitSize _ = 128+  bitSizeMaybe _ = Just 128+  isSigned _ = False++  testBit = testBit128+  bit = bit128++  popCount = popCount128++instance FiniteBits Int128 where+  finiteBitSize _ = 128+  countLeadingZeros = countLeadingZeros128+  countTrailingZeros = countTrailingZeros128++instance Real Int128 where+  toRational x = toInteger128 x % 1++instance Integral Int128 where+  quot n d = fst (quotRem128 n d)+  rem n d = snd (quotRem128 n d)+  div n d = fst (divMod128 n d)+  mod n d = snd (divMod128 n d)+  quotRem = quotRem128+  divMod = divMod128+  toInteger = toInteger128++instance Storable Int128 where+  sizeOf _ = 2 * sizeOf (0 :: Word64)+  alignment _ = 2 * alignment (0 :: Word64)+  peek = peek128+  peekElemOff = peekElemOff128+  poke = poke128+  pokeElemOff = pokeElemOff128++-- -----------------------------------------------------------------------------+-- Rewrite rules.++{-# RULES+"fromIntegral :: Int128 -> Int128" fromIntegral = id :: Int128 -> Int128+  #-}++{-# RULES+"fromIntegral :: Int -> Int128"     fromIntegral = \(I# i#) -> Int128 (W64# 0##) (W64# (int2Word# i#))+"fromIntegral :: Word- > Int128"    fromIntegral = Int128 0 . fromIntegral+"fromIntegral :: Word32 -> Int128"  fromIntegral = Int128 0 . fromIntegral+"fromIntegral :: Word64 -> Int128"  fromIntegral = Int128 0++"fromIntegral :: Int128 -> Int"     fromIntegral = \(Int128 _ w) -> fromIntegral w+"fromIntegral :: Int128 -> Word"    fromIntegral = \(Int128 _ w) -> fromIntegral w+"fromIntegral :: Int128 -> Word32"  fromIntegral = \(Int128 _ w) -> fromIntegral w+"fromIntegral :: Int128 -> Word64"  fromIntegral = \(Int128 _ w) -> w+  #-}++-- -----------------------------------------------------------------------------+-- Functions for `Ord` instance.++compare128 :: Int128 -> Int128 -> Ordering+compare128 (Int128 a1 a0) (Int128 b1 b0) =+  case compare (int64OfWord64 a1) (int64OfWord64 b1) of+    EQ -> compare a0 b0+    LT -> LT+    GT -> GT+  where+    int64OfWord64 (W64# w) = I64# (word2Int# w)++-- -----------------------------------------------------------------------------+-- Functions for `Enum` instance.+++succ128 :: Int128 -> Int128+succ128 (Int128 a1 a0)+  | a1 == 0x7fffffffffffffff && a0 == maxBound = succError "Int128"+  | otherwise =+      case a0 + 1 of+        0 -> Int128 (a1 + 1) 0+        s -> Int128 a1 s++pred128 :: Int128 -> Int128+pred128 (Int128 a1 a0)+  | a1 == 0x8000000000000000 && a0 == 0 = predError "Int128"+  | otherwise =+      case a0 of+        0 -> Int128 (a1 - 1) maxBound+        _ -> Int128 a1 (a0 - 1)++{-# INLINABLE toEnum128 #-}+toEnum128 :: Int -> Int128+toEnum128 i = Int128 0 (toEnum i)++{-# INLINABLE fromEnum128 #-}+fromEnum128 :: Int128 -> Int+fromEnum128 (Int128 _ a0) = fromEnum a0++-- -----------------------------------------------------------------------------+-- Functions for `Num` instance.++{-# INLINABLE plus128 #-}+plus128 :: Int128 -> Int128 -> Int128+plus128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) =+  Int128 (W64# s1) (W64# s0)+  where+    (# c1, s0 #) = plusWord2# a0 b0+    s1a = plusWord# a1 b1+    s1 = plusWord# c1 s1a++{-# INLINABLE minus128 #-}+minus128 :: Int128 -> Int128 -> Int128+minus128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) =+  Int128 (W64# d1) (W64# d0)+  where+    (# d0, c1 #) = subWordC# a0 b0+    a1c = minusWord# a1 (int2Word# c1)+    d1 = minusWord# a1c b1++times128 :: Int128 -> Int128 -> Int128+times128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) =+  Int128 (W64# p1) (W64# p0)+  where+    (# c1, p0 #) = timesWord2# a0 b0+    p1a = timesWord# a1 b0+    p1b = timesWord# a0 b1+    p1c = plusWord# p1a p1b+    p1 = plusWord# p1c c1++{-# INLINABLE negate128 #-}+negate128 :: Int128 -> Int128+negate128 (Int128 (W64# a1) (W64# a0)) =+  case plusWord2# (not# a0) 1## of+    (# c, s #) -> Int128 (W64# (plusWord# (not# a1) c)) (W64# s)++{-# INLINABLE abs128 #-}+abs128 :: Int128 -> Int128+abs128 i@(Int128 a1 _)+  | testBit a1 63 = negate128 i+  | otherwise = i++{-# INLINABLE signum128 #-}+signum128 :: Int128 -> Int128+signum128 (Int128 a1 a0)+  | a1 == 0 && a0 == 0 = zeroInt128+  | testBit a1 63 = minusOneInt128+  | otherwise = oneInt128++{-# INLINABLE complement128 #-}+complement128 :: Int128 -> Int128+complement128 (Int128 a1 a0) = Int128 (complement a1) (complement a0)++fromInteger128 :: Integer -> Int128+fromInteger128 i =+  Int128 (fromIntegral $ i `shiftR` 64) (fromIntegral i)++-- -----------------------------------------------------------------------------+-- Functions for `Bits` instance.++{-# INLINABLE and128 #-}+and128 :: Int128 -> Int128 -> Int128+and128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) =+  Int128 (W64# (and# a1 b1)) (W64# (and# a0 b0))++{-# INLINABLE or128 #-}+or128 :: Int128 -> Int128 -> Int128+or128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) =+  Int128 (W64# (or# a1 b1)) (W64# (or# a0 b0))++{-# INLINABLE xor128 #-}+xor128 :: Int128 -> Int128 -> Int128+xor128 (Int128 (W64# a1) (W64# a0)) (Int128 (W64# b1) (W64# b0)) =+  Int128 (W64# (xor# a1 b1)) (W64# (xor# a0 b0))++-- Probably not worth inlining this.+shiftL128 :: Int128 -> Int -> Int128+shiftL128 w@(Int128 a1 a0) s+  | s == 0 = w+  | s < 0 = shiftL128 w (128 - (abs s `mod` 128))+  | s >= 128 = zeroInt128+  | s == 64 = Int128 a0 0+  | s > 64 = Int128 (a0 `shiftL` (s - 64)) 0+  | otherwise =+      Int128 s1 s0+      where+        s0 = a0 `shiftL` s+        s1 = a1 `shiftL` s + a0 `shiftR` (64 - s)++-- Probably not worth inlining this.+shiftR128 :: Int128 -> Int -> Int128+shiftR128 i@(Int128 a1 a0) s+  | s < 0 = zeroInt128+  | s == 0 = i+  | topBitSetWord64 a1 = complement128 (shiftR128 (complement128 i) s)+  | s >= 128 = zeroInt128+  | s == 64 = Int128 0 a1+  | s > 64 = Int128 0 (a1 `shiftR` (s - 64))+  | otherwise = Int128 s1 s0+      where+        s1 = a1 `shiftR` s+        s0 = a0 `shiftR` s + a1 `shiftL` (64 - s)++rotateL128 :: Int128 -> Int -> Int128+rotateL128 w@(Int128 a1 a0) r+  | r < 0 = zeroInt128+  | r == 0 = w+  | r >= 128 = rotateL128 w (r `mod` 128)+  | r == 64 = Int128 a0 a1+  | r > 64 = rotateL128 (Int128 a0 a1) (r `mod` 64)+  | otherwise =+      Int128 s1 s0+      where+        s0 = a0 `shiftL` r + a1 `shiftR` (64 - r)+        s1 = a1 `shiftL` r + a0 `shiftR` (64 - r)++rotateR128 :: Int128 -> Int -> Int128+rotateR128 w@(Int128 a1 a0) r+  | r < 0 = rotateR128 w (128 - (abs r `mod` 128))+  | r == 0 = w+  | r >= 128 = rotateR128 w (r `mod` 128)+  | r == 64 = Int128 a0 a1+  | r > 64 = rotateR128 (Int128 a0 a1) (r `mod` 64)+  | otherwise =+      Int128 s1 s0+      where+        s0 = a0 `shiftR` r + a1 `shiftL` (64 - r)+        s1 = a1 `shiftR` r + a0 `shiftL` (64 - r)++testBit128 :: Int128 -> Int -> Bool+testBit128 (Int128 a1 a0) i+  | i < 0 = False+  | i >= 128 = False+  | i >= 64 = testBit a1 (i - 64)+  | otherwise = testBit a0 i++bit128 :: Int -> Int128+bit128 indx+  | indx < 0 = zeroInt128+  | indx >= 128 = zeroInt128+  | otherwise = shiftL128 oneInt128 indx++popCount128 :: Int128 -> Int+popCount128 (Int128 a1 a0) = popCount a1 + popCount a0++-- -----------------------------------------------------------------------------+-- Functions for `FiniteBits` instance.++countLeadingZeros128 :: Int128 -> Int+countLeadingZeros128 (Int128 a1 a0) =+  case countLeadingZeros a1 of+    64 -> 64 +  countLeadingZeros a0+    res -> res++countTrailingZeros128 :: Int128 -> Int+countTrailingZeros128 (Int128 a1 a0) =+  case countTrailingZeros a0 of+    64 -> 64 + countTrailingZeros a1+    res -> res++-- -----------------------------------------------------------------------------+-- Functions for `Integral` instance.++quotRem128 :: Int128 -> Int128 -> (Int128, Int128)+quotRem128 numer denom+  | numerIsNegative && denomIsNegative = (word128ToInt128 wq, word128ToInt128 (negate wr))+  | numerIsNegative = (word128ToInt128 (negate wq), word128ToInt128 (negate wr))+  | denomIsNegative = (word128ToInt128 (negate wq), word128ToInt128 wr)+  | otherwise = (word128ToInt128 wq, word128ToInt128 wr)+  where+    (wq, wr) = quotRem absNumerW absDenomW+    absNumerW = int128ToWord128 $ abs128 numer+    absDenomW = int128ToWord128 $ abs128 denom+    numerIsNegative = topBitSetWord64 $ int128Hi64 numer+    denomIsNegative = topBitSetWord64 $ int128Hi64 denom+++divMod128 :: Int128 -> Int128 -> (Int128, Int128)+divMod128 numer denom+  | numerIsNegative && denomIsNegative = (word128ToInt128 wq, word128ToInt128 (negate wr))+  | numerIsNegative = (word128ToInt128 (negate $ wq + 1), word128ToInt128 (absDenomW - wr))+  | denomIsNegative = (word128ToInt128 (negate $ wq + 1), word128ToInt128 (negate $ absDenomW - wr))+  | otherwise = (word128ToInt128 wq, word128ToInt128 wr)+  where+    (wq, wr) = quotRem absNumerW absDenomW+    numerIsNegative = topBitSetWord64 $ int128Hi64 numer+    denomIsNegative = topBitSetWord64 $ int128Hi64 denom+    absNumerW = int128ToWord128 $ abs128 numer+    absDenomW = int128ToWord128 $ abs128 denom+++toInteger128 :: Int128 -> Integer+toInteger128 i@(Int128 a1 a0)+  | popCount a1 == 64 && popCount a0 == 64 = -1+  | not (testBit a1 63) = fromIntegral a1 `shiftL` 64 + fromIntegral a0+  | otherwise =+      case negate128 i of+        Int128 n1 n0 -> negate (fromIntegral n1 `shiftL` 64 + fromIntegral n0)++-- -----------------------------------------------------------------------------+-- Functions for `Integral` instance.++peek128 :: Ptr Int128 -> IO Int128+peek128 ptr =+  Int128 <$> peekElemOff (castPtr ptr) index1 <*> peekElemOff (castPtr ptr) index0++peekElemOff128 :: Ptr Int128 -> Int -> IO Int128+peekElemOff128 ptr idx =+  Int128 <$> peekElemOff (castPtr ptr) (2 * idx + index1)+            <*> peekElemOff (castPtr ptr) (2 * idx + index0)++poke128 :: Ptr Int128 -> Int128 -> IO ()+poke128 ptr (Int128 a1 a0) =+  pokeElemOff (castPtr ptr) index1 a1 >> pokeElemOff (castPtr ptr) index0 a0++pokeElemOff128 :: Ptr Int128 -> Int -> Int128 -> IO ()+pokeElemOff128 ptr idx (Int128 a1 a0) = do+  pokeElemOff (castPtr ptr) (2 * idx + index0) a0+  pokeElemOff (castPtr ptr) (2 * idx + index1) a1++-- -----------------------------------------------------------------------------+-- Helpers.++{-# INLINE int128ToWord128 #-}+int128ToWord128 :: Int128 -> Word128+int128ToWord128 (Int128 a1 a0) = Word128 a1 a0++{-# INLINE topBitSetWord64 #-}+topBitSetWord64 :: Word64 -> Bool+topBitSetWord64 w = testBit w 63++{-# INLINE word128ToInt128 #-}+word128ToInt128 :: Word128 -> Int128+word128ToInt128 (Word128 a1 a0) = Int128 a1 a0++-- -----------------------------------------------------------------------------+-- Constants.++zeroInt128 :: Int128+zeroInt128 = Int128 0 0++oneInt128 :: Int128+oneInt128 = Int128 0 1++minusOneInt128 :: Int128+minusOneInt128 = Int128 maxBound maxBound++index0, index1 :: Int+#if WORDS_BIGENDIAN+index0 = 1+index1 = 0+#else+index0 = 0+index1 = 1+#endif
+ Data/WideWord/Word128.hs view
@@ -0,0 +1,448 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}++-----------------------------------------------------------------------------+---- |+---- Module      :  Data.WideWord.Word128+----+---- Maintainer  :  erikd@mega-nerd.com+---- Stability   :  experimental+---- Portability :  non-portable (GHC extensions and primops)+----+---- This module provides an opaque unsigned 128 bit value with the usual set+---- of typeclass instances one would expect for a fixed width unsigned integer+---- type.+---- Operations like addition, subtraction and multiplication etc provide a+---- "modulo 2^128" result as one would expect from a fixed width unsigned word.+-------------------------------------------------------------------------------++#include <MachDeps.h>++module Data.WideWord.Word128+  ( Word128 (..)+  , byteSwapWord128+  , showHexWord128+  , zeroWord128+  ) where++import Data.Bits (Bits (..), FiniteBits (..), shiftL)++import Foreign.Ptr (Ptr, castPtr)+import Foreign.Storable (Storable (..))++import GHC.Base (Int (..), and#, int2Word#, minusWord#, not#, or#, plusWord#, plusWord2#+                , quotRemWord2#, subWordC#, timesWord#, timesWord2#, xor#)+import GHC.Enum (predError, succError)+import GHC.Real ((%), divZeroError)+import GHC.Word (Word64 (..), byteSwap64)++import Numeric (showHex)+++data Word128 = Word128+  { word128Hi64 :: {-# UNPACK #-} !Word64+  , word128Lo64 :: {-# UNPACK #-} !Word64+  }+  deriving Eq+++byteSwapWord128 :: Word128 -> Word128+byteSwapWord128 (Word128 a1 a0) = Word128 (byteSwap64 a1) (byteSwap64 a0)+++showHexWord128 :: Word128 -> String+showHexWord128 (Word128 a1 a0)+  | a1 == 0 = showHex a0 ""+  | otherwise = showHex a1 zeros ++ showHex a0 ""+  where+    h0 = showHex a0 ""+    zeros = replicate (16 - length h0) '0'++instance Show Word128 where+  show = show . toInteger128++instance Read Word128 where+  readsPrec p s = [(fromInteger128 (x :: Integer), r) | (x, r) <- readsPrec p s]++instance Ord Word128 where+  compare = compare128++instance Bounded Word128 where+  minBound = zeroWord128+  maxBound = Word128 maxBound maxBound++instance Enum Word128 where+  succ = succ128+  pred = pred128+  toEnum = toEnum128+  fromEnum = fromEnum128++instance Num Word128 where+  (+) = plus128+  (-) = minus128+  (*) = times128+  negate = negate128+  abs = id+  signum = signum128+  fromInteger = fromInteger128++instance Bits Word128 where+  (.&.) = and128+  (.|.) = or128+  xor = xor128+  complement = complement128+  shiftL = shiftL128+  unsafeShiftL = shiftL128+  shiftR = shiftR128+  unsafeShiftR = shiftR128+  rotateL = rotateL128+  rotateR = rotateR128++  bitSize _ = 128+  bitSizeMaybe _ = Just 128+  isSigned _ = False++  testBit = testBit128+  bit = bit128++  popCount = popCount128++instance FiniteBits Word128 where+  finiteBitSize _ = 128+  countLeadingZeros = countLeadingZeros128+  countTrailingZeros = countTrailingZeros128++instance Real Word128 where+  toRational x = toInteger128 x % 1++instance Integral Word128 where+  quot n d = fst (quotRem128 n d)+  rem n d = snd (quotRem128 n d)+  div n d = fst (quotRem128 n d)+  mod n d = snd (quotRem128 n d)+  quotRem = quotRem128+  divMod = quotRem128+  toInteger = toInteger128++instance Storable Word128 where+  sizeOf _ = 2 * sizeOf (0 :: Word64)+  alignment _ = 2 * alignment (0 :: Word64)+  peek = peek128+  peekElemOff = peekElemOff128+  poke = poke128+  pokeElemOff = pokeElemOff128++-- -----------------------------------------------------------------------------+-- Rewrite rules.++{-# RULES+"fromIntegral :: Word128 -> Word128" fromIntegral = id :: Word128 -> Word128+  #-}++{-# RULES+"fromIntegral :: Int -> Word128"     fromIntegral = \(I# i#) -> Word128 (W64# 0##) (W64# (int2Word# i#))+"fromIntegral :: Word- > Word128"    fromIntegral = Word128 0 . fromIntegral+"fromIntegral :: Word32 -> Word128"  fromIntegral = Word128 0 . fromIntegral+"fromIntegral :: Word64 -> Word128"  fromIntegral = Word128 0++"fromIntegral :: Word128 -> Int"     fromIntegral = \(Word128 _ w) -> fromIntegral w+"fromIntegral :: Word128 -> Word"    fromIntegral = \(Word128 _ w) -> fromIntegral w+"fromIntegral :: Word128 -> Word32"  fromIntegral = \(Word128 _ w) -> fromIntegral w+"fromIntegral :: Word128 -> Word64"  fromIntegral = \(Word128 _ w) -> w+  #-}++-- -----------------------------------------------------------------------------+-- Functions for `Ord` instance.++compare128 :: Word128 -> Word128 -> Ordering+compare128 (Word128 a1 a0) (Word128 b1 b0) =+  case compare a1 b1 of+    EQ -> compare a0 b0+    LT -> LT+    GT -> GT++-- -----------------------------------------------------------------------------+-- Functions for `Enum` instance.++succ128 :: Word128 -> Word128+succ128 (Word128 a1 a0)+  | a1 == maxBound && a0 == maxBound = succError "Word128"+  | otherwise =+      case a0 + 1 of+        0 -> Word128 (a1 + 1) 0+        s -> Word128 a1 s++pred128 :: Word128 -> Word128+pred128 (Word128 a1 a0)+  | a1 == 0 && a0 == 0 = predError "Word128"+  | otherwise =+      case a0 of+        0 -> Word128 (a1 - 1) maxBound+        _ -> Word128 a1 (a0 - 1)++{-# INLINABLE toEnum128 #-}+toEnum128 :: Int -> Word128+toEnum128 i = Word128 0 (toEnum i)++{-# INLINABLE fromEnum128 #-}+fromEnum128 :: Word128 -> Int+fromEnum128 (Word128 _ a0) = fromEnum a0++-- -----------------------------------------------------------------------------+-- Functions for `Num` instance.++{-# INLINABLE plus128 #-}+plus128 :: Word128 -> Word128 -> Word128+plus128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) =+  Word128 (W64# s1) (W64# s0)+  where+    (# c1, s0 #) = plusWord2# a0 b0+    s1a = plusWord# a1 b1+    s1 = plusWord# c1 s1a++{-# INLINABLE minus128 #-}+minus128 :: Word128 -> Word128 -> Word128+minus128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) =+  Word128 (W64# d1) (W64# d0)+  where+    (# d0, c1 #) = subWordC# a0 b0+    a1c = minusWord# a1 (int2Word# c1)+    d1 = minusWord# a1c b1++times128 :: Word128 -> Word128 -> Word128+times128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) =+  Word128 (W64# p1) (W64# p0)+  where+    (# c1, p0 #) = timesWord2# a0 b0+    p1a = timesWord# a1 b0+    p1b = timesWord# a0 b1+    p1c = plusWord# p1a p1b+    p1 = plusWord# p1c c1++{-# INLINABLE negate128 #-}+negate128 :: Word128 -> Word128+negate128 (Word128 (W64# a1) (W64# a0)) =+  case plusWord2# (not# a0) 1## of+    (# c, s #) -> Word128 (W64# (plusWord# (not# a1) c)) (W64# s)++{-# INLINABLE signum128 #-}+signum128 :: Word128 -> Word128+signum128 (Word128 (W64# 0##) (W64# 0##)) = zeroWord128+signum128 _ = oneWord128++fromInteger128 :: Integer -> Word128+fromInteger128 i =+  Word128 (fromIntegral $ i `shiftR` 64) (fromIntegral i)++-- -----------------------------------------------------------------------------+-- Functions for `Bits` instance.++{-# INLINABLE and128 #-}+and128 :: Word128 -> Word128 -> Word128+and128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) =+  Word128 (W64# (and# a1 b1)) (W64# (and# a0 b0))++{-# INLINABLE or128 #-}+or128 :: Word128 -> Word128 -> Word128+or128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) =+  Word128 (W64# (or# a1 b1)) (W64# (or# a0 b0))++{-# INLINABLE xor128 #-}+xor128 :: Word128 -> Word128 -> Word128+xor128 (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) =+  Word128 (W64# (xor# a1 b1)) (W64# (xor# a0 b0))++{-# INLINABLE complement128 #-}+complement128 :: Word128 -> Word128+complement128 (Word128 a1 a0) = Word128 (complement a1) (complement a0)++-- Probably not worth inlining this.+shiftL128 :: Word128 -> Int -> Word128+shiftL128 w@(Word128 a1 a0) s+  | s == 0 = w+  | s < 0 = shiftL128 w (128 - (abs s `mod` 128))+  | s >= 128 = zeroWord128+  | s == 64 = Word128 a0 0+  | s > 64 = Word128 (a0 `shiftL` (s - 64)) 0+  | otherwise =+      Word128 s1 s0+      where+        s0 = a0 `shiftL` s+        s1 = a1 `shiftL` s + a0 `shiftR` (64 - s)++-- Probably not worth inlining this.+shiftR128 :: Word128 -> Int -> Word128+shiftR128 w@(Word128 a1 a0) s+  | s < 0 = zeroWord128+  | s == 0 = w+  | s >= 128 = zeroWord128+  | s == 64 = Word128 0 a1+  | s > 64 = Word128 0 (a1 `shiftR` (s - 64))+  | otherwise =+      Word128 s1 s0+      where+        s1 = a1 `shiftR` s+        s0 = a0 `shiftR` s + a1 `shiftL` (64 - s)++rotateL128 :: Word128 -> Int -> Word128+rotateL128 w@(Word128 a1 a0) r+  | r < 0 = zeroWord128+  | r == 0 = w+  | r >= 128 = rotateL128 w (r `mod` 128)+  | r == 64 = Word128 a0 a1+  | r > 64 = rotateL128 (Word128 a0 a1) (r `mod` 64)+  | otherwise =+      Word128 s1 s0+      where+        s0 = a0 `shiftL` r + a1 `shiftR` (64 - r)+        s1 = a1 `shiftL` r + a0 `shiftR` (64 - r)++rotateR128 :: Word128 -> Int -> Word128+rotateR128 w@(Word128 a1 a0) r+  | r < 0 = rotateR128 w (128 - (abs r `mod` 128))+  | r == 0 = w+  | r >= 128 = rotateR128 w (r `mod` 128)+  | r == 64 = Word128 a0 a1+  | r > 64 = rotateR128 (Word128 a0 a1) (r `mod` 64)+  | otherwise =+      Word128 s1 s0+      where+        s0 = a0 `shiftR` r + a1 `shiftL` (64 - r)+        s1 = a1 `shiftR` r + a0 `shiftL` (64 - r)++testBit128 :: Word128 -> Int -> Bool+testBit128 (Word128 a1 a0) i+  | i < 0 = False+  | i >= 128 = False+  | i >= 64 = testBit a1 (i - 64)+  | otherwise = testBit a0 i++bit128 :: Int -> Word128+bit128 indx+  | indx < 0 = zeroWord128+  | indx >= 128 = zeroWord128+  | otherwise = shiftL128 oneWord128 indx++popCount128 :: Word128 -> Int+popCount128 (Word128 a1 a0) = popCount a1 + popCount a0++-- -----------------------------------------------------------------------------+-- Functions for `FiniteBits` instance.++countLeadingZeros128 :: Word128 -> Int+countLeadingZeros128 (Word128 a1 a0) =+  case countLeadingZeros a1 of+    64 -> 64 +  countLeadingZeros a0+    res -> res++countTrailingZeros128 :: Word128 -> Int+countTrailingZeros128 (Word128 a1 a0) =+  case countTrailingZeros a0 of+    64 -> 64 + countTrailingZeros a1+    res -> res++-- -----------------------------------------------------------------------------+-- Functions for `Integral` instance.++quotRem128 :: Word128 -> Word128 -> (Word128, Word128)+quotRem128 num@(Word128 n1 n0) den@(Word128 d1 d0)+  | n1 == 0 && d1 == 0 = quotRemTwo n0 d0+  | n1 < d1 = (zeroWord128, num)+  | d1 == 0 = quotRemThree num d0+  | otherwise = quotRemFour num den+++quotRemFour :: Word128 -> Word128 -> (Word128, Word128)+quotRemFour num@(Word128 n1 _) den@(Word128 d1 d0)+  | n1 == d1 = quotRemFourX num d0+  | otherwise = (q, r)+      where+        qtest = quot n1 d1+        diff = times128 den (Word128 0 qtest)+        (q, r) = case compare128 num diff of+                    EQ -> (Word128 0 qtest, zeroWord128)+                    GT -> (Word128 0 qtest, minus128 num diff)+                    LT -> let qx = Word128 0 (qtest - 1)+                              diffx = times128 den qx+                          in (qx, minus128 num diffx)+++{-# INLINE quotRemFourX #-}+quotRemFourX :: Word128 -> Word64 -> (Word128, Word128)+quotRemFourX num@(Word128 _ n0) d0 =+  case compare n0 d0 of+    LT -> (zeroWord128, num)+    EQ -> (oneWord128, zeroWord128)+    GT -> (Word128 0 1, Word128 0 (n0 - d0))+++{-# INLINE quotRemThree #-}+quotRemThree :: Word128 -> Word64 -> (Word128, Word128)+quotRemThree num@(Word128 n1 n0) den+  | den == 0 = divZeroError+  | den == 1 = (num, zeroWord128)+  | n1 < den = case quotRemWord2 n1 n0 den of+                (q, r) -> (Word128 0 q, Word128 0 r)+  | otherwise =+      case quotRem n1 den of+        (q1, r1) -> case quotRemWord2 r1 n0 den of+                      (q0, r0) -> (Word128 q1 q0, Word128 0 r0)++{-# INLINE quotRemWord2 #-}+quotRemWord2 :: Word64 -> Word64 -> Word64 -> (Word64, Word64)+quotRemWord2 (W64# n1) (W64# n0) (W64# d) =+  case quotRemWord2# n1 n0 d of+    (# q, r #) -> (W64# q, W64# r)+++{-# INLINE quotRemTwo #-}+quotRemTwo :: Word64 -> Word64 -> (Word128, Word128)+quotRemTwo n0 d0 =+  case quotRem n0 d0 of+    (q, r) -> (Word128 0 q, Word128 0 r)++toInteger128 :: Word128 -> Integer+toInteger128 (Word128 a1 a0) = fromIntegral a1 `shiftL` 64 + fromIntegral a0++-- -----------------------------------------------------------------------------+-- Functions for `Integral` instance.++peek128 :: Ptr Word128 -> IO Word128+peek128 ptr =+  Word128 <$> peekElemOff (castPtr ptr) index1 <*> peekElemOff (castPtr ptr) index0++peekElemOff128 :: Ptr Word128 -> Int -> IO Word128+peekElemOff128 ptr idx =+  Word128 <$> peekElemOff (castPtr ptr) (2 * idx + index1)+            <*> peekElemOff (castPtr ptr) (2 * idx + index0)++poke128 :: Ptr Word128 -> Word128 -> IO ()+poke128 ptr (Word128 a1 a0) =+  pokeElemOff (castPtr ptr) index1 a1 >> pokeElemOff (castPtr ptr) index0 a0++pokeElemOff128 :: Ptr Word128 -> Int -> Word128 -> IO ()+pokeElemOff128 ptr idx (Word128 a1 a0) = do+  pokeElemOff (castPtr ptr) (2 * idx + index0) a0+  pokeElemOff (castPtr ptr) (2 * idx + index1) a1++-- -----------------------------------------------------------------------------+-- Constants.++zeroWord128 :: Word128+zeroWord128 = Word128 0 0++oneWord128 :: Word128+oneWord128 = Word128 0 1++-- Use these indices to get the peek/poke ordering endian correct.+index0, index1 :: Int+#if WORDS_BIGENDIAN+index0 = 1+index1 = 0+#else+index0 = 0+index1 = 1+#endif
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2017, Erik de Castro Lopo+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the+   distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ test/test.hs view
@@ -0,0 +1,26 @@+import Control.Monad (when)++import Test.Data.WideWord.Int128+import Test.Data.WideWord.Word128++import Test.Hspec (Spec)+import Test.Hspec.Runner (configQuickCheckMaxSuccess, defaultConfig, hspecWithResult, summaryFailures)++import System.Exit (exitFailure, exitSuccess)++++main :: IO ()+main = do+  summary <- hspecWithResult config testAll+  when (summaryFailures summary == 0)+    exitSuccess+  exitFailure+  where+    config = defaultConfig { configQuickCheckMaxSuccess = Just 100000 }++testAll :: Spec+testAll = do+  testWord128+  testInt128+
+ wide-word.cabal view
@@ -0,0 +1,52 @@+-- Initial wide-word.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                wide-word+version:             0.1.0.0+synopsis:            Data types for large but fixed width signed and unsigned integers+description:+  A library to provide data types for large (ie > 64 bits) but fixed width signed+  and unsigned integers with the usual typeclass instances to allow them to be used+  interchangeably with `Word64`.+  .+  The types and operations are coded to be as fast as possible using strictness+  annotations, `INLINEABLE` pragmas and unboxed values and operations where+  appropriate.+homepage:            https://github.com/erikd/wide-word+license:             BSD2+license-file:        LICENSE+author:              Erik de Castro Lopo+maintainer:          erikd@mega-nerd.com+copyright:           Copyright (c) 2017 Erik de Castro Lopo <erikd@mega-nerd.com>+category:            Data+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++library+  default-language:   Haskell2010+  ghc-options:        -Wall -fwarn-tabs+  hs-source-dirs:    .++  exposed-modules:     Data.WideWord+                     , Data.WideWord.Word128+                     , Data.WideWord.Int128++  build-depends:       base                          >= 4.8         && < 5.0+                     , ghc-prim+                     , bytestring                    >= 0.10++test-suite test+  default-language:   Haskell2010+  ghc-options:        -Wall -fwarn-tabs -threaded -O2+  type:               exitcode-stdio-1.0++  main-is:            test.hs+  hs-source-dirs:     test++  build-depends:       base                          >= 4.8         && < 5.0+                     , bytestring                    >= 0.10+                     , ghc-prim+                     , hspec                         == 2.3.*+                     , QuickCheck                    == 2.9.*+                     , wide-word