ref: 62044b52839f697afc20b623eb296488c02eaead
parent: 08a727c87c4c642bfc3c609c295369f9d70c0d62
author: konsumlamm <konsumlamm@gmail.com>
date: Wed Jan 8 07:32:01 EST 2025
Integer: Use Word as Digit
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -19,7 +19,6 @@
import Data.Enum
import Data.Eq
import Data.Function
-import Data.Int
import Data.Integer_Type
import Data.Integral
import Data.List
@@ -27,14 +26,15 @@
import Data.Ord
import Data.Ratio_Type
import Data.Real
+import Data.Word ()
import Numeric.Show
import Text.Show
--
--- The Integer is stored in sign-magniture format with digits in base maxD (2^31)
+-- The Integer is stored in sign-magnitude format with digits in base maxD (2^32)
-- It has the following invariants:
-- * each digit is >= 0 and < maxD
--- * least signification digits first, most significant last
+-- * least significant digits first, most significant last
-- * no trailing 0s in the digits
-- * 0 is positive
{- These definitions are in Integer_Type@@ -41,10 +41,10 @@
data Integer = I Sign [Digit]
--deriving Show
-type Digit = Int
+type Digit = Word
maxD :: Digit
-maxD = 2147483648 -- 2^31, this is used so multiplication of two digit doesn't overflow a 64 bit Int
+maxD = 4294967296 -- 2^32, this is used so multiplication of two digit doesn't overflow a 64 bit Word
data Sign = Plus | Minus
--deriving Show
@@ -158,20 +158,17 @@
sub' bi (x : xs) (y : ys) = d : sub' bo xs ys where (bo, d) = subW bi x y
sub' bi (x : xs) [] = d : sub' bo xs [] where (bo, d) = subW bi x zeroD
sub' 0 [] [] = []
-sub' _ [] _ = undefined
+sub' _ [] _ = error "impossible: xs >= ys"
-- Subtract with borrow
subW :: Digit -> Digit -> Digit -> (Digit, Digit)
subW b x y =
- let d = x - y + b
- in if d < 0 then
- (quot d maxD - 1, rem d maxD + maxD)
- else
- (quot d maxD, rem d maxD)
+ let d = maxD + x - y - b
+ in (1 - quot d maxD, rem d maxD)
-- Remove trailing 0s
trim0 :: [Digit] -> [Digit]
-trim0 = reverse . dropWhile (== (0::Int)) . reverse
+trim0 = reverse . dropWhile (== (0 :: Word)) . reverse
-- Is axs < ays?
ltW :: [Digit] -> [Digit] -> Bool
@@ -182,7 +179,7 @@
cmp (x:xs) (y:ys) = x < y || x == y && cmp xs ys
cmp [] [] = False
cmp _ _ = error "ltW.cmp"
-
+
mulI :: Integer -> Integer -> Integer
mulI (I _ []) _ = I Plus [] -- 0 * x = 0
mulI _ (I _ []) = I Plus [] -- x * 0 = 0
@@ -205,7 +202,7 @@
mulM :: [Digit] -> [Digit] -> [Digit]
mulM xs ys =
let rs = map (mulD zeroD xs) ys
- ss = zipWith (++) (map (`replicate` (0::Int)) [0::Int ..]) rs
+ ss = zipWith (++) (map (`replicate` (0 :: Word)) [0 :: Int ..]) rs
in foldl1 add ss
-- Signs:
@@ -216,7 +213,7 @@
quotRemI :: Integer -> Integer -> (Integer, Integer)
quotRemI _ (I _ []) = error "Integer: division by 0" -- n / 0
quotRemI (I _ []) _ = (I Plus [], I Plus []) -- 0 / n
-quotRemI (I sx xs) (I sy ys) | all (== (0::Int)) ys' =
+quotRemI (I sx xs) (I sy ys) | all (== (0 :: Word)) ys' =
-- All but the MSD are 0. Scale numerator accordingly and divide.
-- Then add back (the ++) the remainder we scaled off.
case quotRemD xs' y of
@@ -252,7 +249,7 @@
quotRemB xs ys =
let n = I Plus xs
d = I Plus ys
- a = I Plus $ replicate (length ys - (1::Int)) (0::Int) ++ [last ys] -- only MSD of ys
+ a = I Plus $ replicate (length ys - (1 :: Int)) (0 :: Word) ++ [last ys] -- only MSD of ys
aq = quotI n a
ar = addI d oneI
loop q r =
@@ -411,7 +408,6 @@
{-sanity :: HasCallStack => Integer -> Integer
sanity (I Minus []) = undefined
-sanity (I _ ds) | any (< 0) ds = undefined
sanity (I _ ds) | length ds > 1 && last ds == 0 = undefined
sanity i = i
-}
@@ -438,7 +434,7 @@
prop_div x (NonZero y) =
to (quotRemI x y) == toInteger x `quotRem` toInteger y
where to (a, b) = (toInteger a, toInteger b)
-
+
prop_muldiv :: Integer -> NonZero Integer -> Bool
prop_muldiv x (NonZero y) =
let (q, r) = quotRemI x y
@@ -472,5 +468,5 @@
mapM_ qc [prop_add, prop_sub, prop_mul,
prop_eq, prop_ne, prop_lt, prop_gt, prop_le, prop_ge]
mapM_ qc [prop_div, prop_muldiv]
-
+
-}
--- a/lib/Data/Integer_Type.hs
+++ b/lib/Data/Integer_Type.hs
@@ -11,14 +11,14 @@
data Sign = Plus | Minus
-type Digit = Int
+type Digit = Word
maxD :: Digit
maxD =
if _wordSize `primIntEQ` 64 then
- (2147483648::Int) -- 2^31, this is used so multiplication of two digits doesn't overflow a 64 bit Int
+ (4294967296 :: Word) -- 2^32, this is used so multiplication of two digits doesn't overflow a 64 bit Word
else if _wordSize `primIntEQ` 32 then
- (32768::Int) -- 2^15, this is used so multiplication of two digits doesn't overflow a 32 bit Int
+ (65536 :: Word) -- 2^16, this is used so multiplication of two digits doesn't overflow a 32 bit Word
else
error "Integer: unsupported word size"
@@ -25,43 +25,47 @@
-- Sadly, we also need a bunch of functions.
_intToInteger :: Int -> Integer
-_intToInteger i | i `primIntGE` 0 = I Plus (f i)
- | i `primIntEQ` ni = I Minus [0::Int,0::Int,2::Int] -- we are at minBound::Int.
- | True = I Minus (f ni)
+_intToInteger i
+ | i `primIntEQ` 0 = I Plus []
+ | i `primIntGE` 0 = f Plus (primIntToWord i)
+ | True = f Minus (primIntToWord (0 `primIntSub` i))
where
- ni = (0::Int) `primIntSub` i
- f :: Int -> [Int]
- f x = if primIntEQ x (0::Int) then [] else primIntRem x maxD : f (primIntQuot x maxD)
+ f sign i =
+ let
+ high = i `primWordQuot` maxD
+ low = i `primWordRem` maxD
+ in if high `primWordEQ` 0 then I sign [low] else I sign [low, high]
_integerToInt :: Integer -> Int
-_integerToInt (I sign ds) = s `primIntMul` i
- where
- i =
- case ds of
- [] -> 0::Int
- [d1] -> d1
- [d1,d2] -> d1 `primIntAdd` (maxD `primIntMul` d2)
- d1:d2:d3:_ -> d1 `primIntAdd` (maxD `primIntMul` (d2 `primIntAdd` (maxD `primIntMul` d3)))
- s =
- case sign of
- Plus -> 1::Int
- Minus -> 0 `primIntSub` 1
+_integerToInt x = primWordToInt (_integerToWord x)
_wordToInteger :: Word -> Integer
-_wordToInteger i = I Plus (f i)
+_wordToInteger i
+ | i `primWordEQ` 0 = I Plus []
+ | high `primWordEQ` 0 = I Plus [low]
+ | True = I Plus [low, high]
where
- f :: Word -> [Int]
- f x = if x `primWordEQ` (0::Word) then [] else primWordToInt (primWordRem x (primIntToWord maxD)) : f (primWordQuot x (primIntToWord maxD))
+ high = i `primWordQuot` maxD
+ low = i `primWordRem` maxD
_integerToWord :: Integer -> Word
-_integerToWord x = primIntToWord (_integerToInt x)
+_integerToWord (I sign ds) =
+ case sign of
+ Plus -> i
+ Minus -> 0 `primWordSub` i
+ where
+ i =
+ case ds of
+ [] -> 0 :: Word
+ [d1] -> d1
+ d1 : d2 : _ -> d1 `primWordAdd` (maxD `primWordMul` d2)
_integerToFloatW :: Integer -> FloatW
_integerToFloatW (I sign ds) = s `primFloatWMul` loop ds
where
- loop [] = 0.0::FloatW
- loop (i : is) = primFloatWFromInt i `primFloatWAdd` (primFloatWFromInt maxD `primFloatWMul` loop is)
+ loop [] = 0.0 :: FloatW
+ loop (d : ds) = primFloatWFromInt (primWordToInt d) `primFloatWAdd` (primFloatWFromInt (primWordToInt maxD) `primFloatWMul` loop ds)
s =
case sign of
- Plus -> 1.0::FloatW
+ Plus -> 1.0 :: FloatW
Minus -> 0.0 `primFloatWSub` 1.0
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -12,12 +12,13 @@
import Data.Eq
import Data.Function
import Data.Int() -- instances only
-import Data.Integer
+import Data.Integer_Type
import Data.Integral
import Data.List
import Data.Maybe_Type
import Data.Num
import Data.Ord
+import Data.Ratio_Type
import Data.Real
import Numeric.Show
import Text.Show
@@ -28,7 +29,7 @@
(*) = primWordMul
abs x = x
signum x = if x == 0 then 0 else 1
- fromInteger x = primIntToWord (_integerToInt x)
+ fromInteger = _integerToWord
instance Integral Word where
quot = primWordQuot