Commit 1bc1672f authored by Stefan Monnier's avatar Stefan Monnier

* lisp/calc/calc.el: Take advantage of native bignums.

Remove redundant :group args.

(calc-trail-mode): Use inhibit-read-only.
(math-bignum-digit-length, math-bignum-digit-size)
(math-small-integer-size): Delete constants.
(math-normalize): Use native bignums.
(math-bignum, math-bignum-big): Delete functions.
(math-make-float): The mantissa can't be a calc bignum any more.
(math-neg, math-scale-left, math-scale-right, math-scale-rounding)
(math-add, math-sub, math-mul, math-idivmod, math-quotient)
(math-format-number, math-read-number, math-read-number-simple):
Don't bother handling calc bignums.
(math-div10-bignum, math-scale-left-bignum, math-scale-right-bignum)
(math-add-bignum, math-sub-bignum, math-mul-bignum, math-mul-bignum-digit)
(math-div-bignum, math-div-bignum-digit, math-div-bignum-big)
(math-div-bignum-part, math-div-bignum-try, math-format-bignum)
(math-format-bignum-decimal, math-read-bignum): Delete functions.
(math-numdigs): Don't presume that native ints are small enough to use
a slow algorithm.

* lisp/calc/calc-aent.el (calc-do-quick-calc):
* lisp/calc/calc-vec.el (calcFunc-vunpack):
* lisp/calc/calc-alg.el (math-beforep): Don't bother handling calc bignums.

* lisp/calc/calc-bin.el (math-bignum-logb-digit-size)
(math-bignum-digit-power-of-two): Remove constants.
(calcFunc-and, math-binary-arg, calcFunc-or, calcFunc-xor)
(calcFunc-diff, calcFunc-not, math-clip, math-format-twos-complement):
Use Emacs's builtin bignums.
(math-and-bignum, math-or-bignum, math-xor-bignum, math-diff-bignum)
(math-not-bignum, math-clip-bignum)
(math-format-bignum-radix, math-format-bignum-binary)
(math-format-bignum-octal, math-format-bignum-hex): Delete functions.
(math-format-binary): Fix old copy&paste error.

* lisp/calc/calc-comb.el (calc-prime-factors): Adjust for unused arg.
(math-prime-test): math-fixnum is now the identity.

* lisp/calc/calc-ext.el: Require cl-lib.
(math-oddp): Use cl-oddp.  Don't bother with calc bignums.
(math-integerp, math-natnump, math-ratp, math-realp, math-anglep)
(math-numberp, math-scalarp, math-vectorp, math-objvecp, math-primp)
(math-num-natnump, math-objectp, math-check-integer, math-compare):
Don't bother handling calc bignums.
(math-check-fixnum): Use fixnump.
(math-fixnum, math-fixnum-big, math-bignum-test): Remove functions.
(math--format-integer-fancy): Rename from math-format-bignum-fancy.
Adjust for internal bignums.

* lisp/calc/calc-funcs.el (calcFunc-besJ): Use cl-isqrt.

* lisp/calc/calc-macs.el (Math-zerop, Math-integer-negp)
(Math-integer-posp, Math-negp, Math-posp, Math-integerp)
(Math-natnump, Math-ratp, Math-realp, Math-anglep, Math-numberp)
(Math-scalarp, Math-vectorp, Math-objectp, Math-objvecp)
(Math-integer-neg, Math-primp, Math-num-integerp):
Don't bother handling calc bignums.
(Math-bignum-test): Delete function.

* lisp/calc/calc-math.el (math-use-emacs-fn): Remove unused `fx`.
(math-isqrt, math-sqrt): Use cl-isqrt.  Don't bother handling calc bignums.
(math-isqrt-bignum, math-isqrt-bignum-iter, math-isqrt-small):
Delete function.

