Wide.hs (6155B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE MagicHash #-} 3 {-# LANGUAGE NumericUnderscores #-} 4 {-# LANGUAGE ViewPatterns #-} 5 {-# LANGUAGE UnboxedSums #-} 6 {-# LANGUAGE UnboxedTuples #-} 7 {-# LANGUAGE UnliftedNewtypes #-} 8 9 -- | 10 -- Module: Data.Word.Wide 11 -- Copyright: (c) 2025 Jared Tobin 12 -- License: MIT 13 -- Maintainer: Jared Tobin <jared@ppad.tech> 14 -- 15 -- Wide words, consisting of two 'Limb's. 16 17 module Data.Word.Wide ( 18 -- * Wide Words 19 Wide(..) 20 21 -- * Construction, Conversion 22 , wide 23 , to 24 , from 25 26 -- * Bit Manipulation 27 , or 28 , and 29 , xor 30 , not 31 32 -- * Comparison 33 , eq_vartime 34 35 -- * Arithmetic 36 , add 37 , add_o 38 , sub 39 , mul 40 41 -- * Unboxed Arithmetic 42 , add_o# 43 , add_w# 44 , sub_b# 45 , sub_w# 46 , mul_w# 47 ) where 48 49 import Control.DeepSeq 50 import Data.Bits ((.|.), (.&.), (.<<.), (.>>.)) 51 import qualified Data.Bits as B 52 import Data.Word.Limb (Limb(..)) 53 import qualified Data.Word.Limb as L 54 import GHC.Exts 55 import Prelude hiding (div, mod, or, and, not, quot, rem, recip) 56 57 -- utilities ------------------------------------------------------------------ 58 59 fi :: (Integral a, Num b) => a -> b 60 fi = fromIntegral 61 {-# INLINE fi #-} 62 63 -- wide words ----------------------------------------------------------------- 64 65 -- | Little-endian wide words. 66 data Wide = Wide !(# Limb, Limb #) 67 68 instance Show Wide where 69 show = show . from 70 71 -- XX add neg 72 73 instance Num Wide where 74 (+) = add 75 (-) = sub 76 (*) = mul 77 abs = id 78 fromInteger = to 79 negate w = add (not w) (Wide (# Limb 1##, Limb 0## #)) 80 signum a = case a of 81 Wide (# Limb 0##, Limb 0## #) -> 0 82 _ -> 1 83 84 instance NFData Wide where 85 rnf (Wide a) = case a of (# _, _ #) -> () 86 87 -- construction / conversion -------------------------------------------------- 88 89 -- | Construct a 'Wide' word from low and high 'Word's. 90 wide :: Word -> Word -> Wide 91 wide (W# l) (W# h) = Wide (# Limb l, Limb h #) 92 93 -- | Convert an 'Integer' to a 'Wide' word. 94 to :: Integer -> Wide 95 to n = 96 let !size = B.finiteBitSize (0 :: Word) 97 !mask = fi (maxBound :: Word) :: Integer 98 !(W# w0) = fi (n .&. mask) 99 !(W# w1) = fi ((n .>>. size) .&. mask) 100 in Wide (# Limb w0, Limb w1 #) 101 102 -- | Convert a 'Wide' word to an 'Integer'. 103 from :: Wide -> Integer 104 from (Wide (# Limb a, Limb b #)) = 105 fi (W# b) .<<. (B.finiteBitSize (0 :: Word)) 106 .|. fi (W# a) 107 108 -- comparison ----------------------------------------------------------------- 109 110 -- | Compare 'Wide' words for equality in variable time. 111 eq_vartime :: Wide -> Wide -> Bool 112 eq_vartime (Wide (# Limb a0, Limb b0 #)) (Wide (# Limb a1, Limb b1 #)) = 113 isTrue# (andI# (eqWord# a0 a1) (eqWord# b0 b1)) 114 115 -- bits ----------------------------------------------------------------------- 116 117 or_w# :: (# Limb, Limb #) -> (# Limb, Limb #) -> (# Limb, Limb #) 118 or_w# (# a0, a1 #) (# b0, b1 #) = (# L.or# a0 b0, L.or# a1 b1 #) 119 {-# INLINE or_w# #-} 120 121 or :: Wide -> Wide -> Wide 122 or (Wide a) (Wide b) = Wide (or_w# a b) 123 124 and_w# :: (# Limb, Limb #) -> (# Limb, Limb #) -> (# Limb, Limb #) 125 and_w# (# a0, a1 #) (# b0, b1 #) = (# L.and# a0 b0, L.and# a1 b1 #) 126 {-# INLINE and_w# #-} 127 128 and :: Wide -> Wide -> Wide 129 and (Wide a) (Wide b) = Wide (and_w# a b) 130 131 xor_w# :: (# Limb, Limb #) -> (# Limb, Limb #) -> (# Limb, Limb #) 132 xor_w# (# a0, a1 #) (# b0, b1 #) = (# L.xor# a0 b0, L.xor# a1 b1 #) 133 {-# INLINE xor_w# #-} 134 135 xor :: Wide -> Wide -> Wide 136 xor (Wide a) (Wide b) = Wide (xor_w# a b) 137 138 not_w# :: (# Limb, Limb #) -> (# Limb, Limb #) 139 not_w# (# a0, a1 #) = (# L.not# a0, L.not# a1 #) 140 {-# INLINE not_w# #-} 141 142 not :: Wide -> Wide 143 not (Wide w) = Wide (not_w# w) 144 {-# INLINE not #-} 145 146 -- addition, subtraction ------------------------------------------------------ 147 148 -- | Overflowing addition, computing 'a + b', returning the sum and a 149 -- carry bit. 150 add_o# 151 :: (# Limb, Limb #) -- ^ augend 152 -> (# Limb, Limb #) -- ^ addend 153 -> (# (# Limb, Limb #), Limb #) -- ^ (# sum, carry bit #) 154 add_o# (# a0, a1 #) (# b0, b1 #) = 155 let !(# s0, c0 #) = L.add_o# a0 b0 156 !(# s1, c1 #) = L.add_c# a1 b1 c0 157 in (# (# s0, s1 #), c1 #) 158 {-# INLINE add_o# #-} 159 160 -- | Overflowing addition on 'Wide' words, computing 'a + b', returning 161 -- the sum and carry. 162 add_o 163 :: Wide -- ^ augend 164 -> Wide -- ^ addend 165 -> (Wide, Word) -- ^ (sum, carry) 166 add_o (Wide a) (Wide b) = 167 let !(# s, Limb c #) = add_o# a b 168 in (Wide s, W# c) 169 170 -- | Wrapping addition, computing 'a + b'. 171 add_w# 172 :: (# Limb, Limb #) -- ^ augend 173 -> (# Limb, Limb #) -- ^ addend 174 -> (# Limb, Limb #) -- ^ sum 175 add_w# a b = 176 let !(# c, _ #) = add_o# a b 177 in c 178 {-# INLINE add_w# #-} 179 180 -- | Wrapping addition on 'Wide' words, computing 'a + b'. 181 add :: Wide -> Wide -> Wide 182 add (Wide a) (Wide b) = Wide (add_w# a b) 183 184 -- | Borrowing subtraction, computing 'a - b' and returning the 185 -- difference with a borrow bit. 186 sub_b# 187 :: (# Limb, Limb #) -- ^ minuend 188 -> (# Limb, Limb #) -- ^ subtrahend 189 -> (# (# Limb, Limb #), Limb #) -- ^ (# difference, borrow bit #) 190 sub_b# (# a0, a1 #) (# b0, b1 #) = 191 let !(# s0, c0 #) = L.sub_b# a0 b0 (Limb 0##) 192 !(# s1, c1 #) = L.sub_b# a1 b1 c0 193 in (# (# s0, s1 #), c1 #) 194 {-# INLINE sub_b# #-} 195 196 -- | Wrapping subtraction, computing 'a - b'. 197 sub_w# 198 :: (# Limb, Limb #) -- ^ minuend 199 -> (# Limb, Limb #) -- ^ subtrahend 200 -> (# Limb, Limb #) -- ^ difference 201 sub_w# a b = 202 let !(# c, _ #) = sub_b# a b 203 in c 204 {-# INLINE sub_w# #-} 205 206 -- | Wrapping subtraction on 'Wide' words, computing 'a - b'. 207 sub :: Wide -> Wide -> Wide 208 sub (Wide a) (Wide b) = Wide (sub_w# a b) 209 210 -- multiplication ------------------------------------------------------------- 211 212 -- | Wrapping multiplication, computing 'a b'. 213 mul_w# 214 :: (# Limb, Limb #) -- ^ multiplicand 215 -> (# Limb, Limb #) -- ^ multiplier 216 -> (# Limb, Limb #) -- ^ product 217 mul_w# (# a0, a1 #) (# b0, b1 #) = 218 let !(# p0_lo, p0_hi #) = L.mul_c# a0 b0 219 !(# p1_lo, _ #) = L.mul_c# a0 b1 220 !(# p2_lo, _ #) = L.mul_c# a1 b0 221 !(# s0, _ #) = L.add_o# p0_hi p1_lo 222 !(# s1, _ #) = L.add_o# s0 p2_lo 223 in (# p0_lo, s1 #) 224 {-# INLINE mul_w# #-} 225 226 -- | Wrapping multiplication on 'Wide' words. 227 mul :: Wide -> Wide -> Wide 228 mul (Wide a) (Wide b) = Wide (mul_w# a b) 229