Word64 patch

[Ian Lynagh]

--jI8keyz6grp/JLjh
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline


Hi all

The Word64 type distributed with hugs (including the latest beta
(Jan 2001) against which this patch was created) appears to be
somewhat lacking in features that might make it useful. The attached
patch makes it an instance of Num, Bits, Integral, Real and Enum.

I haven't looked at the hugs internals where this would probably be
better done, but this is probably the easier fix in the meantime.
There are a few places it goes via Integer - if I get a minute I'll
try to think if any of them can be easily removed.

Warning: This is pretty much untested, but it parsed OK...


Thanks
Ian


--jI8keyz6grp/JLjh
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="Word64.patch"

--- Word.orig.hs	Fri Feb  9 21:53:28 2001
+++ Word.hs	Fri Feb  9 22:04:47 2001
@@ -292,6 +292,81 @@
 instance Read Word64 where
   readsPrec p s = [ (integerToW64 x,r) | (x,r) <- readDec s ]
 
+binop64 :: (Word32 -> Word32 -> Word32) -> Word64 -> Word64 -> Word64
+binop64 f W64{lo = lo_a, hi = hi_a} W64{lo = lo_b, hi = hi_b}
+ = W64{lo = f lo_a lo_b, hi = f hi_a hi_b}
+
+monop64 :: (Word32 -> Word32) -> Word64 -> Word64
+monop64 f W64{lo = lo, hi = hi} = W64{lo = f lo, hi = f hi}
+
+binopi64 :: (Integer -> Integer -> Integer) -> Word64 -> Word64 -> Word64
+binopi64 f a b = fromInteger $ (toInteger a `f` toInteger b) `mod` (2^64)
+
+binoppi64 :: (Integer -> Integer -> (Integer, Integer))
+             -> Word64 -> Word64 -> (Word64, Word64)
+binoppi64 f a b = (fromInteger a', fromInteger b')
+ where (a', b') = toInteger a `f` toInteger b
+
+instance Num Word64 where
+ W64{lo=lo_a,hi=hi_a} + W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}
+  where lo' = lo_a + lo_b
+        hi' = hi_a + hi_b + if lo' < lo_a then 1 else 0
+ W64{lo=lo_a,hi=hi_a} - W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}
+  where lo' = lo_a - lo_b
+        hi' = hi_a - hi_b + if lo' > lo_a then 1 else 0
+ negate x = complement x - 1
+ (*) = binopi64 (*)
+ abs = id
+ signum x = if x == 0 then 0 else 1
+ fromInteger = integerToW64
+ fromInt = integerToW64 . toInteger
+
+instance Bits Word64 where
+ (.&.) = binop64 (.&.)
+ (.|.) = binop64 (.|.)
+ xor = binop64 xor
+ shift w 0 = w
+ shift W64{lo=lo,hi=hi} x
+  | x >  63 = W64{lo = 0,          hi = 0                             }
+  | x >  31 = W64{lo = 0,          hi =                shift lo (x-32)}
+  | x >   0 = W64{lo = shift lo x, hi = shift hi x .|. shift lo (x-32)}
+  | x < -63 = W64{lo = 0,                              hi = 0         }
+  | x < -31 = W64{lo =                shift hi (x+32), hi = 0         }
+  | x <   0 = W64{lo = shift lo x .|. shift hi (x+32), hi = shift hi x}
+ rotate x i = shift x i' .|. shift x (i' - 64)
+  where i' = i `mod` 64
+ complement = monop64 complement
+ bit = rotate 1
+ setBit x i = x .|. bit i
+ clearBit x i = x .&. complement (bit i)
+ complementBit x i = x `xor` bit i
+ testBit x i = x .&. bit i > 0
+ bitSize _ = 64
+ isSigned _ = False
+
+instance Integral Word64 where
+ div = binopi64 div
+ quot = binopi64 quot
+ rem = binopi64 rem
+ mod = binopi64 mod
+ quotRem = binoppi64 quotRem
+ divMod = binoppi64 divMod
+ toInteger = w64ToInteger
+ toInt = fromInteger . w64ToInteger
+ even W64{lo = lo, hi = _} = even lo
+
+instance Real Word64 where
+ toRational x = toInteger x % 1
+
+instance Enum Word64 where
+    toEnum         = fromInt
+    fromEnum       = toInt
+    enumFrom       = numericEnumFrom
+    enumFromTo     = numericEnumFromTo
+    enumFromThen   = numericEnumFromThen
+    enumFromThenTo = numericEnumFromThenTo
+
+
 -----------------------------------------------------------------------------
 -- End of exported definitions
 --

--jI8keyz6grp/JLjh--