* lisp/calc/calc-misc.el (math-fixnump, math-fixnatnump): Use fixnump.
(math-evenp): Use cl-evenp.
(math-zerop, math-negp, math-posp, math-div2): Don't bother handling
calc bignums.
(math-div2-bignum): Delete function.
parent 9552ee4d
......@@ -82,7 +82,7 @@
" ")
shortbuf buf)
(if (and (= (length alg-exp) 1)
(memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
(memq (car-safe (car alg-exp)) '(nil))
(< (length buf) 20)
(= calc-number-radix 10))
(setq buf (concat buf " ("
......
......@@ -258,9 +258,9 @@
(and (eq comp 0)
(not (equal a b))
(> (length (memq (car-safe a)
'(bigneg nil bigpos frac float)))
'(nil frac float)))
(length (memq (car-safe b)
'(bigneg nil bigpos frac float))))))))
'(nil frac float))))))))
((equal b '(neg (var inf var-inf))) nil)
((equal a '(neg (var inf var-inf))) t)
((equal a '(var inf var-inf)) nil)
......
......@@ -28,17 +28,6 @@
(require 'calc-ext)
(require 'calc-macs)
;;; Some useful numbers
(defconst math-bignum-logb-digit-size
(logb math-bignum-digit-size)
"The logb of the size of a bignum digit.
This is the largest value of B such that 2^B is less than
the size of a Calc bignum digit.")
(defconst math-bignum-digit-power-of-two
(expt 2 (logb math-bignum-digit-size))
"The largest power of 2 less than the size of a Calc bignum digit.")
;;; b-prefix binary commands.
(defun calc-and (n)
......@@ -268,18 +257,14 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
(t (math-clip (cons 'bigpos
(math-and-bignum (math-binary-arg a w)
(math-binary-arg b w)))
w))))
(t (math-clip (logand (math-binary-arg a w) (math-binary-arg b w)) w))))
(defun math-binary-arg (a w)
(if (not (Math-integerp a))
(setq a (math-trunc a)))
(if (Math-integer-negp a)
(math-not-bignum (cdr (math-bignum-test (math-sub -1 a)))
(math-abs (if w (math-trunc w) calc-word-size)))
(cdr (Math-bignum-test a))))
(if (< a 0)
(logand a (1- (ash 1 (if w (math-trunc w) calc-word-size))))
a))
(defun math-binary-modulo-args (f a b w)
(let (mod)
......@@ -310,15 +295,6 @@ the size of a Calc bignum digit.")
(funcall f a w))
mod))))
(defun math-and-bignum (a b) ; [l l l]
(and a b
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
(math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa))
(math-norm-bignum (car qb)))
math-bignum-digit-power-of-two
(logand (cdr qa) (cdr qb))))))
(defun calcFunc-or (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
(calcFunc-or a b (math-trunc w)))
......@@ -332,19 +308,7 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
(t (math-clip (cons 'bigpos
(math-or-bignum (math-binary-arg a w)
(math-binary-arg b w)))
w))))
(defun math-or-bignum (a b) ; [l l l]
(and (or a b)
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
(math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa))
(math-norm-bignum (car qb)))
math-bignum-digit-power-of-two
(logior (cdr qa) (cdr qb))))))
(t (math-clip (logior (math-binary-arg a w) (math-binary-arg b w)) w))))
(defun calcFunc-xor (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
......@@ -359,19 +323,7 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
(t (math-clip (cons 'bigpos
(math-xor-bignum (math-binary-arg a w)
(math-binary-arg b w)))
w))))
(defun math-xor-bignum (a b) ; [l l l]
(and (or a b)
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
(math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa))
(math-norm-bignum (car qb)))
math-bignum-digit-power-of-two
(logxor (cdr qa) (cdr qb))))))
(t (math-clip (logxor (math-binary-arg a w) (math-binary-arg b w)) w))))
(defun calcFunc-diff (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
......@@ -386,19 +338,9 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
(t (math-clip (cons 'bigpos
(math-diff-bignum (math-binary-arg a w)
(math-binary-arg b w)))
w))))
(defun math-diff-bignum (a b) ; [l l l]
(and a
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
(math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa))
(math-norm-bignum (car qb)))
math-bignum-digit-power-of-two
(logand (cdr qa) (lognot (cdr qb)))))))
(t (math-clip (logand (math-binary-arg a w)
(lognot (math-binary-arg b w)))
w))))
(defun calcFunc-not (a &optional w) ; [I I] [Public]
(cond ((Math-messy-integerp w)
......@@ -411,21 +353,7 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((< (or w (setq w calc-word-size)) 0)
(math-clip (calcFunc-not a (- w)) w))
(t (math-normalize
(cons 'bigpos
(math-not-bignum (math-binary-arg a w)
w))))))
(defun math-not-bignum (a w) ; [l l]
(let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
(if (<= w math-bignum-logb-digit-size)
(list (logand (lognot (cdr q))
(1- (ash 1 w))))
(math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
(- w math-bignum-logb-digit-size))
math-bignum-digit-power-of-two
(logxor (cdr q)
(1- math-bignum-digit-power-of-two))))))
(t (math-clip (lognot (math-binary-arg a w)) w))))
(defun calcFunc-lsh (a &optional n w) ; [I I] [Public]
(setq a (math-trunc a)
......@@ -525,29 +453,12 @@ the size of a Calc bignum digit.")
a
(math-sub a (math-power-of-2 (- w)))))
((Math-negp a)
(math-normalize (cons 'bigpos (math-binary-arg a w))))
((and (integerp a) (< a math-small-integer-size))
(if (> w (logb math-small-integer-size))
a
(logand a (1- (ash 1 w)))))
(t
(math-normalize
(cons 'bigpos
(math-clip-bignum (cdr (math-bignum-test (math-trunc a)))
w))))))
(math-binary-arg a w))
((integerp a)
(logand a (1- (ash 1 w))))))
(defalias 'calcFunc-clip 'math-clip)
(defun math-clip-bignum (a w) ; [l l]
(let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
(if (<= w math-bignum-logb-digit-size)
(list (logand (cdr q)
(1- (ash 1 w))))
(math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q))
(- w math-bignum-logb-digit-size))
math-bignum-digit-power-of-two
(cdr q)))))
(defvar math-max-digits-cache nil)
(defun math-compute-max-digits (w r)
(let* ((pair (+ (* r 100000) w))
......@@ -601,54 +512,12 @@ the size of a Calc bignum digit.")
(if (< a 8)
(if (< a 0)
(concat "-" (math-format-binary (- a)))
(math-format-radix a))
(aref math-binary-digits a))
(let ((s ""))
(while (> a 7)
(setq s (concat (aref math-binary-digits (% a 8)) s)
a (/ a 8)))
(concat (math-format-radix a) s))))
(defun math-format-bignum-radix (a) ; [X L]
(cond ((null a) "0")
((and (null (cdr a))
(< (car a) calc-number-radix))
(math-format-radix-digit (car a)))
(t
(let ((q (math-div-bignum-digit a calc-number-radix)))
(concat (math-format-bignum-radix (math-norm-bignum (car q)))
(math-format-radix-digit (cdr q)))))))
(defun math-format-bignum-binary (a) ; [X L]
(cond ((null a) "0")
((null (cdr a))
(math-format-binary (car a)))
(t
(let ((q (math-div-bignum-digit a 512)))
(concat (math-format-bignum-binary (math-norm-bignum (car q)))
(aref math-binary-digits (/ (cdr q) 64))
(aref math-binary-digits (% (/ (cdr q) 8) 8))
(aref math-binary-digits (% (cdr q) 8)))))))
(defun math-format-bignum-octal (a) ; [X L]
(cond ((null a) "0")
((null (cdr a))
(math-format-radix (car a)))
(t
(let ((q (math-div-bignum-digit a 512)))
(concat (math-format-bignum-octal (math-norm-bignum (car q)))
(math-format-radix-digit (/ (cdr q) 64))
(math-format-radix-digit (% (/ (cdr q) 8) 8))
(math-format-radix-digit (% (cdr q) 8)))))))
(defun math-format-bignum-hex (a) ; [X L]
(cond ((null a) "0")
((null (cdr a))
(math-format-radix (car a)))
(t
(let ((q (math-div-bignum-digit a 256)))
(concat (math-format-bignum-hex (math-norm-bignum (car q)))
(math-format-radix-digit (/ (cdr q) 16))
(math-format-radix-digit (% (cdr q) 16)))))))
(concat (math-format-binary a) s))))
;;; Decompose into integer and fractional parts, without depending
;;; on calc-internal-prec.
......@@ -665,7 +534,7 @@ the size of a Calc bignum digit.")
(list (math-scale-rounding (nth 1 a) (nth 2 a))
'(float 0 0) 0)))))
(defun math-format-radix-float (a prec)
(defun math-format-radix-float (a _prec)
(let ((fmt (car calc-float-format))
(figs (nth 1 calc-float-format))
(point calc-point-char)
......@@ -823,20 +692,14 @@ the size of a Calc bignum digit.")
(defun math-format-twos-complement (a)
"Format an integer in two's complement mode."
(let* (;(calc-leading-zeros t)
(overflow nil)
(negative nil)
(num
(cond
((or (eq a 0)
(and (Math-integer-posp a)))
(if (integerp a)
(math-format-radix a)
(math-format-bignum-radix (cdr a))))
(Math-integer-posp a))
(math-format-radix a))
((Math-integer-negp a)
(let ((newa (math-add a math-2-word-size)))
(if (integerp newa)
(math-format-radix newa)
(math-format-bignum-radix (cdr newa))))))))
(math-format-radix newa))))))
(let* ((calc-internal-prec 6)
(digs (math-compute-max-digits (math-abs calc-word-size)
calc-number-radix))
......
......@@ -211,8 +211,8 @@
(calc-invert-func)
(calc-next-prime iters))
(defun calc-prime-factors (iters)
(interactive "p")
(defun calc-prime-factors (&optional _iters)
(interactive)
(calc-slow-wrapper
(let ((res (calcFunc-prfac (calc-top-n 1))))
(if (not math-prime-factors-finished)
......@@ -806,7 +806,6 @@
((Math-integer-negp n)
'(nil))
((Math-natnum-lessp n 8000000)
(setq n (math-fixnum n))
(let ((i -1) v)
(while (and (> (% n (setq v (aref math-primes-table
(setq i (1+ i)))))
......
......@@ -25,6 +25,7 @@
(require 'calc)
(require 'calc-macs)
(require 'cl-lib)
;; Declare functions which are defined elsewhere.
(declare-function math-clip "calc-bin" (a &optional w))
......@@ -62,10 +63,10 @@
(declare-function math-format-radix-float "calc-bin" (a prec))
(declare-function math-compose-expr "calccomp" (a prec &optional div))
(declare-function math-abs "calc-arith" (a))
(declare-function math-format-bignum-binary "calc-bin" (a))
(declare-function math-format-bignum-octal "calc-bin" (a))
(declare-function math-format-bignum-hex "calc-bin" (a))
(declare-function math-format-bignum-radix "calc-bin" (a))
(declare-function math-format-binary "calc-bin" (a))
(declare-function math-format-octal "calc-bin" (a))
(declare-function math-format-hex "calc-bin" (a))
(declare-function math-format-radix "calc-bin" (a))
(declare-function math-compute-max-digits "calc-bin" (w r))
(declare-function math-map-vec "calc-vec" (f a))
(declare-function math-make-frac "calc-frac" (num den))
......@@ -779,8 +780,7 @@ math-sqr-float math-trunc-fancy math-trunc-special)
calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or
calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip
math-compute-max-digits math-convert-radix-digits math-float-parts
math-format-bignum-binary math-format-bignum-hex
math-format-bignum-octal math-format-bignum-radix math-format-binary
math-format-binary
math-format-radix math-format-radix-float math-integer-log2
math-power-of-2 math-radix-float-power)
......@@ -881,7 +881,7 @@ calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw
math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw
math-exp-minus-1-raw math-exp-raw
math-from-radians math-from-radians-2 math-hypot math-infinite-dir
math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float
math-ln-raw math-nearly-equal math-nearly-equal-float
math-nearly-zerop math-nearly-zerop-float math-nth-root
math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw
math-tan-raw math-to-radians math-to-radians-2)
......@@ -2014,11 +2014,11 @@ calc-kill calc-kill-region calc-yank))))
(defvar ,cache-prec (cond
((consp ,init) (math-numdigs (nth 1 ,init)))
(,init
(nth 1 (math-numdigs (eval ,init))))
(nth 1 (math-numdigs (eval ,init t))))
(t
-100)))
(defvar ,cache-val (cond ((consp ,init) ,init)
(,init (eval ,init))
(,init (eval ,init t))
(t ,init)))
(defvar ,last-prec -100)
(defvar ,last-val nil)
......@@ -2117,77 +2117,61 @@ calc-kill calc-kill-region calc-yank))))
;;; True if A is an odd integer. [P R R] [Public]
(defun math-oddp (a)
(if (consp a)
(and (memq (car a) '(bigpos bigneg))
(= (% (nth 1 a) 2) 1))
(/= (% a 2) 0)))
(and (integerp a) (cl-oddp a)))
;;; True if A is a small or big integer. [P x] [Public]
(defun math-integerp (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg))))
;;; True if A is an integer. [P x] [Public]
(defalias 'math-integerp #'integerp)
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
(defun math-natnump (a)
(or (natnump a)
(eq (car-safe a) 'bigpos)))
(defalias 'math-natnump #'natnump)
;;; True if A is a rational (or integer). [P x] [Public]
(defun math-ratp (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac))))
(defalias 'math-ratp #'Math-ratp)
;;; True if A is a real (or rational). [P x] [Public]
(defun math-realp (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float))))
(defalias 'math-realp #'Math-realp)
;;; True if A is a real or HMS form. [P x] [Public]
(defun math-anglep (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float hms))))
(defalias 'math-anglep #'Math-anglep)
;;; True if A is a number of any kind. [P x] [Public]
(defun math-numberp (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
(defalias 'math-numberp #'Math-numberp)
;;; True if A is a complex number or angle. [P x] [Public]
(defun math-scalarp (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
(defalias 'math-scalarp #'#'Math-scalarp)
;;; True if A is a vector. [P x] [Public]
(defun math-vectorp (a)
(eq (car-safe a) 'vec))
(defalias 'math-vectorp #'Math-vectorp)
;;; True if A is any vector or scalar data object. [P x]
(defun math-objvecp (a) ; [Public]
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx polar
hms date sdev intv mod vec incomplete))))
(memq (car-safe a) '(frac float cplx polar
hms date sdev intv mod vec
;; FIXME: Math-objvecp does not include this one!
incomplete))))
;;; True if A is an object not composed of sub-formulas . [P x] [Public]
(defun math-primp (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx polar
hms date mod var))))
(memq (car-safe a) '(frac float cplx polar
hms date mod var))))
;;; True if A is numerically (but not literally) an integer. [P x] [Public]
(defun math-messy-integerp (a)
(cond
((eq (car-safe a) 'float) (>= (nth 2 a) 0))
;; FIXME: Math-messy-integerp does not include this case!
((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
;;; True if A is numerically an integer. [P x] [Public]
(defun math-num-integerp (a)
(or (Math-integerp a)
(or (integerp a)
(Math-messy-integerp a)))
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
(defun math-num-natnump (a)
(or (natnump a)
(eq (car-safe a) 'bigpos)
(and (eq (car-safe a) 'float)
(Math-natnump (nth 1 a))
(>= (nth 2 a) 0))))
......@@ -2277,28 +2261,24 @@ calc-kill calc-kill-region calc-yank))))
;;; True if A is any scalar data object. [P x]
(defun math-objectp (a) ; [Public]
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx
polar hms date sdev intv mod))))
(memq (car-safe a) '(frac float cplx
polar hms date sdev intv mod))))
;;; Verify that A is an integer and return A in integer form. [I N; - x]
(defun math-check-integer (a) ; [Public]
(cond ((integerp a) a) ; for speed
((math-integerp a) a)
(cond ((integerp a) a)
((math-messy-integerp a)
(math-trunc a))
(t (math-reject-arg a 'integerp))))
;;; Verify that A is a small integer and return A in integer form. [S N; - x]
(defun math-check-fixnum (a &optional allow-inf) ; [Public]
(cond ((integerp a) a) ; for speed
(cond ((fixnump a) a) ; for speed
((Math-num-integerp a)
(let ((a (math-trunc a)))
(if (integerp a)
(if (fixnump a)
a
(if (or (Math-lessp most-positive-fixnum a)
(Math-lessp a (- most-positive-fixnum)))
(math-reject-arg a 'fixnump)
(math-fixnum a)))))
(math-reject-arg a 'fixnump))))
((and allow-inf (equal a '(var inf var-inf)))
most-positive-fixnum)
((and allow-inf (equal a '(neg (var inf var-inf))))
......@@ -2348,20 +2328,6 @@ If X is not an error form, return 1."
(memq t (mapcar (lambda (x) (eq (car-safe x) 'sdev)) ls))))
;;; Coerce integer A to be a small integer. [S I]
(defun math-fixnum (a)
(if (consp a)
(if (cdr a)
(if (eq (car a) 'bigneg)
(- (math-fixnum-big (cdr a)))
(math-fixnum-big (cdr a)))
0)
a))
(defun math-fixnum-big (a)
(if (cdr a)
(+ (car a) (* (math-fixnum-big (cdr a)) math-bignum-digit-size))
(car a)))
(defvar math-simplify-only nil)
(defun math-normalize-fancy (a)
......@@ -2468,12 +2434,6 @@ If X is not an error form, return 1."
(setcdr last nil)
a))))
(defun math-bignum-test (a) ; [B N; B s; b b]
(if (consp a)
a
(math-bignum 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)))
......@@ -2496,17 +2456,7 @@ If X is not an error form, return 1."
2
0))
((and (integerp a) (Math-integerp b))
(if (consp b)
(if (eq (car b) 'bigpos) -1 1)
(if (< a b) -1 1)))
((and (eq (car-safe a) 'bigpos) (Math-integerp b))
(if (eq (car-safe b) 'bigpos)
(math-compare-bignum (cdr a) (cdr b))
1))
((and (eq (car-safe a) 'bigneg) (Math-integerp b))
(if (eq (car-safe b) 'bigneg)
(math-compare-bignum (cdr b) (cdr a))
-1))
(if (< a b) -1 1))
((eq (car-safe a) 'frac)
(if (eq (car-safe b) 'frac)
(math-compare (math-mul (nth 1 a) (nth 2 b))
......@@ -3451,16 +3401,16 @@ If X is not an error form, return 1."
(list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
a))
(defun math-format-bignum-fancy (a) ; [X L]
(defun math--format-integer-fancy (a) ; [I]
(let ((str (cond ((= calc-number-radix 10)
(math-format-bignum-decimal a))
(number-to-string a))
((= calc-number-radix 2)
(math-format-bignum-binary a))
(math-format-binary a))
((= calc-number-radix 8)
(math-format-bignum-octal a))
(math-format-octal a))
((= calc-number-radix 16)
(math-format-bignum-hex a))
(t (math-format-bignum-radix a)))))
(math-format-hex a))
(t (math-format-radix a)))))
(if calc-leading-zeros
(let* ((calc-internal-prec 6)
(digs (math-compute-max-digits (math-abs calc-word-size)
......
......@@ -27,6 +27,7 @@
(require 'calc-ext)
(require 'calc-macs)
(require 'cl-lib)
(defun calc-inc-gamma (arg)
(interactive "P")
......@@ -177,7 +178,7 @@
'(float 0 0)
2)))))))
(defun math-gamma-series (sum x xinvsqr oterm n)
(defun math-gamma-series (sum x xinvsqr _oterm n)
(math-working "gamma" sum)
(let* ((bn (math-bernoulli-number n))
(term (math-mul (math-div-float (math-float (nth 1 bn))
......@@ -525,7 +526,7 @@
bj))
(t
(if (Math-lessp 100 v) (math-reject-arg v 'range))
(let* ((j (logior (+ v (math-isqrt-small (* 40 v))) 1))
(let* ((j (logior (+ v (cl-isqrt (* 40 v))) 1))
(two-over-x (math-div 2 x))
(jsum nil)
(bjp '(float 0 0))
......
......@@ -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-bignum "calc" (a))
(declare-function math-compare-bignum "calc-ext" (a b))
......@@ -70,29 +69,22 @@
;;; Faster in-line version zerop, normalized values only.
(defsubst Math-zerop (a) ; [P N]
(if (consp a)
(and (not (memq (car a) '(bigpos bigneg)))
(if (eq (car a) 'float)
(eq (nth 1 a) 0)
(math-zerop a)))
(if (eq (car a) 'float)
(eq (nth 1 a) 0)
(math-zerop a))
(eq a 0)))
(defsubst Math-integer-negp (a)
(if (consp a)
(eq (car a) 'bigneg)
(< a 0)))
(and (integerp a) (< a 0)))
(defsubst Math-integer-posp (a)
(if (consp a)
(eq (car a) 'bigpos)
(> a 0)))
(and (integerp a) (> a 0)))
(defsubst Math-negp (a)
(if (consp a)
(or (eq (car a) 'bigneg)