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:
parent
f13ae2bb95
commit
c13b4fa61e
6 changed files with 14 additions and 62 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue