aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-06-25 23:05:11 -0400
committerStefan Monnier2019-06-25 23:05:11 -0400
commit1bc1672f77d15f5f2cda29ce8ce4806bbb6ff71a (patch)
treea3b7fd9f3128dfb94129dbc35c723603557953c4
parent9552ee4df7d2ceebb8728a61d00598aa981b580c (diff)
downloademacs-1bc1672f77d15f5f2cda29ce8ce4806bbb6ff71a.tar.gz
emacs-1bc1672f77d15f5f2cda29ce8ce4806bbb6ff71a.zip
* 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.
Diffstat
-rw-r--r--lisp/calc/calc-aent.el2
-rw-r--r--lisp/calc/calc-alg.el4
-rw-r--r--lisp/calc/calc-bin.el175
-rw-r--r--lisp/calc/calc-comb.el5
-rw-r--r--lisp/calc/calc-ext.el130
-rw-r--r--lisp/calc/calc-funcs.el5
-rw-r--r--lisp/calc/calc-macs.el74
-rw-r--r--lisp/calc/calc-math.el95
-rw-r--r--lisp/calc/calc-misc.el40
-rw-r--r--lisp/calc/calc-vec.el8
-rw-r--r--lisp/calc/calc.el566
11 files changed, 168 insertions, 936 deletions
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index f16e665fc34..a03bd6039cc 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -82,7 +82,7 @@
82 " ") 82 " ")
83 shortbuf buf) 83 shortbuf buf)
84 (if (and (= (length alg-exp) 1) 84 (if (and (= (length alg-exp) 1)
85 (memq (car-safe (car alg-exp)) '(nil bigpos bigneg)) 85 (memq (car-safe (car alg-exp)) '(nil))
86 (< (length buf) 20) 86 (< (length buf) 20)
87 (= calc-number-radix 10)) 87 (= calc-number-radix 10))
88 (setq buf (concat buf " (" 88 (setq buf (concat buf " ("
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 41ffc83d86f..136b18e48f5 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -258,9 +258,9 @@
258 (and (eq comp 0) 258 (and (eq comp 0)
259 (not (equal a b)) 259 (not (equal a b))
260 (> (length (memq (car-safe a) 260 (> (length (memq (car-safe a)
261 '(bigneg nil bigpos frac float))) 261 '(nil frac float)))
262 (length (memq (car-safe b) 262 (length (memq (car-safe b)
263 '(bigneg nil bigpos frac float)))))))) 263 '(nil frac float))))))))
264 ((equal b '(neg (var inf var-inf))) nil) 264 ((equal b '(neg (var inf var-inf))) nil)
265 ((equal a '(neg (var inf var-inf))) t) 265 ((equal a '(neg (var inf var-inf))) t)
266 ((equal a '(var inf var-inf)) nil) 266 ((equal a '(var inf var-inf)) nil)
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index d979edb5fdb..b4371bdaf98 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -28,17 +28,6 @@
28(require 'calc-ext) 28(require 'calc-ext)
29(require 'calc-macs) 29(require 'calc-macs)
30 30
31;;; Some useful numbers
32(defconst math-bignum-logb-digit-size
33 (logb math-bignum-digit-size)
34 "The logb of the size of a bignum digit.
35This is the largest value of B such that 2^B is less than
36the size of a Calc bignum digit.")
37
38(defconst math-bignum-digit-power-of-two
39 (expt 2 (logb math-bignum-digit-size))
40 "The largest power of 2 less than the size of a Calc bignum digit.")
41
42;;; b-prefix binary commands. 31;;; b-prefix binary commands.
43 32
44(defun calc-and (n) 33(defun calc-and (n)
@@ -268,18 +257,14 @@ the size of a Calc bignum digit.")
268 (math-reject-arg a 'integerp)) 257 (math-reject-arg a 'integerp))
269 ((not (Math-num-integerp b)) 258 ((not (Math-num-integerp b))
270 (math-reject-arg b 'integerp)) 259 (math-reject-arg b 'integerp))
271 (t (math-clip (cons 'bigpos 260 (t (math-clip (logand (math-binary-arg a w) (math-binary-arg b w)) w))))
272 (math-and-bignum (math-binary-arg a w)
273 (math-binary-arg b w)))
274 w))))
275 261
276(defun math-binary-arg (a w) 262(defun math-binary-arg (a w)
277 (if (not (Math-integerp a)) 263 (if (not (Math-integerp a))
278 (setq a (math-trunc a))) 264 (setq a (math-trunc a)))
279 (if (Math-integer-negp a) 265 (if (< a 0)
280 (math-not-bignum (cdr (math-bignum-test (math-sub -1 a))) 266 (logand a (1- (ash 1 (if w (math-trunc w) calc-word-size))))
281 (math-abs (if w (math-trunc w) calc-word-size))) 267 a))
282 (cdr (Math-bignum-test a))))
283 268
284(defun math-binary-modulo-args (f a b w) 269(defun math-binary-modulo-args (f a b w)
285 (let (mod) 270 (let (mod)
@@ -310,15 +295,6 @@ the size of a Calc bignum digit.")
310 (funcall f a w)) 295 (funcall f a w))
311 mod)))) 296 mod))))
312 297
313(defun math-and-bignum (a b) ; [l l l]
314 (and a b
315 (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
316 (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
317 (math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa))
318 (math-norm-bignum (car qb)))
319 math-bignum-digit-power-of-two
320 (logand (cdr qa) (cdr qb))))))
321
322(defun calcFunc-or (a b &optional w) ; [I I I] [Public] 298(defun calcFunc-or (a b &optional w) ; [I I I] [Public]
323 (cond ((Math-messy-integerp w) 299 (cond ((Math-messy-integerp w)
324 (calcFunc-or a b (math-trunc w))) 300 (calcFunc-or a b (math-trunc w)))
@@ -332,19 +308,7 @@ the size of a Calc bignum digit.")
332 (math-reject-arg a 'integerp)) 308 (math-reject-arg a 'integerp))
333 ((not (Math-num-integerp b)) 309 ((not (Math-num-integerp b))
334 (math-reject-arg b 'integerp)) 310 (math-reject-arg b 'integerp))
335 (t (math-clip (cons 'bigpos 311 (t (math-clip (logior (math-binary-arg a w) (math-binary-arg b w)) w))))
336 (math-or-bignum (math-binary-arg a w)
337 (math-binary-arg b w)))
338 w))))
339
340(defun math-or-bignum (a b) ; [l l l]
341 (and (or a b)
342 (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
343 (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
344 (math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa))
345 (math-norm-bignum (car qb)))
346 math-bignum-digit-power-of-two
347 (logior (cdr qa) (cdr qb))))))
348 312
349(defun calcFunc-xor (a b &optional w) ; [I I I] [Public] 313(defun calcFunc-xor (a b &optional w) ; [I I I] [Public]
350 (cond ((Math-messy-integerp w) 314 (cond ((Math-messy-integerp w)
@@ -359,19 +323,7 @@ the size of a Calc bignum digit.")
359 (math-reject-arg a 'integerp)) 323 (math-reject-arg a 'integerp))
360 ((not (Math-num-integerp b)) 324 ((not (Math-num-integerp b))
361 (math-reject-arg b 'integerp)) 325 (math-reject-arg b 'integerp))
362 (t (math-clip (cons 'bigpos 326 (t (math-clip (logxor (math-binary-arg a w) (math-binary-arg b w)) w))))
363 (math-xor-bignum (math-binary-arg a w)
364 (math-binary-arg b w)))
365 w))))
366
367(defun math-xor-bignum (a b) ; [l l l]
368 (and (or a b)
369 (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
370 (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
371 (math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa))
372 (math-norm-bignum (car qb)))
373 math-bignum-digit-power-of-two
374 (logxor (cdr qa) (cdr qb))))))
375 327
376(defun calcFunc-diff (a b &optional w) ; [I I I] [Public] 328(defun calcFunc-diff (a b &optional w) ; [I I I] [Public]
377 (cond ((Math-messy-integerp w) 329 (cond ((Math-messy-integerp w)
@@ -386,19 +338,9 @@ the size of a Calc bignum digit.")
386 (math-reject-arg a 'integerp)) 338 (math-reject-arg a 'integerp))
387 ((not (Math-num-integerp b)) 339 ((not (Math-num-integerp b))
388 (math-reject-arg b 'integerp)) 340 (math-reject-arg b 'integerp))
389 (t (math-clip (cons 'bigpos 341 (t (math-clip (logand (math-binary-arg a w)
390 (math-diff-bignum (math-binary-arg a w) 342 (lognot (math-binary-arg b w)))
391 (math-binary-arg b w))) 343 w))))
392 w))))
393
394(defun math-diff-bignum (a b) ; [l l l]
395 (and a
396 (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
397 (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
398 (math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa))
399 (math-norm-bignum (car qb)))
400 math-bignum-digit-power-of-two
401 (logand (cdr qa) (lognot (cdr qb)))))))
402 344
403(defun calcFunc-not (a &optional w) ; [I I] [Public] 345(defun calcFunc-not (a &optional w) ; [I I] [Public]
404 (cond ((Math-messy-integerp w) 346 (cond ((Math-messy-integerp w)
@@ -411,21 +353,7 @@ the size of a Calc bignum digit.")
411 (math-reject-arg a 'integerp)) 353 (math-reject-arg a 'integerp))
412 ((< (or w (setq w calc-word-size)) 0) 354 ((< (or w (setq w calc-word-size)) 0)
413 (math-clip (calcFunc-not a (- w)) w)) 355 (math-clip (calcFunc-not a (- w)) w))
414 (t (math-normalize 356 (t (math-clip (lognot (math-binary-arg a w)) w))))
415 (cons 'bigpos
416 (math-not-bignum (math-binary-arg a w)
417 w))))))
418
419(defun math-not-bignum (a w) ; [l l]
420 (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
421 (if (<= w math-bignum-logb-digit-size)
422 (list (logand (lognot (cdr q))
423 (1- (ash 1 w))))
424 (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
425 (- w math-bignum-logb-digit-size))
426 math-bignum-digit-power-of-two
427 (logxor (cdr q)
428 (1- math-bignum-digit-power-of-two))))))
429 357
430(defun calcFunc-lsh (a &optional n w) ; [I I] [Public] 358(defun calcFunc-lsh (a &optional n w) ; [I I] [Public]
431 (setq a (math-trunc a) 359 (setq a (math-trunc a)
@@ -525,29 +453,12 @@ the size of a Calc bignum digit.")
525 a 453 a
526 (math-sub a (math-power-of-2 (- w))))) 454 (math-sub a (math-power-of-2 (- w)))))
527 ((Math-negp a) 455 ((Math-negp a)
528 (math-normalize (cons 'bigpos (math-binary-arg a w)))) 456 (math-binary-arg a w))
529 ((and (integerp a) (< a math-small-integer-size)) 457 ((integerp a)
530 (if (> w (logb math-small-integer-size)) 458 (logand a (1- (ash 1 w))))))
531 a
532 (logand a (1- (ash 1 w)))))
533 (t
534 (math-normalize
535 (cons 'bigpos
536 (math-clip-bignum (cdr (math-bignum-test (math-trunc a)))
537 w))))))
538 459
539(defalias 'calcFunc-clip 'math-clip) 460(defalias 'calcFunc-clip 'math-clip)
540 461
541(defun math-clip-bignum (a w) ; [l l]
542 (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
543 (if (<= w math-bignum-logb-digit-size)
544 (list (logand (cdr q)
545 (1- (ash 1 w))))
546 (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q))
547 (- w math-bignum-logb-digit-size))
548 math-bignum-digit-power-of-two
549 (cdr q)))))
550
551(defvar math-max-digits-cache nil) 462(defvar math-max-digits-cache nil)
552(defun math-compute-max-digits (w r) 463(defun math-compute-max-digits (w r)
553 (let* ((pair (+ (* r 100000) w)) 464 (let* ((pair (+ (* r 100000) w))
@@ -601,54 +512,12 @@ the size of a Calc bignum digit.")
601 (if (< a 8) 512 (if (< a 8)
602 (if (< a 0) 513 (if (< a 0)
603 (concat "-" (math-format-binary (- a))) 514 (concat "-" (math-format-binary (- a)))
604 (math-format-radix a)) 515 (aref math-binary-digits a))
605 (let ((s "")) 516 (let ((s ""))
606 (while (> a 7) 517 (while (> a 7)
607 (setq s (concat (aref math-binary-digits (% a 8)) s) 518 (setq s (concat (aref math-binary-digits (% a 8)) s)
608 a (/ a 8))) 519 a (/ a 8)))
609 (concat (math-format-radix a) s)))) 520 (concat (math-format-binary a) s))))
610
611(defun math-format-bignum-radix (a) ; [X L]
612 (cond ((null a) "0")
613 ((and (null (cdr a))
614 (< (car a) calc-number-radix))
615 (math-format-radix-digit (car a)))
616 (t
617 (let ((q (math-div-bignum-digit a calc-number-radix)))
618 (concat (math-format-bignum-radix (math-norm-bignum (car q)))
619 (math-format-radix-digit (cdr q)))))))
620
621(defun math-format-bignum-binary (a) ; [X L]
622 (cond ((null a) "0")
623 ((null (cdr a))
624 (math-format-binary (car a)))
625 (t
626 (let ((q (math-div-bignum-digit a 512)))
627 (concat (math-format-bignum-binary (math-norm-bignum (car q)))
628 (aref math-binary-digits (/ (cdr q) 64))
629 (aref math-binary-digits (% (/ (cdr q) 8) 8))
630 (aref math-binary-digits (% (cdr q) 8)))))))
631
632(defun math-format-bignum-octal (a) ; [X L]
633 (cond ((null a) "0")
634 ((null (cdr a))
635 (math-format-radix (car a)))
636 (t
637 (let ((q (math-div-bignum-digit a 512)))
638 (concat (math-format-bignum-octal (math-norm-bignum (car q)))
639 (math-format-radix-digit (/ (cdr q) 64))
640 (math-format-radix-digit (% (/ (cdr q) 8) 8))
641 (math-format-radix-digit (% (cdr q) 8)))))))
642
643(defun math-format-bignum-hex (a) ; [X L]
644 (cond ((null a) "0")
645 ((null (cdr a))
646 (math-format-radix (car a)))
647 (t
648 (let ((q (math-div-bignum-digit a 256)))
649 (concat (math-format-bignum-hex (math-norm-bignum (car q)))
650 (math-format-radix-digit (/ (cdr q) 16))
651 (math-format-radix-digit (% (cdr q) 16)))))))
652 521
653;;; Decompose into integer and fractional parts, without depending 522;;; Decompose into integer and fractional parts, without depending
654;;; on calc-internal-prec. 523;;; on calc-internal-prec.
@@ -665,7 +534,7 @@ the size of a Calc bignum digit.")
665 (list (math-scale-rounding (nth 1 a) (nth 2 a)) 534 (list (math-scale-rounding (nth 1 a) (nth 2 a))
666 '(float 0 0) 0))))) 535 '(float 0 0) 0)))))
667 536
668(defun math-format-radix-float (a prec) 537(defun math-format-radix-float (a _prec)
669 (let ((fmt (car calc-float-format)) 538 (let ((fmt (car calc-float-format))
670 (figs (nth 1 calc-float-format)) 539 (figs (nth 1 calc-float-format))
671 (point calc-point-char) 540 (point calc-point-char)
@@ -823,20 +692,14 @@ the size of a Calc bignum digit.")
823(defun math-format-twos-complement (a) 692(defun math-format-twos-complement (a)
824 "Format an integer in two's complement mode." 693 "Format an integer in two's complement mode."
825 (let* (;(calc-leading-zeros t) 694 (let* (;(calc-leading-zeros t)
826 (overflow nil)
827 (negative nil)
828 (num 695 (num
829 (cond 696 (cond
830 ((or (eq a 0) 697 ((or (eq a 0)
831 (and (Math-integer-posp a))) 698 (Math-integer-posp a))
832 (if (integerp a) 699 (math-format-radix a))
833 (math-format-radix a)
834 (math-format-bignum-radix (cdr a))))
835 ((Math-integer-negp a) 700 ((Math-integer-negp a)
836 (let ((newa (math-add a math-2-word-size))) 701 (let ((newa (math-add a math-2-word-size)))
837 (if (integerp newa) 702 (math-format-radix newa))))))
838 (math-format-radix newa)
839 (math-format-bignum-radix (cdr newa))))))))
840 (let* ((calc-internal-prec 6) 703 (let* ((calc-internal-prec 6)
841 (digs (math-compute-max-digits (math-abs calc-word-size) 704 (digs (math-compute-max-digits (math-abs calc-word-size)
842 calc-number-radix)) 705 calc-number-radix))
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index 02779039610..5bede650dd3 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -211,8 +211,8 @@
211 (calc-invert-func) 211 (calc-invert-func)
212 (calc-next-prime iters)) 212 (calc-next-prime iters))
213 213
214(defun calc-prime-factors (iters) 214(defun calc-prime-factors (&optional _iters)
215 (interactive "p") 215 (interactive)
216 (calc-slow-wrapper 216 (calc-slow-wrapper
217 (let ((res (calcFunc-prfac (calc-top-n 1)))) 217 (let ((res (calcFunc-prfac (calc-top-n 1))))
218 (if (not math-prime-factors-finished) 218 (if (not math-prime-factors-finished)
@@ -806,7 +806,6 @@
806 ((Math-integer-negp n) 806 ((Math-integer-negp n)
807 '(nil)) 807 '(nil))
808 ((Math-natnum-lessp n 8000000) 808 ((Math-natnum-lessp n 8000000)
809 (setq n (math-fixnum n))
810 (let ((i -1) v) 809 (let ((i -1) v)
811 (while (and (> (% n (setq v (aref math-primes-table 810 (while (and (> (% n (setq v (aref math-primes-table
812 (setq i (1+ i))))) 811 (setq i (1+ i)))))
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 4cc6b224226..bd5d4395a1c 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -25,6 +25,7 @@
25 25
26(require 'calc) 26(require 'calc)
27(require 'calc-macs) 27(require 'calc-macs)
28(require 'cl-lib)
28 29
29;; Declare functions which are defined elsewhere. 30;; Declare functions which are defined elsewhere.
30(declare-function math-clip "calc-bin" (a &optional w)) 31(declare-function math-clip "calc-bin" (a &optional w))
@@ -62,10 +63,10 @@
62(declare-function math-format-radix-float "calc-bin" (a prec)) 63(declare-function math-format-radix-float "calc-bin" (a prec))
63(declare-function math-compose-expr "calccomp" (a prec &optional div)) 64(declare-function math-compose-expr "calccomp" (a prec &optional div))
64(declare-function math-abs "calc-arith" (a)) 65(declare-function math-abs "calc-arith" (a))
65(declare-function math-format-bignum-binary "calc-bin" (a)) 66(declare-function math-format-binary "calc-bin" (a))
66(declare-function math-format-bignum-octal "calc-bin" (a)) 67(declare-function math-format-octal "calc-bin" (a))
67(declare-function math-format-bignum-hex "calc-bin" (a)) 68(declare-function math-format-hex "calc-bin" (a))
68(declare-function math-format-bignum-radix "calc-bin" (a)) 69(declare-function math-format-radix "calc-bin" (a))
69(declare-function math-compute-max-digits "calc-bin" (w r)) 70(declare-function math-compute-max-digits "calc-bin" (w r))
70(declare-function math-map-vec "calc-vec" (f a)) 71(declare-function math-map-vec "calc-vec" (f a))
71(declare-function math-make-frac "calc-frac" (num den)) 72(declare-function math-make-frac "calc-frac" (num den))
@@ -779,8 +780,7 @@ math-sqr-float math-trunc-fancy math-trunc-special)
779calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or 780calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or
780calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip 781calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip
781math-compute-max-digits math-convert-radix-digits math-float-parts 782math-compute-max-digits math-convert-radix-digits math-float-parts
782math-format-bignum-binary math-format-bignum-hex 783math-format-binary
783math-format-bignum-octal math-format-bignum-radix math-format-binary
784math-format-radix math-format-radix-float math-integer-log2 784math-format-radix math-format-radix-float math-integer-log2
785math-power-of-2 math-radix-float-power) 785math-power-of-2 math-radix-float-power)
786 786
@@ -881,7 +881,7 @@ calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw
881math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw 881math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw
882math-exp-minus-1-raw math-exp-raw 882math-exp-minus-1-raw math-exp-raw
883math-from-radians math-from-radians-2 math-hypot math-infinite-dir 883math-from-radians math-from-radians-2 math-hypot math-infinite-dir
884math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float 884math-ln-raw math-nearly-equal math-nearly-equal-float
885math-nearly-zerop math-nearly-zerop-float math-nth-root 885math-nearly-zerop math-nearly-zerop-float math-nth-root
886math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw 886math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw
887math-tan-raw math-to-radians math-to-radians-2) 887math-tan-raw math-to-radians math-to-radians-2)
@@ -2014,11 +2014,11 @@ calc-kill calc-kill-region calc-yank))))
2014 (defvar ,cache-prec (cond 2014 (defvar ,cache-prec (cond
2015 ((consp ,init) (math-numdigs (nth 1 ,init))) 2015 ((consp ,init) (math-numdigs (nth 1 ,init)))
2016 (,init 2016 (,init
2017 (nth 1 (math-numdigs (eval ,init)))) 2017 (nth 1 (math-numdigs (eval ,init t))))
2018 (t 2018 (t
2019 -100))) 2019 -100)))
2020 (defvar ,cache-val (cond ((consp ,init) ,init) 2020 (defvar ,cache-val (cond ((consp ,init) ,init)
2021 (,init (eval ,init)) 2021 (,init (eval ,init t))
2022 (t ,init))) 2022 (t ,init)))
2023 (defvar ,last-prec -100) 2023 (defvar ,last-prec -100)
2024 (defvar ,last-val nil) 2024 (defvar ,last-val nil)
@@ -2117,77 +2117,61 @@ calc-kill calc-kill-region calc-yank))))
2117 2117
2118;;; True if A is an odd integer. [P R R] [Public] 2118;;; True if A is an odd integer. [P R R] [Public]
2119(defun math-oddp (a) 2119(defun math-oddp (a)
2120 (if (consp a) 2120 (and (integerp a) (cl-oddp a)))
2121 (and (memq (car a) '(bigpos bigneg))
2122 (= (% (nth 1 a) 2) 1))
2123 (/= (% a 2) 0)))
2124 2121
2125;;; True if A is a small or big integer. [P x] [Public] 2122;;; True if A is an integer. [P x] [Public]
2126(defun math-integerp (a) 2123(defalias 'math-integerp #'integerp)
2127 (or (integerp a)
2128 (memq (car-safe a) '(bigpos bigneg))))
2129 2124
2130;;; True if A is (numerically) a non-negative integer. [P N] [Public] 2125;;; True if A is (numerically) a non-negative integer. [P N] [Public]
2131(defun math-natnump (a) 2126(defalias 'math-natnump #'natnump)
2132 (or (natnump a)
2133 (eq (car-safe a) 'bigpos)))
2134 2127
2135;;; True if A is a rational (or integer). [P x] [Public] 2128;;; True if A is a rational (or integer). [P x] [Public]
2136(defun math-ratp (a) 2129(defalias 'math-ratp #'Math-ratp)
2137 (or (integerp a)
2138 (memq (car-safe a) '(bigpos bigneg frac))))
2139 2130
2140;;; True if A is a real (or rational). [P x] [Public] 2131;;; True if A is a real (or rational). [P x] [Public]
2141(defun math-realp (a) 2132(defalias 'math-realp #'Math-realp)
2142 (or (integerp a)
2143 (memq (car-safe a) '(bigpos bigneg frac float))))
2144 2133
2145;;; True if A is a real or HMS form. [P x] [Public] 2134;;; True if A is a real or HMS form. [P x] [Public]
2146(defun math-anglep (a) 2135(defalias 'math-anglep #'Math-anglep)
2147 (or (integerp a)
2148 (memq (car-safe a) '(bigpos bigneg frac float hms))))
2149 2136
2150;;; True if A is a number of any kind. [P x] [Public] 2137;;; True if A is a number of any kind. [P x] [Public]
2151(defun math-numberp (a) 2138(defalias 'math-numberp #'Math-numberp)
2152 (or (integerp a)
2153 (memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
2154 2139
2155;;; True if A is a complex number or angle. [P x] [Public] 2140;;; True if A is a complex number or angle. [P x] [Public]
2156(defun math-scalarp (a) 2141(defalias 'math-scalarp #'#'Math-scalarp)
2157 (or (integerp a)
2158 (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
2159 2142
2160;;; True if A is a vector. [P x] [Public] 2143;;; True if A is a vector. [P x] [Public]
2161(defun math-vectorp (a) 2144(defalias 'math-vectorp #'Math-vectorp)
2162 (eq (car-safe a) 'vec))
2163 2145
2164;;; True if A is any vector or scalar data object. [P x] 2146;;; True if A is any vector or scalar data object. [P x]
2165(defun math-objvecp (a) ; [Public] 2147(defun math-objvecp (a) ; [Public]
2166 (or (integerp a) 2148 (or (integerp a)
2167 (memq (car-safe a) '(bigpos bigneg frac float cplx polar 2149 (memq (car-safe a) '(frac float cplx polar
2168 hms date sdev intv mod vec incomplete)))) 2150 hms date sdev intv mod vec
2151 ;; FIXME: Math-objvecp does not include this one!
2152 incomplete))))
2169 2153
2170;;; True if A is an object not composed of sub-formulas . [P x] [Public] 2154;;; True if A is an object not composed of sub-formulas . [P x] [Public]
2171(defun math-primp (a) 2155(defun math-primp (a)
2172 (or (integerp a) 2156 (or (integerp a)
2173 (memq (car-safe a) '(bigpos bigneg frac float cplx polar 2157 (memq (car-safe a) '(frac float cplx polar
2174 hms date mod var)))) 2158 hms date mod var))))
2175 2159
2176;;; True if A is numerically (but not literally) an integer. [P x] [Public] 2160;;; True if A is numerically (but not literally) an integer. [P x] [Public]
2177(defun math-messy-integerp (a) 2161(defun math-messy-integerp (a)
2178 (cond 2162 (cond
2179 ((eq (car-safe a) 'float) (>= (nth 2 a) 0)) 2163 ((eq (car-safe a) 'float) (>= (nth 2 a) 0))
2164 ;; FIXME: Math-messy-integerp does not include this case!
2180 ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a))))) 2165 ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
2181 2166
2182;;; True if A is numerically an integer. [P x] [Public] 2167;;; True if A is numerically an integer. [P x] [Public]
2183(defun math-num-integerp (a) 2168(defun math-num-integerp (a)
2184 (or (Math-integerp a) 2169 (or (integerp a)
2185 (Math-messy-integerp a))) 2170 (Math-messy-integerp a)))
2186 2171
2187;;; True if A is (numerically) a non-negative integer. [P N] [Public] 2172;;; True if A is (numerically) a non-negative integer. [P N] [Public]
2188(defun math-num-natnump (a) 2173(defun math-num-natnump (a)
2189 (or (natnump a) 2174 (or (natnump a)
2190 (eq (car-safe a) 'bigpos)
2191 (and (eq (car-safe a) 'float) 2175 (and (eq (car-safe a) 'float)
2192 (Math-natnump (nth 1 a)) 2176 (Math-natnump (nth 1 a))
2193 (>= (nth 2 a) 0)))) 2177 (>= (nth 2 a) 0))))
@@ -2277,28 +2261,24 @@ calc-kill calc-kill-region calc-yank))))
2277;;; True if A is any scalar data object. [P x] 2261;;; True if A is any scalar data object. [P x]
2278(defun math-objectp (a) ; [Public] 2262(defun math-objectp (a) ; [Public]
2279 (or (integerp a) 2263 (or (integerp a)
2280 (memq (car-safe a) '(bigpos bigneg frac float cplx 2264 (memq (car-safe a) '(frac float cplx
2281 polar hms date sdev intv mod)))) 2265 polar hms date sdev intv mod))))
2282 2266
2283;;; Verify that A is an integer and return A in integer form. [I N; - x] 2267;;; Verify that A is an integer and return A in integer form. [I N; - x]
2284(defun math-check-integer (a) ; [Public] 2268(defun math-check-integer (a) ; [Public]
2285 (cond ((integerp a) a) ; for speed 2269 (cond ((integerp a) a)
2286 ((math-integerp a) a)
2287 ((math-messy-integerp a) 2270 ((math-messy-integerp a)
2288 (math-trunc a)) 2271 (math-trunc a))
2289 (t (math-reject-arg a 'integerp)))) 2272 (t (math-reject-arg a 'integerp))))
2290 2273
2291;;; Verify that A is a small integer and return A in integer form. [S N; - x] 2274;;; Verify that A is a small integer and return A in integer form. [S N; - x]
2292(defun math-check-fixnum (a &optional allow-inf) ; [Public] 2275(defun math-check-fixnum (a &optional allow-inf) ; [Public]
2293 (cond ((integerp a) a) ; for speed 2276 (cond ((fixnump a) a) ; for speed
2294 ((Math-num-integerp a) 2277 ((Math-num-integerp a)
2295 (let ((a (math-trunc a))) 2278 (let ((a (math-trunc a)))
2296 (if (integerp a) 2279 (if (fixnump a)
2297 a 2280 a
2298 (if (or (Math-lessp most-positive-fixnum a) 2281 (math-reject-arg a 'fixnump))))
2299 (Math-lessp a (- most-positive-fixnum)))
2300 (math-reject-arg a 'fixnump)
2301 (math-fixnum a)))))
2302 ((and allow-inf (equal a '(var inf var-inf))) 2282 ((and allow-inf (equal a '(var inf var-inf)))
2303 most-positive-fixnum) 2283 most-positive-fixnum)
2304 ((and allow-inf (equal a '(neg (var inf var-inf)))) 2284 ((and allow-inf (equal a '(neg (var inf var-inf))))
@@ -2348,20 +2328,6 @@ If X is not an error form, return 1."
2348 (memq t (mapcar (lambda (x) (eq (car-safe x) 'sdev)) ls)))) 2328 (memq t (mapcar (lambda (x) (eq (car-safe x) 'sdev)) ls))))
2349 2329
2350;;; Coerce integer A to be a small integer. [S I] 2330;;; Coerce integer A to be a small integer. [S I]
2351(defun math-fixnum (a)
2352 (if (consp a)
2353 (if (cdr a)
2354 (if (eq (car a) 'bigneg)
2355 (- (math-fixnum-big (cdr a)))
2356 (math-fixnum-big (cdr a)))
2357 0)
2358 a))
2359
2360(defun math-fixnum-big (a)
2361 (if (cdr a)
2362 (+ (car a) (* (math-fixnum-big (cdr a)) math-bignum-digit-size))
2363 (car a)))
2364
2365(defvar math-simplify-only nil) 2331(defvar math-simplify-only nil)
2366 2332
2367(defun math-normalize-fancy (a) 2333(defun math-normalize-fancy (a)
@@ -2468,12 +2434,6 @@ If X is not an error form, return 1."
2468 (setcdr last nil) 2434 (setcdr last nil)
2469 a)))) 2435 a))))
2470 2436
2471(defun math-bignum-test (a) ; [B N; B s; b b]
2472 (if (consp a)
2473 a
2474 (math-bignum a)))
2475
2476
2477;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public] 2437;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
2478(defun calcFunc-sign (a &optional x) 2438(defun calcFunc-sign (a &optional x)
2479 (let ((signs (math-possible-signs a))) 2439 (let ((signs (math-possible-signs a)))
@@ -2496,17 +2456,7 @@ If X is not an error form, return 1."
2496 2 2456 2
2497 0)) 2457 0))
2498 ((and (integerp a) (Math-integerp b)) 2458 ((and (integerp a) (Math-integerp b))
2499 (if (consp b) 2459 (if (< a b) -1 1))
2500 (if (eq (car b) 'bigpos) -1 1)
2501 (if (< a b) -1 1)))
2502 ((and (eq (car-safe a) 'bigpos) (Math-integerp b))
2503 (if (eq (car-safe b) 'bigpos)
2504 (math-compare-bignum (cdr a) (cdr b))
2505 1))
2506 ((and (eq (car-safe a) 'bigneg) (Math-integerp b))
2507 (if (eq (car-safe b) 'bigneg)
2508 (math-compare-bignum (cdr b) (cdr a))
2509 -1))
2510 ((eq (car-safe a) 'frac) 2460 ((eq (car-safe a) 'frac)
2511 (if (eq (car-safe b) 'frac) 2461 (if (eq (car-safe b) 'frac)
2512 (math-compare (math-mul (nth 1 a) (nth 2 b)) 2462 (math-compare (math-mul (nth 1 a) (nth 2 b))
@@ -3451,16 +3401,16 @@ If X is not an error form, return 1."
3451 (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g)))) 3401 (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
3452 a)) 3402 a))
3453 3403
3454(defun math-format-bignum-fancy (a) ; [X L] 3404(defun math--format-integer-fancy (a) ; [I]
3455 (let ((str (cond ((= calc-number-radix 10) 3405 (let ((str (cond ((= calc-number-radix 10)
3456 (math-format-bignum-decimal a)) 3406 (number-to-string a))
3457 ((= calc-number-radix 2) 3407 ((= calc-number-radix 2)
3458 (math-format-bignum-binary a)) 3408 (math-format-binary a))
3459 ((= calc-number-radix 8) 3409 ((= calc-number-radix 8)
3460 (math-format-bignum-octal a)) 3410 (math-format-octal a))
3461 ((= calc-number-radix 16) 3411 ((= calc-number-radix 16)
3462 (math-format-bignum-hex a)) 3412 (math-format-hex a))
3463 (t (math-format-bignum-radix a))))) 3413 (t (math-format-radix a)))))
3464 (if calc-leading-zeros 3414 (if calc-leading-zeros
3465 (let* ((calc-internal-prec 6) 3415 (let* ((calc-internal-prec 6)
3466 (digs (math-compute-max-digits (math-abs calc-word-size) 3416 (digs (math-compute-max-digits (math-abs calc-word-size)
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index a9d153961d8..17e79354835 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -27,6 +27,7 @@
27 27
28(require 'calc-ext) 28(require 'calc-ext)
29(require 'calc-macs) 29(require 'calc-macs)
30(require 'cl-lib)
30 31
31(defun calc-inc-gamma (arg) 32(defun calc-inc-gamma (arg)
32 (interactive "P") 33 (interactive "P")
@@ -177,7 +178,7 @@
177 '(float 0 0) 178 '(float 0 0)
178 2))))))) 179 2)))))))
179 180
180(defun math-gamma-series (sum x xinvsqr oterm n) 181(defun math-gamma-series (sum x xinvsqr _oterm n)
181 (math-working "gamma" sum) 182 (math-working "gamma" sum)
182 (let* ((bn (math-bernoulli-number n)) 183 (let* ((bn (math-bernoulli-number n))
183 (term (math-mul (math-div-float (math-float (nth 1 bn)) 184 (term (math-mul (math-div-float (math-float (nth 1 bn))
@@ -525,7 +526,7 @@
525 bj)) 526 bj))
526 (t 527 (t
527 (if (Math-lessp 100 v) (math-reject-arg v 'range)) 528 (if (Math-lessp 100 v) (math-reject-arg v 'range))
528 (let* ((j (logior (+ v (math-isqrt-small (* 40 v))) 1)) 529 (let* ((j (logior (+ v (cl-isqrt (* 40 v))) 1))
529 (two-over-x (math-div 2 x)) 530 (two-over-x (math-div 2 x))
530 (jsum nil) 531 (jsum nil)
531 (bjp '(float 0 0)) 532 (bjp '(float 0 0))
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 0afba2c1b28..aadfabbd21e 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -29,7 +29,6 @@
29(declare-function math-looks-negp "calc-misc" (a)) 29(declare-function math-looks-negp "calc-misc" (a))
30(declare-function math-posp "calc-misc" (a)) 30(declare-function math-posp "calc-misc" (a))
31(declare-function math-compare "calc-ext" (a b)) 31(declare-function math-compare "calc-ext" (a b))
32(declare-function math-bignum "calc" (a))
33(declare-function math-compare-bignum "calc-ext" (a b)) 32(declare-function math-compare-bignum "calc-ext" (a b))
34 33
35 34
@@ -70,29 +69,22 @@
70;;; Faster in-line version zerop, normalized values only. 69;;; Faster in-line version zerop, normalized values only.
71(defsubst Math-zerop (a) ; [P N] 70(defsubst Math-zerop (a) ; [P N]
72 (if (consp a) 71 (if (consp a)
73 (and (not (memq (car a) '(bigpos bigneg))) 72 (if (eq (car a) 'float)
74 (if (eq (car a) 'float) 73 (eq (nth 1 a) 0)
75 (eq (nth 1 a) 0) 74 (math-zerop a))
76 (math-zerop a)))
77 (eq a 0))) 75 (eq a 0)))
78 76
79(defsubst Math-integer-negp (a) 77(defsubst Math-integer-negp (a)
80 (if (consp a) 78 (and (integerp a) (< a 0)))
81 (eq (car a) 'bigneg)
82 (< a 0)))
83 79
84(defsubst Math-integer-posp (a) 80(defsubst Math-integer-posp (a)
85 (if (consp a) 81 (and (integerp a) (> a 0)))
86 (eq (car a) 'bigpos)
87 (> a 0)))
88 82
89(defsubst Math-negp (a) 83(defsubst Math-negp (a)
90 (if (consp a) 84 (if (consp a)
91 (or (eq (car a) 'bigneg) 85 (if (memq (car a) '(frac float))
92 (and (not (eq (car a) 'bigpos)) 86 (Math-integer-negp (nth 1 a))
93 (if (memq (car a) '(frac float)) 87 (math-negp a))
94 (Math-integer-negp (nth 1 a))
95 (math-negp a))))
96 (< a 0))) 88 (< a 0)))
97 89
98(defsubst Math-looks-negp (a) ; [P x] [Public] 90(defsubst Math-looks-negp (a) ; [P x] [Public]
@@ -104,44 +96,38 @@
104 96
105(defsubst Math-posp (a) 97(defsubst Math-posp (a)
106 (if (consp a) 98 (if (consp a)
107 (or (eq (car a) 'bigpos) 99 (if (memq (car a) '(frac float))
108 (and (not (eq (car a) 'bigneg)) 100 (Math-integer-posp (nth 1 a))
109 (if (memq (car a) '(frac float)) 101 (math-posp a))
110 (Math-integer-posp (nth 1 a))
111 (math-posp a))))
112 (> a 0))) 102 (> a 0)))
113 103
114(defsubst Math-integerp (a) 104(defalias 'Math-integerp #'integerp)
115 (or (not (consp a))
116 (memq (car a) '(bigpos bigneg))))
117 105
118(defsubst Math-natnump (a) 106(defsubst Math-natnump (a)
119 (if (consp a) 107 (and (integerp a) (>= a 0)))
120 (eq (car a) 'bigpos)
121 (>= a 0)))
122 108
123(defsubst Math-ratp (a) 109(defsubst Math-ratp (a)
124 (or (not (consp a)) 110 (or (not (consp a))
125 (memq (car a) '(bigpos bigneg frac)))) 111 (eq (car a) 'frac)))
126 112
127(defsubst Math-realp (a) 113(defsubst Math-realp (a)
128 (or (not (consp a)) 114 (or (not (consp a))
129 (memq (car a) '(bigpos bigneg frac float)))) 115 (memq (car a) '(frac float))))
130 116
131(defsubst Math-anglep (a) 117(defsubst Math-anglep (a)
132 (or (not (consp a)) 118 (or (not (consp a))
133 (memq (car a) '(bigpos bigneg frac float hms)))) 119 (memq (car a) '(frac float hms))))
134 120
135(defsubst Math-numberp (a) 121(defsubst Math-numberp (a)
136 (or (not (consp a)) 122 (or (not (consp a))
137 (memq (car a) '(bigpos bigneg frac float cplx polar)))) 123 (memq (car a) '(frac float cplx polar))))
138 124
139(defsubst Math-scalarp (a) 125(defsubst Math-scalarp (a)
140 (or (not (consp a)) 126 (or (not (consp a))
141 (memq (car a) '(bigpos bigneg frac float cplx polar hms)))) 127 (memq (car a) '(frac float cplx polar hms))))
142 128
143(defsubst Math-vectorp (a) 129(defsubst Math-vectorp (a)
144 (and (consp a) (eq (car a) 'vec))) 130 (eq (car-safe a) 'vec))
145 131
146(defsubst Math-messy-integerp (a) 132(defsubst Math-messy-integerp (a)
147 (and (consp a) 133 (and (consp a)
@@ -151,21 +137,17 @@
151(defsubst Math-objectp (a) ; [Public] 137(defsubst Math-objectp (a) ; [Public]
152 (or (not (consp a)) 138 (or (not (consp a))
153 (memq (car a) 139 (memq (car a)
154 '(bigpos bigneg frac float cplx polar hms date sdev intv mod)))) 140 '(frac float cplx polar hms date sdev intv mod))))
155 141
156(defsubst Math-objvecp (a) ; [Public] 142(defsubst Math-objvecp (a) ; [Public]
157 (or (not (consp a)) 143 (or (not (consp a))
158 (memq (car a) 144 (memq (car a)
159 '(bigpos bigneg frac float cplx polar hms date 145 '(frac float cplx polar hms date
160 sdev intv mod vec)))) 146 sdev intv mod vec))))
161 147
162;;; Compute the negative of A. [O O; o o] [Public] 148;;; Compute the negative of A. [O O; o o] [Public]
163(defsubst Math-integer-neg (a) 149(defsubst Math-integer-neg (a)
164 (if (consp a) 150 (- a))
165 (if (eq (car a) 'bigpos)
166 (cons 'bigneg (cdr a))
167 (cons 'bigpos (cdr a)))
168 (- a)))
169 151
170(defsubst Math-equal (a b) 152(defsubst Math-equal (a b)
171 (= (math-compare a b) 0)) 153 (= (math-compare a b) 0))
@@ -175,20 +157,14 @@
175 157
176(defsubst Math-primp (a) 158(defsubst Math-primp (a)
177 (or (not (consp a)) 159 (or (not (consp a))
178 (memq (car a) '(bigpos bigneg frac float cplx polar 160 (memq (car a) '(frac float cplx polar
179 hms date mod var)))) 161 hms date mod var))))
180 162
181(defsubst Math-num-integerp (a) 163(defsubst Math-num-integerp (a)
182 (or (not (consp a)) 164 (or (not (consp a))
183 (memq (car a) '(bigpos bigneg))
184 (and (eq (car a) 'float) 165 (and (eq (car a) 'float)
185 (>= (nth 2 a) 0)))) 166 (>= (nth 2 a) 0))))
186 167
187(defsubst Math-bignum-test (a) ; [B N; B s; b b]
188 (if (consp a)
189 a
190 (math-bignum a)))
191
192(defsubst Math-equal-int (a b) 168(defsubst Math-equal-int (a b)
193 (or (eq a b) 169 (or (eq a b)
194 (and (consp a) 170 (and (consp a)
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 62fe3d4b3c0..4ca8515989b 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -25,6 +25,8 @@
25 25
26;; This file is autoloaded from calc-ext.el. 26;; This file is autoloaded from calc-ext.el.
27 27
28
29(require 'cl-lib)
28(require 'calc-ext) 30(require 'calc-ext)
29(require 'calc-macs) 31(require 'calc-macs)
30 32
@@ -95,8 +97,7 @@ If this can't be done, return NIL."
95 (and 97 (and
96 (<= calc-internal-prec math-emacs-precision) 98 (<= calc-internal-prec math-emacs-precision)
97 (math-realp x) 99 (math-realp x)
98 (let* ((fx (math-float x)) 100 (let* ((xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
99 (xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
100 (and (<= math-smallest-emacs-expt xpon) 101 (and (<= math-smallest-emacs-expt xpon)
101 (<= xpon math-largest-emacs-expt) 102 (<= xpon math-largest-emacs-expt)
102 (condition-case nil 103 (condition-case nil
@@ -371,51 +372,15 @@ If this can't be done, return NIL."
371;;; with an overestimate always works, even using truncating integer division! 372;;; with an overestimate always works, even using truncating integer division!
372(defun math-isqrt (a) 373(defun math-isqrt (a)
373 (cond ((Math-zerop a) a) 374 (cond ((Math-zerop a) a)
374 ((not (math-natnump a)) 375 ((not (natnump a))
375 (math-reject-arg a 'natnump)) 376 (math-reject-arg a 'natnump))
376 ((integerp a) 377 (t (cl-isqrt a))))
377 (math-isqrt-small a))
378 (t
379 (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a))))))))
380 378
381(defun calcFunc-isqrt (a) 379(defun calcFunc-isqrt (a)
382 (if (math-realp a) 380 (if (math-realp a)
383 (math-isqrt (math-floor a)) 381 (math-isqrt (math-floor a))
384 (math-floor (math-sqrt a)))) 382 (math-floor (math-sqrt a))))
385 383
386
387;;; This returns (flag . result) where the flag is t if A is a perfect square.
388(defun math-isqrt-bignum (a) ; [P.l L]
389 (let ((len (length a)))
390 (if (= (% len 2) 0)
391 (let* ((top (nthcdr (- len 2) a)))
392 (math-isqrt-bignum-iter
393 a
394 (math-scale-bignum-digit-size
395 (math-bignum-big
396 (1+ (math-isqrt-small
397 (+ (* (nth 1 top) math-bignum-digit-size) (car top)))))
398 (1- (/ len 2)))))
399 (let* ((top (nth (1- len) a)))
400 (math-isqrt-bignum-iter
401 a
402 (math-scale-bignum-digit-size
403 (list (1+ (math-isqrt-small top)))
404 (/ len 2)))))))
405
406(defun math-isqrt-bignum-iter (a guess) ; [l L l]
407 (math-working "isqrt" (cons 'bigpos guess))
408 (let* ((q (math-div-bignum a guess))
409 (s (math-add-bignum (car q) guess))
410 (g2 (math-div2-bignum s))
411 (comp (math-compare-bignum g2 guess)))
412 (if (< comp 0)
413 (math-isqrt-bignum-iter a g2)
414 (cons (and (= comp 0)
415 (math-zerop-bignum (cdr q))
416 (= (% (car s) 2) 0))
417 guess))))
418
419(defun math-zerop-bignum (a) 384(defun math-zerop-bignum (a)
420 (and (eq (car a) 0) 385 (and (eq (car a) 0)
421 (progn 386 (progn
@@ -428,19 +393,6 @@ If this can't be done, return NIL."
428 n (1- n))) 393 n (1- n)))
429 a) 394 a)
430 395
431(defun math-isqrt-small (a) ; A > 0. [S S]
432 (let ((g (cond ((>= a 1000000) 10000)
433 ((>= a 10000) 1000)
434 ((>= a 100) 100)
435 (t 10)))
436 g2)
437 (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
438 (setq g g2))
439 g))
440
441
442
443
444;;; Compute the square root of a number. 396;;; Compute the square root of a number.
445;;; [T N] if possible, else [F N] if possible, else [C N]. [Public] 397;;; [T N] if possible, else [F N] if possible, else [C N]. [Public]
446(defun math-sqrt (a) 398(defun math-sqrt (a)
@@ -449,32 +401,24 @@ If this can't be done, return NIL."
449 (and (math-known-nonposp a) 401 (and (math-known-nonposp a)
450 (math-imaginary (math-sqrt (math-neg a)))) 402 (math-imaginary (math-sqrt (math-neg a))))
451 (and (integerp a) 403 (and (integerp a)
452 (let ((sqrt (math-isqrt-small a))) 404 (let ((sqrt (cl-isqrt a)))
453 (if (= (* sqrt sqrt) a) 405 (if (= (* sqrt sqrt) a)
454 sqrt 406 sqrt
455 (if calc-symbolic-mode 407 (if calc-symbolic-mode
456 (list 'calcFunc-sqrt a) 408 (list 'calcFunc-sqrt a)
457 (math-sqrt-float (math-float a) (math-float sqrt)))))) 409 (math-sqrt-float (math-float a) (math-float sqrt))))))
458 (and (eq (car-safe a) 'bigpos)
459 (let* ((res (math-isqrt-bignum (cdr a)))
460 (sqrt (math-normalize (cons 'bigpos (cdr res)))))
461 (if (car res)
462 sqrt
463 (if calc-symbolic-mode
464 (list 'calcFunc-sqrt a)
465 (math-sqrt-float (math-float a) (math-float sqrt))))))
466 (and (eq (car-safe a) 'frac) 410 (and (eq (car-safe a) 'frac)
467 (let* ((num-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 1 a))))) 411 (let* ((num-sqrt (cl-isqrt (nth 1 a)))
468 (num-sqrt (math-normalize (cons 'bigpos (cdr num-res)))) 412 (num-exact (= (* num-sqrt num-sqrt) (nth 1 a)))
469 (den-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 2 a))))) 413 (den-sqrt (cl-isqrt (nth 2 a)))
470 (den-sqrt (math-normalize (cons 'bigpos (cdr den-res))))) 414 (den-exact (= (* den-sqrt den-sqrt) (nth 2 a))))
471 (if (and (car num-res) (car den-res)) 415 (if (and num-exact den-exact)
472 (list 'frac num-sqrt den-sqrt) 416 (list 'frac num-sqrt den-sqrt)
473 (if calc-symbolic-mode 417 (if calc-symbolic-mode
474 (if (or (car num-res) (car den-res)) 418 (if (or num-exact den-exact)
475 (math-div (if (car num-res) 419 (math-div (if num-exact
476 num-sqrt (list 'calcFunc-sqrt (nth 1 a))) 420 num-sqrt (list 'calcFunc-sqrt (nth 1 a)))
477 (if (car den-res) 421 (if den-exact
478 den-sqrt (list 'calcFunc-sqrt (nth 2 a)))) 422 den-sqrt (list 'calcFunc-sqrt (nth 2 a))))
479 (list 'calcFunc-sqrt a)) 423 (list 'calcFunc-sqrt a))
480 (math-sqrt-float (math-float a) 424 (math-sqrt-float (math-float a)
@@ -482,12 +426,9 @@ If this can't be done, return NIL."
482 (and (eq (car-safe a) 'float) 426 (and (eq (car-safe a) 'float)
483 (if calc-symbolic-mode 427 (if calc-symbolic-mode
484 (if (= (% (nth 2 a) 2) 0) 428 (if (= (% (nth 2 a) 2) 0)
485 (let ((res (math-isqrt-bignum 429 (let ((res (cl-isqrt (nth 1 a))))
486 (cdr (Math-bignum-test (nth 1 a)))))) 430 (if (= (* res res) (nth 1 a))
487 (if (car res) 431 (math-make-float res (/ (nth 2 a) 2))
488 (math-make-float (math-normalize
489 (cons 'bigpos (cdr res)))
490 (/ (nth 2 a) 2))
491 (signal 'inexact-result nil))) 432 (signal 'inexact-result nil)))
492 (signal 'inexact-result nil)) 433 (signal 'inexact-result nil))
493 (math-sqrt-float a))) 434 (math-sqrt-float a)))
@@ -551,7 +492,7 @@ If this can't be done, return NIL."
551 (if (null guess) 492 (if (null guess)
552 (let ((ldiff (- (math-numdigs (nth 1 a)) 6))) 493 (let ((ldiff (- (math-numdigs (nth 1 a)) 6)))
553 (or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff))) 494 (or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff)))
554 (setq guess (math-make-float (math-isqrt-small 495 (setq guess (math-make-float (cl-isqrt
555 (math-scale-int (nth 1 a) (- ldiff))) 496 (math-scale-int (nth 1 a) (- ldiff)))
556 (/ (+ (nth 2 a) ldiff) 2))))) 497 (/ (+ (nth 2 a) ldiff) 2)))))
557 (math-sqrt-float-iter a guess))))) 498 (math-sqrt-float-iter a guess)))))
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 5fd8d07da57..d86b117c1f1 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -27,6 +27,7 @@
27 27
28(require 'calc) 28(require 'calc)
29(require 'calc-macs) 29(require 'calc-macs)
30(require 'cl-lib)
30 31
31;; Declare functions which are defined elsewhere. 32;; Declare functions which are defined elsewhere.
32(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive)) 33(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive))
@@ -118,7 +119,7 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
118 "press SPC, DEL to scroll, C-g to cancel") 119 "press SPC, DEL to scroll, C-g to cancel")
119 (memq (setq key (read-event)) 120 (memq (setq key (read-event))
120 '(? ?\C-h ?\C-? ?\C-v ?\M-v))) 121 '(? ?\C-h ?\C-? ?\C-v ?\M-v)))
121 (condition-case err 122 (condition-case nil
122 (if (memq key '(? ?\C-v)) 123 (if (memq key '(? ?\C-v))
123 (scroll-up) 124 (scroll-up)
124 (scroll-down)) 125 (scroll-down))
@@ -658,10 +659,7 @@ loaded and the keystroke automatically re-typed."
658;;;###autoload 659;;;###autoload
659(defun math-zerop (a) 660(defun math-zerop (a)
660 (if (consp a) 661 (if (consp a)
661 (cond ((memq (car a) '(bigpos bigneg)) 662 (cond ((memq (car a) '(frac float polar mod))
662 (while (eq (car (setq a (cdr a))) 0))
663 (null a))
664 ((memq (car a) '(frac float polar mod))
665 (math-zerop (nth 1 a))) 663 (math-zerop (nth 1 a)))
666 ((eq (car a) 'cplx) 664 ((eq (car a) 'cplx)
667 (and (math-zerop (nth 1 a)) (math-zerop (nth 2 a)))) 665 (and (math-zerop (nth 1 a)) (math-zerop (nth 2 a))))
@@ -677,9 +675,7 @@ loaded and the keystroke automatically re-typed."
677;;;###autoload 675;;;###autoload
678(defun math-negp (a) 676(defun math-negp (a)
679 (if (consp a) 677 (if (consp a)
680 (cond ((eq (car a) 'bigpos) nil) 678 (cond ((memq (car a) '(float frac))
681 ((eq (car a) 'bigneg) (cdr a))
682 ((memq (car a) '(float frac))
683 (Math-integer-negp (nth 1 a))) 679 (Math-integer-negp (nth 1 a)))
684 ((eq (car a) 'hms) 680 ((eq (car a) 'hms)
685 (if (math-zerop (nth 1 a)) 681 (if (math-zerop (nth 1 a))
@@ -712,9 +708,7 @@ loaded and the keystroke automatically re-typed."
712;;;###autoload 708;;;###autoload
713(defun math-posp (a) 709(defun math-posp (a)
714 (if (consp a) 710 (if (consp a)
715 (cond ((eq (car a) 'bigpos) (cdr a)) 711 (cond ((memq (car a) '(float frac))
716 ((eq (car a) 'bigneg) nil)
717 ((memq (car a) '(float frac))
718 (Math-integer-posp (nth 1 a))) 712 (Math-integer-posp (nth 1 a)))
719 ((eq (car a) 'hms) 713 ((eq (car a) 'hms)
720 (if (math-zerop (nth 1 a)) 714 (if (math-zerop (nth 1 a))
@@ -734,36 +728,20 @@ loaded and the keystroke automatically re-typed."
734 (> a 0))) 728 (> a 0)))
735 729
736;;;###autoload 730;;;###autoload
737(defalias 'math-fixnump 'integerp) 731(defalias 'math-fixnump #'fixnump)
738;;;###autoload 732;;;###autoload
739(defalias 'math-fixnatnump 'natnump) 733(defun math-fixnatnump (x) (and (fixnump x) (natnump x)))
740
741 734
742;; True if A is an even integer. [P R R] [Public] 735;; True if A is an even integer. [P R R] [Public]
743;;;###autoload 736;;;###autoload
744(defun math-evenp (a) 737(defun math-evenp (a)
745 (if (consp a) 738 (and (integerp a) (cl-evenp a)))
746 (and (memq (car a) '(bigpos bigneg))
747 (= (% (nth 1 a) 2) 0))
748 (= (% a 2) 0)))
749 739
750;; Compute A / 2, for small or big integer A. [I i] 740;; Compute A / 2, for small or big integer A. [I i]
751;; If A is negative, type of truncation is undefined. 741;; If A is negative, type of truncation is undefined.
752;;;###autoload 742;;;###autoload
753(defun math-div2 (a) 743(defun math-div2 (a)
754 (if (consp a) 744 (/ a 2))
755 (if (cdr a)
756 (math-normalize (cons (car a) (math-div2-bignum (cdr a))))
757 0)
758 (/ a 2)))
759
760;;;###autoload
761(defun math-div2-bignum (a) ; [l l]
762 (if (cdr a)
763 (cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) (/ math-bignum-digit-size 2)))
764 (math-div2-bignum (cdr a)))
765 (list (/ (car a) 2))))
766
767 745
768;; Reject an argument to a calculator function. [Public] 746;; Reject an argument to a calculator function. [Public]
769;;;###autoload 747;;;###autoload
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index a3e98c06249..364ba4d23bf 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -242,7 +242,7 @@
242 (cdr item))) 242 (cdr item)))
243 ((> mode 0) 243 ((> mode 0)
244 (let ((dims nil) 244 (let ((dims nil)
245 type new row) 245 type new)
246 (setq item (list item)) 246 (setq item (list item))
247 (while (> mode 0) 247 (while (> mode 0)
248 (setq type (calc-unpack-type (car item)) 248 (setq type (calc-unpack-type (car item))
@@ -1375,9 +1375,7 @@
1375 (aa (if neg (math-sub -1 a) a)) 1375 (aa (if neg (math-sub -1 a) a))
1376 (str (if (eq aa 0) 1376 (str (if (eq aa 0)
1377 "" 1377 ""
1378 (if (consp aa) 1378 (math-format-binary aa)))
1379 (math-format-bignum-binary (cdr aa))
1380 (math-format-binary aa))))
1381 (zero (if neg ?1 ?0)) 1379 (zero (if neg ?1 ?0))
1382 (one (if neg ?0 ?1)) 1380 (one (if neg ?0 ?1))
1383 (len (length str)) 1381 (len (length str))
@@ -1467,7 +1465,7 @@
1467 a) 1465 a)
1468 1466
1469(defun math-clean-set (a &optional always-vec) 1467(defun math-clean-set (a &optional always-vec)
1470 (let ((p a) res) 1468 (let ((p a))
1471 (while (cdr p) 1469 (while (cdr p)
1472 (if (and (eq (car-safe (nth 1 p)) 'intv) 1470 (if (and (eq (car-safe (nth 1 p)) 'intv)
1473 (Math-equal (nth 2 (nth 1 p)) (nth 3 (nth 1 p)))) 1471 (Math-equal (nth 2 (nth 1 p)) (nth 3 (nth 1 p))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 2136a099eed..3a9a2804cf2 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -211,7 +211,6 @@
211(declare-function math-group-float "calc-ext" (str)) 211(declare-function math-group-float "calc-ext" (str))
212(declare-function math-mod "calc-misc" (a b)) 212(declare-function math-mod "calc-misc" (a b))
213(declare-function math-format-number-fancy "calc-ext" (a prec)) 213(declare-function math-format-number-fancy "calc-ext" (a prec))
214(declare-function math-format-bignum-fancy "calc-ext" (a))
215(declare-function math-read-number-fancy "calc-ext" (s)) 214(declare-function math-read-number-fancy "calc-ext" (s))
216(declare-function calc-do-grab-region "calc-yank" (top bot arg)) 215(declare-function calc-do-grab-region "calc-yank" (top bot arg))
217(declare-function calc-do-grab-rectangle "calc-yank" (top bot arg &optional reduce)) 216(declare-function calc-do-grab-rectangle "calc-yank" (top bot arg &optional reduce))
@@ -232,7 +231,6 @@
232(defcustom calc-settings-file 231(defcustom calc-settings-file
233 (locate-user-emacs-file "calc.el" ".calc.el") 232 (locate-user-emacs-file "calc.el" ".calc.el")
234 "File in which to record permanent settings." 233 "File in which to record permanent settings."
235 :group 'calc
236 :type '(file)) 234 :type '(file))
237 235
238(defcustom calc-language-alist 236(defcustom calc-language-alist
@@ -248,14 +246,12 @@
248 (f90-mode . fortran) 246 (f90-mode . fortran)
249 (texinfo-mode . calc-normal-language)) 247 (texinfo-mode . calc-normal-language))
250 "Alist of major modes with appropriate Calc languages." 248 "Alist of major modes with appropriate Calc languages."
251 :group 'calc
252 :type '(alist :key-type (symbol :tag "Major mode") 249 :type '(alist :key-type (symbol :tag "Major mode")
253 :value-type (symbol :tag "Calc language"))) 250 :value-type (symbol :tag "Calc language")))
254 251
255(defcustom calc-embedded-announce-formula 252(defcustom calc-embedded-announce-formula
256 "%Embed\n\\(% .*\n\\)*" 253 "%Embed\n\\(% .*\n\\)*"
257 "A regular expression which is sure to be followed by a calc-embedded formula." 254 "A regular expression which is sure to be followed by a calc-embedded formula."
258 :group 'calc
259 :type '(regexp)) 255 :type '(regexp))
260 256
261(defcustom calc-embedded-announce-formula-alist 257(defcustom calc-embedded-announce-formula-alist
@@ -271,26 +267,22 @@
271 (xml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") 267 (xml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*")
272 (texinfo-mode . "@c Embed\n\\(@c .*\n\\)*")) 268 (texinfo-mode . "@c Embed\n\\(@c .*\n\\)*"))
273 "Alist of major modes with appropriate values for `calc-embedded-announce-formula'." 269 "Alist of major modes with appropriate values for `calc-embedded-announce-formula'."
274 :group 'calc
275 :type '(alist :key-type (symbol :tag "Major mode") 270 :type '(alist :key-type (symbol :tag "Major mode")
276 :value-type (regexp :tag "Regexp to announce formula"))) 271 :value-type (regexp :tag "Regexp to announce formula")))
277 272
278(defcustom calc-embedded-open-formula 273(defcustom calc-embedded-open-formula
279 "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" 274 "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
280 "A regular expression for the opening delimiter of a formula used by calc-embedded." 275 "A regular expression for the opening delimiter of a formula used by calc-embedded."
281 :group 'calc
282 :type '(regexp)) 276 :type '(regexp))
283 277
284(defcustom calc-embedded-close-formula 278(defcustom calc-embedded-close-formula
285 "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" 279 "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
286 "A regular expression for the closing delimiter of a formula used by calc-embedded." 280 "A regular expression for the closing delimiter of a formula used by calc-embedded."
287 :group 'calc
288 :type '(regexp)) 281 :type '(regexp))
289 282
290(defcustom calc-embedded-open-close-formula-alist 283(defcustom calc-embedded-open-close-formula-alist
291 nil 284 nil
292 "Alist of major modes with pairs of formula delimiters used by calc-embedded." 285 "Alist of major modes with pairs of formula delimiters used by calc-embedded."
293 :group 'calc
294 :type '(alist :key-type (symbol :tag "Major mode") 286 :type '(alist :key-type (symbol :tag "Major mode")
295 :value-type (list (regexp :tag "Opening formula delimiter") 287 :value-type (list (regexp :tag "Opening formula delimiter")
296 (regexp :tag "Closing formula delimiter")))) 288 (regexp :tag "Closing formula delimiter"))))
@@ -298,13 +290,11 @@
298(defcustom calc-embedded-word-regexp 290(defcustom calc-embedded-word-regexp
299 "[-+]?[0-9]+\\(\\.[0-9]+\\)?\\([eE][-+]?[0-9]+\\)?" 291 "[-+]?[0-9]+\\(\\.[0-9]+\\)?\\([eE][-+]?[0-9]+\\)?"
300 "A regular expression determining a word for calc-embedded-word." 292 "A regular expression determining a word for calc-embedded-word."
301 :group 'calc
302 :type '(regexp)) 293 :type '(regexp))
303 294
304(defcustom calc-embedded-word-regexp-alist 295(defcustom calc-embedded-word-regexp-alist
305 nil 296 nil
306 "Alist of major modes with word regexps used by calc-embedded-word." 297 "Alist of major modes with word regexps used by calc-embedded-word."
307 :group 'calc
308 :type '(alist :key-type (symbol :tag "Major mode") 298 :type '(alist :key-type (symbol :tag "Major mode")
309 :value-type (regexp :tag "Regexp for word"))) 299 :value-type (regexp :tag "Regexp for word")))
310 300
@@ -313,14 +303,12 @@
313 "A string which is the opening delimiter for a \"plain\" formula. 303 "A string which is the opening delimiter for a \"plain\" formula.
314If calc-show-plain mode is enabled, this is inserted at the front of 304If calc-show-plain mode is enabled, this is inserted at the front of
315each formula." 305each formula."
316 :group 'calc
317 :type '(string)) 306 :type '(string))
318 307
319(defcustom calc-embedded-close-plain 308(defcustom calc-embedded-close-plain
320 " %%%\n" 309 " %%%\n"
321 "A string which is the closing delimiter for a \"plain\" formula. 310 "A string which is the closing delimiter for a \"plain\" formula.
322See calc-embedded-open-plain." 311See calc-embedded-open-plain."
323 :group 'calc
324 :type '(string)) 312 :type '(string))
325 313
326(defcustom calc-embedded-open-close-plain-alist 314(defcustom calc-embedded-open-close-plain-alist
@@ -336,7 +324,6 @@ See calc-embedded-open-plain."
336 (xml-mode "<!-- %% " " %% -->\n") 324 (xml-mode "<!-- %% " " %% -->\n")
337 (texinfo-mode "@c %% " " %%\n")) 325 (texinfo-mode "@c %% " " %%\n"))
338 "Alist of major modes with pairs of delimiters for \"plain\" formulas." 326 "Alist of major modes with pairs of delimiters for \"plain\" formulas."
339 :group 'calc
340 :type '(alist :key-type (symbol :tag "Major mode") 327 :type '(alist :key-type (symbol :tag "Major mode")
341 :value-type (list (string :tag "Opening \"plain\" delimiter") 328 :value-type (list (string :tag "Opening \"plain\" delimiter")
342 (string :tag "Closing \"plain\" delimiter")))) 329 (string :tag "Closing \"plain\" delimiter"))))
@@ -344,19 +331,16 @@ See calc-embedded-open-plain."
344(defcustom calc-embedded-open-new-formula 331(defcustom calc-embedded-open-new-formula
345 "\n\n" 332 "\n\n"
346 "A string which is inserted at front of formula by calc-embedded-new-formula." 333 "A string which is inserted at front of formula by calc-embedded-new-formula."
347 :group 'calc
348 :type '(string)) 334 :type '(string))
349 335
350(defcustom calc-embedded-close-new-formula 336(defcustom calc-embedded-close-new-formula
351 "\n\n" 337 "\n\n"
352 "A string which is inserted at end of formula by calc-embedded-new-formula." 338 "A string which is inserted at end of formula by calc-embedded-new-formula."
353 :group 'calc
354 :type '(string)) 339 :type '(string))
355 340
356(defcustom calc-embedded-open-close-new-formula-alist 341(defcustom calc-embedded-open-close-new-formula-alist
357 nil 342 nil
358 "Alist of major modes with pairs of new formula delimiters used by calc-embedded." 343 "Alist of major modes with pairs of new formula delimiters used by calc-embedded."
359 :group 'calc
360 :type '(alist :key-type (symbol :tag "Major mode") 344 :type '(alist :key-type (symbol :tag "Major mode")
361 :value-type (list (string :tag "Opening new formula delimiter") 345 :value-type (list (string :tag "Opening new formula delimiter")
362 (string :tag "Closing new formula delimiter")))) 346 (string :tag "Closing new formula delimiter"))))
@@ -365,14 +349,12 @@ See calc-embedded-open-plain."
365 "% " 349 "% "
366 "A string which should precede calc-embedded mode annotations. 350 "A string which should precede calc-embedded mode annotations.
367This is not required to be present for user-written mode annotations." 351This is not required to be present for user-written mode annotations."
368 :group 'calc
369 :type '(string)) 352 :type '(string))
370 353
371(defcustom calc-embedded-close-mode 354(defcustom calc-embedded-close-mode
372 "\n" 355 "\n"
373 "A string which should follow calc-embedded mode annotations. 356 "A string which should follow calc-embedded mode annotations.
374This is not required to be present for user-written mode annotations." 357This is not required to be present for user-written mode annotations."
375 :group 'calc
376 :type '(string)) 358 :type '(string))
377 359
378(defcustom calc-embedded-open-close-mode-alist 360(defcustom calc-embedded-open-close-mode-alist
@@ -388,7 +370,6 @@ This is not required to be present for user-written mode annotations."
388 (xml-mode "<!-- " " -->\n") 370 (xml-mode "<!-- " " -->\n")
389 (texinfo-mode "@c " "\n")) 371 (texinfo-mode "@c " "\n"))
390 "Alist of major modes with pairs of strings to delimit annotations." 372 "Alist of major modes with pairs of strings to delimit annotations."
391 :group 'calc
392 :type '(alist :key-type (symbol :tag "Major mode") 373 :type '(alist :key-type (symbol :tag "Major mode")
393 :value-type (list (string :tag "Opening annotation delimiter") 374 :value-type (list (string :tag "Opening annotation delimiter")
394 (string :tag "Closing annotation delimiter")))) 375 (string :tag "Closing annotation delimiter"))))
@@ -402,34 +383,29 @@ This is not required to be present for user-written mode annotations."
402 "pgnuplot" 383 "pgnuplot"
403 "gnuplot") 384 "gnuplot")
404 "Name of GNUPLOT program, for calc-graph features." 385 "Name of GNUPLOT program, for calc-graph features."
405 :group 'calc
406 :type '(string) 386 :type '(string)
407 :version "26.2") 387 :version "26.2")
408 388
409(defcustom calc-gnuplot-plot-command 389(defcustom calc-gnuplot-plot-command
410 nil 390 nil
411 "Name of command for displaying GNUPLOT output; %s = file name to print." 391 "Name of command for displaying GNUPLOT output; %s = file name to print."
412 :group 'calc
413 :type '(choice (string) (sexp))) 392 :type '(choice (string) (sexp)))
414 393
415(defcustom calc-gnuplot-print-command 394(defcustom calc-gnuplot-print-command
416 "lp %s" 395 "lp %s"
417 "Name of command for printing GNUPLOT output; %s = file name to print." 396 "Name of command for printing GNUPLOT output; %s = file name to print."
418 :group 'calc
419 :type '(choice (string) (sexp))) 397 :type '(choice (string) (sexp)))
420 398
421(defcustom calc-multiplication-has-precedence 399(defcustom calc-multiplication-has-precedence
422 t 400 t
423 "If non-nil, multiplication has precedence over division 401 "If non-nil, multiplication has precedence over division
424in normal mode." 402in normal mode."
425 :group 'calc
426 :type 'boolean) 403 :type 'boolean)
427 404
428(defcustom calc-ensure-consistent-units 405(defcustom calc-ensure-consistent-units
429 nil 406 nil
430 "If non-nil, make sure new units are consistent with current units 407 "If non-nil, make sure new units are consistent with current units
431when converting units." 408when converting units."
432 :group 'calc
433 :version "24.3" 409 :version "24.3"
434 :type 'boolean) 410 :type 'boolean)
435 411
@@ -437,14 +413,12 @@ when converting units."
437 nil 413 nil
438 "If non-nil, the stack element under the cursor will be copied by `calc-enter' 414 "If non-nil, the stack element under the cursor will be copied by `calc-enter'
439and deleted by `calc-pop'." 415and deleted by `calc-pop'."
440 :group 'calc
441 :version "24.4" 416 :version "24.4"
442 :type 'boolean) 417 :type 'boolean)
443 418
444(defcustom calc-undo-length 419(defcustom calc-undo-length
445 100 420 100
446 "The number of undo steps that will be preserved when Calc is quit." 421 "The number of undo steps that will be preserved when Calc is quit."
447 :group 'calc
448 :type 'integer) 422 :type 'integer)
449 423
450(defcustom calc-highlight-selections-with-faces 424(defcustom calc-highlight-selections-with-faces
@@ -455,42 +429,36 @@ shown by displaying the rest of the formula in `calc-nonselected-face'.
455If option `calc-show-selections' is nil, then selected sub-formulas are shown 429If option `calc-show-selections' is nil, then selected sub-formulas are shown
456by displaying the sub-formula in `calc-selected-face'." 430by displaying the sub-formula in `calc-selected-face'."
457 :version "24.1" 431 :version "24.1"
458 :group 'calc
459 :type 'boolean) 432 :type 'boolean)
460 433
461(defcustom calc-lu-field-reference 434(defcustom calc-lu-field-reference
462 "20 uPa" 435 "20 uPa"
463 "The default reference level for logarithmic units (field)." 436 "The default reference level for logarithmic units (field)."
464 :version "24.1" 437 :version "24.1"
465 :group 'calc
466 :type '(string)) 438 :type '(string))
467 439
468(defcustom calc-lu-power-reference 440(defcustom calc-lu-power-reference
469 "mW" 441 "mW"
470 "The default reference level for logarithmic units (power)." 442 "The default reference level for logarithmic units (power)."
471 :version "24.1" 443 :version "24.1"
472 :group 'calc
473 :type '(string)) 444 :type '(string))
474 445
475(defcustom calc-note-threshold "1" 446(defcustom calc-note-threshold "1"
476 "The number of cents that a frequency should be near a note 447 "The number of cents that a frequency should be near a note
477to be identified as that note." 448to be identified as that note."
478 :version "24.1" 449 :version "24.1"
479 :type 'string 450 :type 'string)
480 :group 'calc)
481 451
482(defvar math-format-date-cache) ; calc-forms.el 452(defvar math-format-date-cache) ; calc-forms.el
483 453
484(defface calc-nonselected-face 454(defface calc-nonselected-face
485 '((t :inherit shadow 455 '((t :inherit shadow
486 :slant italic)) 456 :slant italic))
487 "Face used to show the non-selected portion of a formula." 457 "Face used to show the non-selected portion of a formula.")
488 :group 'calc)
489 458
490(defface calc-selected-face 459(defface calc-selected-face
491 '((t :weight bold)) 460 '((t :weight bold))
492 "Face used to show the selected portion of a formula." 461 "Face used to show the selected portion of a formula.")
493 :group 'calc)
494 462
495(define-obsolete-variable-alias 'calc-bug-address 'report-emacs-bug-address 463(define-obsolete-variable-alias 'calc-bug-address 'report-emacs-bug-address
496 "26.2") 464 "26.2")
@@ -934,7 +902,6 @@ Used by `calc-user-invocation'.")
934 902
935;; The following modes use specially-formatted data. 903;; The following modes use specially-formatted data.
936(put 'calc-mode 'mode-class 'special) 904(put 'calc-mode 'mode-class 'special)
937(put 'calc-trail-mode 'mode-class 'special)
938 905
939(define-error 'calc-error "Calc internal error") 906(define-error 'calc-error "Calc internal error")
940(define-error 'inexact-result 907(define-error 'inexact-result
@@ -1384,7 +1351,7 @@ Notations: 3.14e6 3.14 * 10^6
1384 (set-buffer "*Calculator*") 1351 (set-buffer "*Calculator*")
1385 (while plist 1352 (while plist
1386 (put 'calc-define (car plist) nil) 1353 (put 'calc-define (car plist) nil)
1387 (eval (nth 1 plist)) 1354 (eval (nth 1 plist) t)
1388 (setq plist (cdr (cdr plist)))) 1355 (setq plist (cdr (cdr plist))))
1389 ;; See if this has added any more calc-define properties. 1356 ;; See if this has added any more calc-define properties.
1390 (calc-check-defines)) 1357 (calc-check-defines))
@@ -1410,7 +1377,7 @@ commands given here will actually operate on the *Calculator* stack."
1410 (make-local-variable 'overlay-arrow-position) 1377 (make-local-variable 'overlay-arrow-position)
1411 (make-local-variable 'overlay-arrow-string) 1378 (make-local-variable 'overlay-arrow-string)
1412 (when (= (buffer-size) 0) 1379 (when (= (buffer-size) 0)
1413 (let ((buffer-read-only nil)) 1380 (let ((inhibit-read-only t))
1414 (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))) 1381 (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
1415 1382
1416(defun calc-create-buffer () 1383(defun calc-create-buffer ()
@@ -2043,7 +2010,6 @@ on 15 October 1582 (Gregorian), and many Catholic countries made
2043the change then. Great Britain and its colonies had the Gregorian 2010the change then. Great Britain and its colonies had the Gregorian
2044calendar take effect on 14 September 1752 (Gregorian); this includes 2011calendar take effect on 14 September 1752 (Gregorian); this includes
2045the United States." 2012the United States."
2046 :group 'calc
2047 :version "24.4" 2013 :version "24.4"
2048 :type '(choice (const :tag "Always use the Gregorian calendar" nil) 2014 :type '(choice (const :tag "Always use the Gregorian calendar" nil)
2049 (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736)) 2015 (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736))
@@ -2490,51 +2456,18 @@ the United States."
2490 (setq last-command-event 13) 2456 (setq last-command-event 13)
2491 (calcDigit-nondigit)))) 2457 (calcDigit-nondigit))))
2492 2458
2493
2494
2495
2496(defconst math-bignum-digit-length
2497 (truncate (/ (log (/ most-positive-fixnum 2) 10) 2))
2498 "The length of a \"digit\" in Calc bignums.
2499If a big integer is of the form (bigpos N0 N1 ...), this is the
2500length of the allowable Emacs integers N0, N1,...
2501The value of 2*10^(2*MATH-BIGNUM-DIGIT-LENGTH) must be less than the
2502largest Emacs integer.")
2503
2504(defconst math-bignum-digit-size
2505 (expt 10 math-bignum-digit-length)
2506 "An upper bound for the size of the \"digit\"s in Calc bignums.")
2507
2508(defconst math-small-integer-size
2509 (expt math-bignum-digit-size 2)
2510 "An upper bound for the size of \"small integer\"s in Calc.")
2511
2512
2513;;;; Arithmetic routines. 2459;;;; Arithmetic routines.
2514;; 2460;;
2515;; An object as manipulated by one of these routines may take any of the 2461;; An object as manipulated by one of these routines may take any of the
2516;; following forms: 2462;; following forms:
2517;; 2463;;
2518;; integer An integer. For normalized numbers, this format 2464;; integer An integer.
2519;; is used only for
2520;; negative math-small-integer-size + 1 to
2521;; math-small-integer-size - 1
2522;;
2523;; (bigpos N0 N1 N2 ...) A big positive integer,
2524;; N0 + N1*math-bignum-digit-size
2525;; + N2*(math-bignum-digit-size)^2 ...
2526;; (bigneg N0 N1 N2 ...) A big negative integer,
2527;; - N0 - N1*math-bignum-digit-size ...
2528;; Each digit N is in the range
2529;; 0 ... math-bignum-digit-size -1.
2530;; Normalized, always at least three N present,
2531;; and the most significant N is nonzero.
2532;; 2465;;
2533;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers. 2466;; (frac NUM DEN) A fraction. NUM and DEN are integers.
2534;; Normalized, DEN > 1. 2467;; Normalized, DEN > 1.
2535;; 2468;;
2536;; (float NUM EXP) A floating-point number, NUM * 10^EXP; 2469;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
2537;; NUM is a small or big integer, EXP is a small int. 2470;; NUM and EXP are integers.
2538;; Normalized, NUM is not a multiple of 10, and 2471;; Normalized, NUM is not a multiple of 10, and
2539;; abs(NUM) < 10^calc-internal-prec. 2472;; abs(NUM) < 10^calc-internal-prec.
2540;; Normalized zero is stored as (float 0 0). 2473;; Normalized zero is stored as (float 0 0).
@@ -2595,8 +2528,7 @@ largest Emacs integer.")
2595;; B Normalized big integer 2528;; B Normalized big integer
2596;; S Normalized small integer 2529;; S Normalized small integer
2597;; D Digit (small integer, 0..999) 2530;; D Digit (small integer, 0..999)
2598;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol) 2531;; L normalized vector element list (without "vec")
2599;; or normalized vector element list (without "vec")
2600;; P Predicate (truth value) 2532;; P Predicate (truth value)
2601;; X Any Lisp object 2533;; X Any Lisp object
2602;; Z "nil" 2534;; Z "nil"
@@ -2617,44 +2549,7 @@ largest Emacs integer.")
2617(defun math-normalize (a) 2549(defun math-normalize (a)
2618 (setq math-normalize-error nil) 2550 (setq math-normalize-error nil)
2619 (cond 2551 (cond
2620 ((not (consp a)) 2552 ((not (consp a)) a)
2621 (if (integerp a)
2622 (if (or (>= a math-small-integer-size)
2623 (<= a (- math-small-integer-size)))
2624 (math-bignum a)
2625 a)
2626 a))
2627 ((eq (car a) 'bigpos)
2628 (if (eq (nth (1- (length a)) a) 0)
2629 (let* ((last (setq a
2630 (copy-sequence a)))
2631 (digs a))
2632 (while (setq digs (cdr digs))
2633 (or (eq (car digs) 0) (setq last digs)))
2634 (setcdr last nil)))
2635 (if (cdr (cdr (cdr a)))
2636 a
2637 (cond
2638 ((cdr (cdr a)) (+ (nth 1 a)
2639 (* (nth 2 a)
2640 math-bignum-digit-size)))
2641 ((cdr a) (nth 1 a))
2642 (t 0))))
2643 ((eq (car a) 'bigneg)
2644 (if (eq (nth (1- (length a)) a) 0)
2645 (let* ((last (setq a (copy-sequence a)))
2646 (digs a))
2647 (while (setq digs (cdr digs))
2648 (or (eq (car digs) 0) (setq last digs)))
2649 (setcdr last nil)))
2650 (if (cdr (cdr (cdr a)))
2651 a
2652 (cond
2653 ((cdr (cdr a)) (- (+ (nth 1 a)
2654 (* (nth 2 a)
2655 math-bignum-digit-size))))
2656 ((cdr a) (- (nth 1 a)))
2657 (t 0))))
2658 ((eq (car a) 'float) 2553 ((eq (car a) 'float)
2659 (math-make-float (math-normalize (nth 1 a)) 2554 (math-make-float (math-normalize (nth 1 a))
2660 (nth 2 a))) 2555 (nth 2 a)))
@@ -2766,23 +2661,6 @@ largest Emacs integer.")
2766 ((consp a) a) 2661 ((consp a) a)
2767 (t (error "Invalid data object encountered")))) 2662 (t (error "Invalid data object encountered"))))
2768 2663
2769
2770
2771;; Coerce integer A to be a bignum. [B S]
2772(defun math-bignum (a)
2773 (cond
2774 ((>= a 0)
2775 (cons 'bigpos (math-bignum-big a)))
2776 (t
2777 (cons 'bigneg (math-bignum-big (- a))))))
2778
2779(defun math-bignum-big (a) ; [L s]
2780 (if (= a 0)
2781 nil
2782 (cons (% a math-bignum-digit-size)
2783 (math-bignum-big (/ a math-bignum-digit-size)))))
2784
2785
2786;; Build a normalized floating-point number. [F I S] 2664;; Build a normalized floating-point number. [F I S]
2787(defun math-make-float (mant exp) 2665(defun math-make-float (mant exp)
2788 (if (eq mant 0) 2666 (if (eq mant 0)
@@ -2791,20 +2669,9 @@ largest Emacs integer.")
2791 (if (< ldiff 0) 2669 (if (< ldiff 0)
2792 (setq mant (math-scale-rounding mant ldiff) 2670 (setq mant (math-scale-rounding mant ldiff)
2793 exp (- exp ldiff)))) 2671 exp (- exp ldiff))))
2794 (if (consp mant) 2672 (while (= (% mant 10) 0)
2795 (let ((digs (cdr mant))) 2673 (setq mant (/ mant 10)
2796 (if (= (% (car digs) 10) 0) 2674 exp (1+ exp)))
2797 (progn
2798 (while (= (car digs) 0)
2799 (setq digs (cdr digs)
2800 exp (+ exp math-bignum-digit-length)))
2801 (while (= (% (car digs) 10) 0)
2802 (setq digs (math-div10-bignum digs)
2803 exp (1+ exp)))
2804 (setq mant (math-normalize (cons (car mant) digs))))))
2805 (while (= (% mant 10) 0)
2806 (setq mant (/ mant 10)
2807 exp (1+ exp))))
2808 (if (and (<= exp -4000000) 2675 (if (and (<= exp -4000000)
2809 (<= (+ exp (math-numdigs mant) -1) -4000000)) 2676 (<= (+ exp (math-numdigs mant) -1) -4000000))
2810 (signal 'math-underflow nil) 2677 (signal 'math-underflow nil)
@@ -2813,13 +2680,6 @@ largest Emacs integer.")
2813 (signal 'math-overflow nil) 2680 (signal 'math-overflow nil)
2814 (list 'float mant exp))))) 2681 (list 'float mant exp)))))
2815 2682
2816(defun math-div10-bignum (a) ; [l l]
2817 (if (cdr a)
2818 (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10)
2819 (expt 10 (1- math-bignum-digit-length))))
2820 (math-div10-bignum (cdr a)))
2821 (list (/ (car a) 10))))
2822
2823;;; Coerce A to be a float. [F N; V V] [Public] 2683;;; Coerce A to be a float. [F N; V V] [Public]
2824(defun math-float (a) 2684(defun math-float (a)
2825 (cond ((Math-integerp a) (math-make-float a 0)) 2685 (cond ((Math-integerp a) (math-make-float a 0))
@@ -2832,8 +2692,6 @@ largest Emacs integer.")
2832 2692
2833(defun math-neg (a) 2693(defun math-neg (a)
2834 (cond ((not (consp a)) (- a)) 2694 (cond ((not (consp a)) (- a))
2835 ((eq (car a) 'bigpos) (cons 'bigneg (cdr a)))
2836 ((eq (car a) 'bigneg) (cons 'bigpos (cdr a)))
2837 ((memq (car a) '(frac float)) 2695 ((memq (car a) '(frac float))
2838 (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) 2696 (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
2839 ((memq (car a) '(cplx vec hms date calcFunc-idn)) 2697 ((memq (car a) '(cplx vec hms date calcFunc-idn))
@@ -2843,19 +2701,19 @@ largest Emacs integer.")
2843 2701
2844;;; Compute the number of decimal digits in integer A. [S I] 2702;;; Compute the number of decimal digits in integer A. [S I]
2845(defun math-numdigs (a) 2703(defun math-numdigs (a)
2846 (if (consp a) 2704 (cond
2847 (if (cdr a) 2705 ((= a 0) 0)
2848 (let* ((len (1- (length a))) 2706 ((progn (when (< a 0) (setq a (- a)))
2849 (top (nth len a))) 2707 (>= a 100))
2850 (+ (* (1- len) math-bignum-digit-length) (math-numdigs top))) 2708 (let* ((bd (logb a))
2851 0) 2709 (d (truncate (/ bd (eval-when-compile (log 10 2))))))
2852 (cond ((>= a 100) (+ (math-numdigs (/ a 1000)) 3)) 2710 (let ((b (expt 10 d)))
2853 ((>= a 10) 2) 2711 (cond
2854 ((>= a 1) 1) 2712 ((> b a) d)
2855 ((= a 0) 0) 2713 ((> (* 10 b) a) (1+ d))
2856 ((> a -10) 1) 2714 (t (+ d 2))))))
2857 ((> a -100) 2) 2715 ((>= a 10) 2)
2858 (t (math-numdigs (- a)))))) 2716 (t 1)))
2859 2717
2860;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S] 2718;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S]
2861(defun math-scale-int (a n) 2719(defun math-scale-int (a n)
@@ -2866,76 +2724,23 @@ largest Emacs integer.")
2866(defun math-scale-left (a n) ; [I I S] 2724(defun math-scale-left (a n) ; [I I S]
2867 (if (= n 0) 2725 (if (= n 0)
2868 a 2726 a
2869 (if (consp a) 2727 (* a (expt 10 n))))
2870 (cons (car a) (math-scale-left-bignum (cdr a) n))
2871 (if (>= n math-bignum-digit-length)
2872 (if (or (>= a math-bignum-digit-size)
2873 (<= a (- math-bignum-digit-size)))
2874 (math-scale-left (math-bignum a) n)
2875 (math-scale-left (* a math-bignum-digit-size)
2876 (- n math-bignum-digit-length)))
2877 (let ((sz (expt 10 (- (* 2 math-bignum-digit-length) n))))
2878 (if (or (>= a sz) (<= a (- sz)))
2879 (math-scale-left (math-bignum a) n)
2880 (* a (expt 10 n))))))))
2881
2882(defun math-scale-left-bignum (a n)
2883 (if (>= n math-bignum-digit-length)
2884 (while (>= (setq a (cons 0 a)
2885 n (- n math-bignum-digit-length))
2886 math-bignum-digit-length)))
2887 (if (> n 0)
2888 (math-mul-bignum-digit a (expt 10 n) 0)
2889 a))
2890 2728
2891(defun math-scale-right (a n) ; [i i S] 2729(defun math-scale-right (a n) ; [i i S]
2892 (if (= n 0) 2730 (if (= n 0)
2893 a 2731 a
2894 (if (consp a) 2732 (if (<= a 0)
2895 (cons (car a) (math-scale-right-bignum (cdr a) n)) 2733 (if (= a 0)
2896 (if (<= a 0) 2734 0
2897 (if (= a 0) 2735 (- (math-scale-right (- a) n)))
2898 0 2736 (if (> n 0)
2899 (- (math-scale-right (- a) n))) 2737 (/ a (expt 10 n))
2900 (if (>= n math-bignum-digit-length) 2738 a))))
2901 (while (and (> (setq a (/ a math-bignum-digit-size)) 0)
2902 (>= (setq n (- n math-bignum-digit-length))
2903 math-bignum-digit-length))))
2904 (if (> n 0)
2905 (/ a (expt 10 n))
2906 a)))))
2907
2908(defun math-scale-right-bignum (a n) ; [L L S; l l S]
2909 (if (>= n math-bignum-digit-length)
2910 (setq a (nthcdr (/ n math-bignum-digit-length) a)
2911 n (% n math-bignum-digit-length)))
2912 (if (> n 0)
2913 (cdr (math-mul-bignum-digit a (expt 10 (- math-bignum-digit-length n)) 0))
2914 a))
2915 2739
2916;;; Multiply (with rounding) the integer A by 10^N. [I i S] 2740;;; Multiply (with rounding) the integer A by 10^N. [I i S]
2917(defun math-scale-rounding (a n) 2741(defun math-scale-rounding (a n)
2918 (cond ((>= n 0) 2742 (cond ((>= n 0)
2919 (math-scale-left a n)) 2743 (math-scale-left a n))
2920 ((consp a)
2921 (math-normalize
2922 (cons (car a)
2923 (let ((val (if (< n (- math-bignum-digit-length))
2924 (math-scale-right-bignum
2925 (cdr a)
2926 (- (- math-bignum-digit-length) n))
2927 (if (< n 0)
2928 (math-mul-bignum-digit
2929 (cdr a)
2930 (expt 10 (+ math-bignum-digit-length n)) 0)
2931 (cdr a))))) ; n = -math-bignum-digit-length
2932 (if (and val (>= (car val) (/ math-bignum-digit-size 2)))
2933 (if (cdr val)
2934 (if (eq (car (cdr val)) (1- math-bignum-digit-size))
2935 (math-add-bignum (cdr val) '(1))
2936 (cons (1+ (car (cdr val))) (cdr (cdr val))))
2937 '(1))
2938 (cdr val))))))
2939 (t 2744 (t
2940 (if (< a 0) 2745 (if (< a 0)
2941 (- (math-scale-rounding (- a) n)) 2746 (- (math-scale-rounding (- a) n))
@@ -2948,36 +2753,13 @@ largest Emacs integer.")
2948(defun math-add (a b) 2753(defun math-add (a b)
2949 (or 2754 (or
2950 (and (not (or (consp a) (consp b))) 2755 (and (not (or (consp a) (consp b)))
2951 (progn 2756 (+ a b))
2952 (setq a (+ a b))
2953 (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size))
2954 (math-bignum a)
2955 a)))
2956 (and (Math-zerop a) (not (eq (car-safe a) 'mod)) 2757 (and (Math-zerop a) (not (eq (car-safe a) 'mod))
2957 (if (and (math-floatp a) (Math-ratp b)) (math-float b) b)) 2758 (if (and (math-floatp a) (Math-ratp b)) (math-float b) b))
2958 (and (Math-zerop b) (not (eq (car-safe b) 'mod)) 2759 (and (Math-zerop b) (not (eq (car-safe b) 'mod))
2959 (if (and (math-floatp b) (Math-ratp a)) (math-float a) a)) 2760 (if (and (math-floatp b) (Math-ratp a)) (math-float a) a))
2960 (and (Math-objvecp a) (Math-objvecp b) 2761 (and (Math-objvecp a) (Math-objvecp b)
2961 (or 2762 (or
2962 (and (Math-integerp a) (Math-integerp b)
2963 (progn
2964 (or (consp a) (setq a (math-bignum a)))
2965 (or (consp b) (setq b (math-bignum b)))
2966 (if (eq (car a) 'bigneg)
2967 (if (eq (car b) 'bigneg)
2968 (cons 'bigneg (math-add-bignum (cdr a) (cdr b)))
2969 (math-normalize
2970 (let ((diff (math-sub-bignum (cdr b) (cdr a))))
2971 (if (eq diff 'neg)
2972 (cons 'bigneg (math-sub-bignum (cdr a) (cdr b)))
2973 (cons 'bigpos diff)))))
2974 (if (eq (car b) 'bigneg)
2975 (math-normalize
2976 (let ((diff (math-sub-bignum (cdr a) (cdr b))))
2977 (if (eq diff 'neg)
2978 (cons 'bigneg (math-sub-bignum (cdr b) (cdr a)))
2979 (cons 'bigpos diff))))
2980 (cons 'bigpos (math-add-bignum (cdr a) (cdr b)))))))
2981 (and (Math-ratp a) (Math-ratp b) 2763 (and (Math-ratp a) (Math-ratp b)
2982 (require 'calc-ext) 2764 (require 'calc-ext)
2983 (calc-add-fractions a b)) 2765 (calc-add-fractions a b))
@@ -2993,79 +2775,6 @@ largest Emacs integer.")
2993 (and (require 'calc-ext) 2775 (and (require 'calc-ext)
2994 (math-add-symb-fancy a b)))) 2776 (math-add-symb-fancy a b))))
2995 2777
2996(defun math-add-bignum (a b) ; [L L L; l l l]
2997 (if a
2998 (if b
2999 (let* ((a (copy-sequence a)) (aa a) (carry nil) sum)
3000 (while (and aa b)
3001 (if carry
3002 (if (< (setq sum (+ (car aa) (car b)))
3003 (1- math-bignum-digit-size))
3004 (progn
3005 (setcar aa (1+ sum))
3006 (setq carry nil))
3007 (setcar aa (- sum (1- math-bignum-digit-size))))
3008 (if (< (setq sum (+ (car aa) (car b))) math-bignum-digit-size)
3009 (setcar aa sum)
3010 (setcar aa (- sum math-bignum-digit-size))
3011 (setq carry t)))
3012 (setq aa (cdr aa)
3013 b (cdr b)))
3014 (if carry
3015 (if b
3016 (nconc a (math-add-bignum b '(1)))
3017 (while (eq (car aa) (1- math-bignum-digit-size))
3018 (setcar aa 0)
3019 (setq aa (cdr aa)))
3020 (if aa
3021 (progn
3022 (setcar aa (1+ (car aa)))
3023 a)
3024 (nconc a '(1))))
3025 (if b
3026 (nconc a b)
3027 a)))
3028 a)
3029 b))
3030
3031(defun math-sub-bignum (a b) ; [l l l]
3032 (if b
3033 (if a
3034 (let* ((a (copy-sequence a)) (aa a) (borrow nil) diff)
3035 (while (and aa b)
3036 (if borrow
3037 (if (>= (setq diff (- (car aa) (car b))) 1)
3038 (progn
3039 (setcar aa (1- diff))
3040 (setq borrow nil))
3041 (setcar aa (+ diff (1- math-bignum-digit-size))))
3042 (if (>= (setq diff (- (car aa) (car b))) 0)
3043 (setcar aa diff)
3044 (setcar aa (+ diff math-bignum-digit-size))
3045 (setq borrow t)))
3046 (setq aa (cdr aa)
3047 b (cdr b)))
3048 (if borrow
3049 (progn
3050 (while (eq (car aa) 0)
3051 (setcar aa (1- math-bignum-digit-size))
3052 (setq aa (cdr aa)))
3053 (if aa
3054 (progn
3055 (setcar aa (1- (car aa)))
3056 a)
3057 'neg))
3058 (while (eq (car b) 0)
3059 (setq b (cdr b)))
3060 (if b
3061 'neg
3062 a)))
3063 (while (eq (car b) 0)
3064 (setq b (cdr b)))
3065 (and b
3066 'neg))
3067 a))
3068
3069(defun math-add-float (a b) ; [F F F] 2778(defun math-add-float (a b) ; [F F F]
3070 (let ((ediff (- (nth 2 a) (nth 2 b)))) 2779 (let ((ediff (- (nth 2 a) (nth 2 b))))
3071 (if (>= ediff 0) 2780 (if (>= ediff 0)
@@ -3088,9 +2797,7 @@ largest Emacs integer.")
3088 (if (or (consp a) (consp b)) 2797 (if (or (consp a) (consp b))
3089 (math-add a (math-neg b)) 2798 (math-add a (math-neg b))
3090 (setq a (- a b)) 2799 (setq a (- a b))
3091 (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size)) 2800 a))
3092 (math-bignum a)
3093 a)))
3094 2801
3095(defun math-sub-float (a b) ; [F F F] 2802(defun math-sub-float (a b) ; [F F F]
3096 (let ((ediff (- (nth 2 a) (nth 2 b)))) 2803 (let ((ediff (- (nth 2 a) (nth 2 b))))
@@ -3115,8 +2822,6 @@ largest Emacs integer.")
3115(defun math-mul (a b) 2822(defun math-mul (a b)
3116 (or 2823 (or
3117 (and (not (consp a)) (not (consp b)) 2824 (and (not (consp a)) (not (consp b))
3118 (< a math-bignum-digit-size) (> a (- math-bignum-digit-size))
3119 (< b math-bignum-digit-size) (> b (- math-bignum-digit-size))
3120 (* a b)) 2825 (* a b))
3121 (and (Math-zerop a) (not (eq (car-safe b) 'mod)) 2826 (and (Math-zerop a) (not (eq (car-safe b) 'mod))
3122 (if (Math-scalarp b) 2827 (if (Math-scalarp b)
@@ -3130,17 +2835,6 @@ largest Emacs integer.")
3130 (math-mul-zero b a))) 2835 (math-mul-zero b a)))
3131 (and (Math-objvecp a) (Math-objvecp b) 2836 (and (Math-objvecp a) (Math-objvecp b)
3132 (or 2837 (or
3133 (and (Math-integerp a) (Math-integerp b)
3134 (progn
3135 (or (consp a) (setq a (math-bignum a)))
3136 (or (consp b) (setq b (math-bignum b)))
3137 (math-normalize
3138 (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
3139 (if (cdr (cdr a))
3140 (if (cdr (cdr b))
3141 (math-mul-bignum (cdr a) (cdr b))
3142 (math-mul-bignum-digit (cdr a) (nth 1 b) 0))
3143 (math-mul-bignum-digit (cdr b) (nth 1 a) 0))))))
3144 (and (Math-ratp a) (Math-ratp b) 2838 (and (Math-ratp a) (Math-ratp b)
3145 (require 'calc-ext) 2839 (require 'calc-ext)
3146 (calc-mul-fractions a b)) 2840 (calc-mul-fractions a b))
@@ -3169,146 +2863,19 @@ largest Emacs integer.")
3169 '(var uinf var-uinf) 2863 '(var uinf var-uinf)
3170 a))) 2864 a)))
3171 2865
3172;;; Multiply digit lists A and B. [L L L; l l l]
3173(defun math-mul-bignum (a b)
3174 (and a b
3175 (let* ((sum (if (<= (car b) 1)
3176 (if (= (car b) 0)
3177 (list 0)
3178 (copy-sequence a))
3179 (math-mul-bignum-digit a (car b) 0)))
3180 (sump sum) c d aa ss prod)
3181 (while (setq b (cdr b))
3182 (setq ss (setq sump (or (cdr sump) (setcdr sump (list 0))))
3183 d (car b)
3184 c 0
3185 aa a)
3186 (while (progn
3187 (setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d))
3188 c))
3189 math-bignum-digit-size))
3190 (setq aa (cdr aa)))
3191 (setq c (/ prod math-bignum-digit-size)
3192 ss (or (cdr ss) (setcdr ss (list 0)))))
3193 (if (>= prod math-bignum-digit-size)
3194 (if (cdr ss)
3195 (setcar (cdr ss) (+ (/ prod math-bignum-digit-size) (car (cdr ss))))
3196 (setcdr ss (list (/ prod math-bignum-digit-size))))))
3197 sum)))
3198
3199;;; Multiply digit list A by digit D. [L L D D; l l D D]
3200(defun math-mul-bignum-digit (a d c)
3201 (if a
3202 (if (<= d 1)
3203 (and (= d 1) a)
3204 (let* ((a (copy-sequence a)) (aa a) prod)
3205 (while (progn
3206 (setcar aa
3207 (% (setq prod (+ (* (car aa) d) c))
3208 math-bignum-digit-size))
3209 (cdr aa))
3210 (setq aa (cdr aa)
3211 c (/ prod math-bignum-digit-size)))
3212 (if (>= prod math-bignum-digit-size)
3213 (setcdr aa (list (/ prod math-bignum-digit-size))))
3214 a))
3215 (and (> c 0)
3216 (list c))))
3217
3218
3219;;; Compute the integer (quotient . remainder) of A and B, which may be 2866;;; Compute the integer (quotient . remainder) of A and B, which may be
3220;;; small or big integers. Type and consistency of truncation is undefined 2867;;; small or big integers. Type and consistency of truncation is undefined
3221;;; if A or B is negative. B must be nonzero. [I.I I I] [Public] 2868;;; if A or B is negative. B must be nonzero. [I.I I I] [Public]
3222(defun math-idivmod (a b) 2869(defun math-idivmod (a b)
3223 (if (eq b 0) 2870 (if (eq b 0)
3224 (math-reject-arg a "*Division by zero")) 2871 (math-reject-arg a "*Division by zero"))
3225 (if (or (consp a) (consp b)) 2872 (cons (/ a b) (% a b)))
3226 (if (and (natnump b) (< b math-bignum-digit-size))
3227 (let ((res (math-div-bignum-digit (cdr a) b)))
3228 (cons
3229 (math-normalize (cons (car a) (car res)))
3230 (cdr res)))
3231 (or (consp a) (setq a (math-bignum a)))
3232 (or (consp b) (setq b (math-bignum b)))
3233 (let ((res (math-div-bignum (cdr a) (cdr b))))
3234 (cons
3235 (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
3236 (car res)))
3237 (math-normalize (cons (car a) (cdr res))))))
3238 (cons (/ a b) (% a b))))
3239 2873
3240(defun math-quotient (a b) ; [I I I] [Public] 2874(defun math-quotient (a b) ; [I I I] [Public]
3241 (if (and (not (consp a)) (not (consp b))) 2875 (if (and (not (consp a)) (not (consp b)))
3242 (if (= b 0) 2876 (if (= b 0)
3243 (math-reject-arg a "*Division by zero") 2877 (math-reject-arg a "*Division by zero")
3244 (/ a b)) 2878 (/ a b))))
3245 (if (and (natnump b) (< b math-bignum-digit-size))
3246 (if (= b 0)
3247 (math-reject-arg a "*Division by zero")
3248 (math-normalize (cons (car a)
3249 (car (math-div-bignum-digit (cdr a) b)))))
3250 (or (consp a) (setq a (math-bignum a)))
3251 (or (consp b) (setq b (math-bignum b)))
3252 (let* ((alen (1- (length a)))
3253 (blen (1- (length b)))
3254 (d (/ math-bignum-digit-size (1+ (nth (1- blen) (cdr b)))))
3255 (res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0)
3256 (math-mul-bignum-digit (cdr b) d 0)
3257 alen blen)))
3258 (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
3259 (car res)))))))
3260
3261
3262;;; Divide a bignum digit list by another. [l.l l L]
3263;;; The following division algorithm is borrowed from Knuth vol. II, sec. 4.3.1
3264(defun math-div-bignum (a b)
3265 (if (cdr b)
3266 (let* ((alen (length a))
3267 (blen (length b))
3268 (d (/ math-bignum-digit-size (1+ (nth (1- blen) b))))
3269 (res (math-div-bignum-big (math-mul-bignum-digit a d 0)
3270 (math-mul-bignum-digit b d 0)
3271 alen blen)))
3272 (if (= d 1)
3273 res
3274 (cons (car res)
3275 (car (math-div-bignum-digit (cdr res) d)))))
3276 (let ((res (math-div-bignum-digit a (car b))))
3277 (cons (car res) (list (cdr res))))))
3278
3279;;; Divide a bignum digit list by a digit. [l.D l D]
3280(defun math-div-bignum-digit (a b)
3281 (if a
3282 (let* ((res (math-div-bignum-digit (cdr a) b))
3283 (num (+ (* (cdr res) math-bignum-digit-size) (car a))))
3284 (cons
3285 (cons (/ num b) (car res))
3286 (% num b)))
3287 '(nil . 0)))
3288
3289(defun math-div-bignum-big (a b alen blen) ; [l.l l L]
3290 (if (< alen blen)
3291 (cons nil a)
3292 (let* ((res (math-div-bignum-big (cdr a) b (1- alen) blen))
3293 (num (cons (car a) (cdr res)))
3294 (res2 (math-div-bignum-part num b blen)))
3295 (cons
3296 (cons (car res2) (car res))
3297 (cdr res2)))))
3298
3299(defun math-div-bignum-part (a b blen) ; a < b*math-bignum-digit-size [D.l l L]
3300 (let* ((num (+ (* (or (nth blen a) 0) math-bignum-digit-size)
3301 (or (nth (1- blen) a) 0)))
3302 (den (nth (1- blen) b))
3303 (guess (min (/ num den) (1- math-bignum-digit-size))))
3304 (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)))
3305
3306(defun math-div-bignum-try (a b c guess) ; [D.l l l D]
3307 (let ((rem (math-sub-bignum a c)))
3308 (if (eq rem 'neg)
3309 (math-div-bignum-try a b (math-sub-bignum c b) (1- guess))
3310 (cons guess rem))))
3311
3312 2879
3313;;; Compute the quotient of A and B. [O O N] [Public] 2880;;; Compute the quotient of A and B. [O O N] [Public]
3314(defun math-div (a b) 2881(defun math-div (a b)
@@ -3532,11 +3099,11 @@ largest Emacs integer.")
3532 (math-format-binary a) 3099 (math-format-binary a)
3533 (math-format-radix a)))) 3100 (math-format-radix a))))
3534 (math-format-radix a)))) 3101 (math-format-radix a))))
3535 (math-format-number (math-bignum a)))) 3102 (require 'calc-ext)
3103 (declare-function math--format-integer-fancy "calc-ext" (a))
3104 (concat (if (< a 0) "-") (math--format-integer-fancy (abs a)))))
3536 ((stringp a) a) 3105 ((stringp a) a)
3537 ((not (consp a)) (prin1-to-string a)) 3106 ((not (consp a)) (prin1-to-string a))
3538 ((eq (car a) 'bigpos) (math-format-bignum (cdr a)))
3539 ((eq (car a) 'bigneg) (concat "-" (math-format-bignum (cdr a))))
3540 ((and (eq (car a) 'float) (= calc-number-radix 10)) 3107 ((and (eq (car a) 'float) (= calc-number-radix 10))
3541 (if (Math-integer-negp (nth 1 a)) 3108 (if (Math-integer-negp (nth 1 a))
3542 (concat "-" (math-format-number (math-neg a))) 3109 (concat "-" (math-format-number (math-neg a)))
@@ -3551,9 +3118,7 @@ largest Emacs integer.")
3551 (> (+ exp (math-numdigs mant)) (- figs)))) 3118 (> (+ exp (math-numdigs mant)) (- figs))))
3552 (progn 3119 (progn
3553 (setq mant (math-scale-rounding mant (+ exp figs)) 3120 (setq mant (math-scale-rounding mant (+ exp figs))
3554 str (if (integerp mant) 3121 str (int-to-string mant))
3555 (int-to-string mant)
3556 (math-format-bignum-decimal (cdr mant))))
3557 (if (<= (length str) figs) 3122 (if (<= (length str) figs)
3558 (setq str (concat (make-string (1+ (- figs (length str))) ?0) 3123 (setq str (concat (make-string (1+ (- figs (length str))) ?0)
3559 str))) 3124 str)))
@@ -3571,9 +3136,7 @@ largest Emacs integer.")
3571 (when (< adj 0) 3136 (when (< adj 0)
3572 (setq mant (math-scale-rounding mant adj) 3137 (setq mant (math-scale-rounding mant adj)
3573 exp (- exp adj))))) 3138 exp (- exp adj)))))
3574 (setq str (if (integerp mant) 3139 (setq str (int-to-string mant))
3575 (int-to-string mant)
3576 (math-format-bignum-decimal (cdr mant))))
3577 (let* ((len (length str)) 3140 (let* ((len (length str))
3578 (dpos (+ exp len))) 3141 (dpos (+ exp len)))
3579 (if (and (eq fmt 'float) 3142 (if (and (eq fmt 'float)
@@ -3617,31 +3180,6 @@ largest Emacs integer.")
3617 (require 'calc-ext) 3180 (require 'calc-ext)
3618 (math-format-number-fancy a prec)))) 3181 (math-format-number-fancy a prec))))
3619 3182
3620(defun math-format-bignum (a) ; [X L]
3621 (if (and (= calc-number-radix 10)
3622 (not calc-leading-zeros)
3623 (not calc-group-digits))
3624 (math-format-bignum-decimal a)
3625 (require 'calc-ext)
3626 (math-format-bignum-fancy a)))
3627
3628(defun math-format-bignum-decimal (a) ; [X L]
3629 (if a
3630 (let ((s ""))
3631 (while (cdr (cdr a))
3632 (setq s (concat
3633 (format
3634 (concat "%0"
3635 (number-to-string (* 2 math-bignum-digit-length))
3636 "d")
3637 (+ (* (nth 1 a) math-bignum-digit-size) (car a))) s)
3638 a (cdr (cdr a))))
3639 (concat (int-to-string
3640 (+ (* (or (nth 1 a) 0) math-bignum-digit-size) (car a))) s))
3641 "0"))
3642
3643
3644
3645;;; Parse a simple number in string form. [N X] [Public] 3183;;; Parse a simple number in string form. [N X] [Public]
3646(defun math-read-number (s &optional decimal) 3184(defun math-read-number (s &optional decimal)
3647 "Convert the string S into a Calc number." 3185 "Convert the string S into a Calc number."
@@ -3657,9 +3195,7 @@ largest Emacs integer.")
3657 (eq (aref digs 0) ?0) 3195 (eq (aref digs 0) ?0)
3658 (null decimal)) 3196 (null decimal))
3659 (math-read-number (concat "8#" digs)) 3197 (math-read-number (concat "8#" digs))
3660 (if (<= (length digs) (* 2 math-bignum-digit-length)) 3198 (string-to-number digs))))
3661 (string-to-number digs)
3662 (cons 'bigpos (math-read-bignum digs))))))
3663 3199
3664 ;; Clean up the string if necessary 3200 ;; Clean up the string if necessary
3665 ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) 3201 ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s)
@@ -3714,14 +3250,10 @@ and all digits are kept, regardless of Calc's current precision."
3714 ((string-match "^[0-9]+$" s) 3250 ((string-match "^[0-9]+$" s)
3715 (if (string-match "^\\(0+\\)" s) 3251 (if (string-match "^\\(0+\\)" s)
3716 (setq s (substring s (match-end 0)))) 3252 (setq s (substring s (match-end 0))))
3717 (if (<= (length s) (* 2 math-bignum-digit-length)) 3253 (string-to-number s))
3718 (string-to-number s)
3719 (cons 'bigpos (math-read-bignum s))))
3720 ;; Minus sign 3254 ;; Minus sign
3721 ((string-match "^-[0-9]+$" s) 3255 ((string-match "^-[0-9]+$" s)
3722 (if (<= (length s) (1+ (* 2 math-bignum-digit-length))) 3256 (string-to-number s))
3723 (string-to-number s)
3724 (cons 'bigneg (math-read-bignum (substring s 1)))))
3725 ;; Decimal point 3257 ;; Decimal point
3726 ((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s) 3258 ((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s)
3727 (let ((int (math-match-substring s 1)) 3259 (let ((int (math-match-substring s 1))
@@ -3736,12 +3268,6 @@ and all digits are kept, regardless of Calc's current precision."
3736 (substring s (match-beginning n) (match-end n)) 3268 (substring s (match-beginning n) (match-end n))
3737 "")) 3269 ""))
3738 3270
3739(defun math-read-bignum (s) ; [l X]
3740 (if (> (length s) math-bignum-digit-length)
3741 (cons (string-to-number (substring s (- math-bignum-digit-length)))
3742 (math-read-bignum (substring s 0 (- math-bignum-digit-length))))
3743 (list (string-to-number s))))
3744
3745(defconst math-standard-opers 3271(defconst math-standard-opers
3746 '( ( "_" calcFunc-subscr 1200 1201 ) 3272 '( ( "_" calcFunc-subscr 1200 1201 )
3747 ( "%" calcFunc-percent 1100 -1 ) 3273 ( "%" calcFunc-percent 1100 -1 )
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-21 15:11:51 +0000