1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

Remove Calc bignum remnants

* lisp/calc/calc-macs.el (Math-natnum-lessp):
* lisp/calc/calc-ext.el (math-norm-bignum, math-compare-bignum):
* lisp/calc/calc-math.el (math-zerop-bignum)
(math-scale-bignum-digit-size): Remove.

* lisp/calc/calc-bin.el (math-integer-log2, calcFunc-rot, math-clip):
* lisp/calc/calc-comb.el (math-prime-test, calcFunc-prfac)
(calcFunc-totient, calcFunc-moebius):
* lisp/calc/calc-ext.el (math-gcd):
* lisp/calc/calc-funcs.el (calcFunc-betaB):
* lisp/calc/calc-math.el (math-nth-root-int-iter, calcFunc-ilog):
Replace Math-natnum-lessp with <.
This commit is contained in:
Mattias Engdegård 2020-12-06 23:35:09 +01:00
parent f13ae2bb95
commit c13b4fa61e
6 changed files with 14 additions and 62 deletions

View file

@ -224,13 +224,13 @@
(let ((i 0)
(p math-power-of-2-cache)
val)
(while (and p (Math-natnum-lessp (setq val (car p)) n))
(while (and p (< (setq val (car p)) n))
(setq p (cdr p)
i (1+ i)))
(if p
(and (equal val n)
i)
(while (Math-natnum-lessp
(while (<
(prog1
(setq val (math-mul val 2))
(setq math-power-of-2-cache (nconc math-power-of-2-cache
@ -438,7 +438,7 @@
(if (Math-integer-negp a)
(setq a (math-clip a w)))
(cond ((or (Math-integer-negp n)
(not (Math-natnum-lessp n w)))
(>= n w))
(calcFunc-rot a (math-mod n w) w))
(t
(math-add (calcFunc-lsh a (- n w) w)
@ -455,7 +455,7 @@
(math-reject-arg a 'integerp))
((< (or w (setq w calc-word-size)) 0)
(setq a (math-clip a (- w)))
(if (Math-natnum-lessp a (math-power-of-2 (- -1 w)))
(if (< a (math-power-of-2 (- -1 w)))
a
(math-sub a (math-power-of-2 (- w)))))
((math-zerop w)

View file

@ -815,7 +815,7 @@
(error "Argument must be an integer"))
((Math-integer-negp n)
'(nil))
((Math-natnum-lessp n 8000000)
((< n 8000000)
(let ((i -1) v)
(while (and (> (% n (setq v (aref math-primes-table
(setq i (1+ i)))))
@ -913,7 +913,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (Math-natnump n)
(if (Math-natnum-lessp 2 n)
(if (< 2 n)
(let (factors res p (i 0))
(while (and (not (eq n 1))
(< i (length math-primes-table)))
@ -927,7 +927,7 @@
(setq factors (nconc factors (list p))
n (car res)))
(or (eq n 1)
(Math-natnum-lessp p (car res))
(< p (car res))
(setq factors (nconc factors (list n))
n 1))
(setq i (1+ i)))
@ -946,7 +946,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (Math-natnump n)
(if (Math-natnum-lessp n 2)
(if (< n 2)
(if (Math-negp n)
(calcFunc-totient (math-abs n))
n)
@ -969,7 +969,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (and (Math-natnump n) (not (eq n 0)))
(if (Math-natnum-lessp n 2)
(if (< n 2)
(if (Math-negp n)
(calcFunc-moebius (math-abs n))
1)

View file

@ -2417,17 +2417,6 @@ If X is not an error form, return 1."
(mapcar #'math-normalize (cdr a))))))
;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
(defun math-norm-bignum (a)
(let ((digs a) (last nil))
(while digs
(or (eq (car digs) 0) (setq last digs))
(setq digs (cdr digs)))
(and last
(progn
(setcdr last nil)
a))))
;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
(defun calcFunc-sign (a &optional x)
(let ((signs (math-possible-signs a)))
@ -2542,23 +2531,6 @@ If X is not an error form, return 1."
0
2))))
;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.
(defun math-compare-bignum (a b) ; [S l l]
(let ((res 0))
(while (and a b)
(if (< (car a) (car b))
(setq res -1)
(if (> (car a) (car b))
(setq res 1)))
(setq a (cdr a)
b (cdr b)))
(if a
(progn
(while (eq (car a) 0) (setq a (cdr a)))
(if a 1 res))
(while (eq (car b) 0) (setq b (cdr b)))
(if b -1 res))))
(defun math-compare-lists (a b)
(cond ((null a) (null b))
((null b) nil)
@ -2685,7 +2657,7 @@ If X is not an error form, return 1."
(if (Math-integer-negp a) (setq a (math-neg a)))
(if (Math-integer-negp b) (setq b (math-neg b)))
(let (c)
(if (Math-natnum-lessp a b)
(if (< a b)
(setq c b b a a c))
(while (and (consp a) (not (eq b 0)))
(setq c b

View file

@ -410,7 +410,7 @@
((and (math-num-integerp b)
(if (math-negp b)
(math-reject-arg b 'range)
(Math-natnum-lessp (setq b (math-trunc b)) 20)))
(< (setq b (math-trunc b)) 20)))
(and calc-symbolic-mode (or (math-floatp a) (math-floatp b))
(math-inexact-result))
(math-mul
@ -427,7 +427,7 @@
((and (math-num-integerp a)
(if (math-negp a)
(math-reject-arg a 'range)
(Math-natnum-lessp (setq a (math-trunc a)) 20)))
(< (setq a (math-trunc a)) 20)))
(math-sub (or math-current-beta-value (calcFunc-beta a b))
(calcFunc-betaB (math-sub 1 x) b a)))
(t

View file

@ -29,7 +29,6 @@
(declare-function math-looks-negp "calc-misc" (a))
(declare-function math-posp "calc-misc" (a))
(declare-function math-compare "calc-ext" (a b))
(declare-function math-compare-bignum "calc-ext" (a b))
(defmacro calc-wrapper (&rest body)
@ -174,13 +173,6 @@
(eq (nth 1 a) b)
(= (nth 2 a) 0))))
(defsubst Math-natnum-lessp (a b)
(if (consp a)
(and (consp b)
(= (math-compare-bignum (cdr a) (cdr b)) -1))
(or (consp b)
(< a b))))
(provide 'calc-macs)
;;; calc-macs.el ends here

View file

@ -370,18 +370,6 @@ If this can't be done, return NIL."
(math-isqrt (math-floor a))
(math-floor (math-sqrt a))))
(defun math-zerop-bignum (a)
(and (eq (car a) 0)
(progn
(while (eq (car (setq a (cdr a))) 0))
(null a))))
(defun math-scale-bignum-digit-size (a n) ; [L L S]
(while (> n 0)
(setq a (cons 0 a)
n (1- n)))
a)
;;; Compute the square root of a number.
;;; [T N] if possible, else [F N] if possible, else [C N]. [Public]
(defun math-sqrt (a)
@ -666,7 +654,7 @@ If this can't be done, return NIL."
(let* ((q (math-idivmod a (math-ipow guess (1- math-nri-n))))
(s (math-add (car q) (math-mul (1- math-nri-n) guess)))
(g2 (math-idivmod s math-nri-n)))
(if (Math-natnum-lessp (car g2) guess)
(if (< (car g2) guess)
(math-nth-root-int-iter a (car g2))
(cons (and (equal (car g2) guess)
(eq (cdr q) 0)
@ -1615,7 +1603,7 @@ If this can't be done, return NIL."
(math-natnump b) (not (eq b 0)))
(if (eq b 1)
(math-reject-arg x "*Logarithm base one")
(if (Math-natnum-lessp x b)
(if (< x b)
0
(cdr (math-integer-log x b))))
(math-floor (calcFunc-log x b))))