* 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.
This commit is contained in:
Stefan Monnier
parent
9552ee4df7
commit
1bc1672f77
11 changed files with 168 additions and 936 deletions
|
|
@ -82,7 +82,7 @@
|
|||
" ")
|
||||
shortbuf buf)
|
||||
(if (and (= (length alg-exp) 1)
|
||||
(memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
|
||||
(memq (car-safe (car alg-exp)) '(nil))
|
||||
(< (length buf) 20)
|
||||
(= calc-number-radix 10))
|
||||
(setq buf (concat buf " ("
|
||||
|
|
|
|||
|
|
@ -258,9 +258,9 @@
|
|||
(and (eq comp 0)
|
||||
(not (equal a b))
|
||||
(> (length (memq (car-safe a)
|
||||
'(bigneg nil bigpos frac float)))
|
||||
'(nil frac float)))
|
||||
(length (memq (car-safe b)
|
||||
'(bigneg nil bigpos frac float))))))))
|
||||
'(nil frac float))))))))
|
||||
((equal b '(neg (var inf var-inf))) nil)
|
||||
((equal a '(neg (var inf var-inf))) t)
|
||||
((equal a '(var inf var-inf)) nil)
|
||||
|
|
|
|||
|
|
@ -28,17 +28,6 @@
|
|||
(require 'calc-ext)
|
||||
(require 'calc-macs)
|
||||
|
||||
;;; Some useful numbers
|
||||
(defconst math-bignum-logb-digit-size
|
||||
(logb math-bignum-digit-size)
|
||||
"The logb of the size of a bignum digit.
|
||||
This is the largest value of B such that 2^B is less than
|
||||
the size of a Calc bignum digit.")
|
||||
|
||||
(defconst math-bignum-digit-power-of-two
|
||||
(expt 2 (logb math-bignum-digit-size))
|
||||
"The largest power of 2 less than the size of a Calc bignum digit.")
|
||||
|
||||
;;; b-prefix binary commands.
|
||||
|
||||
(defun calc-and (n)
|
||||
|
|
@ -268,18 +257,14 @@ the size of a Calc bignum digit.")
|
|||
(math-reject-arg a 'integerp))
|
||||
((not (Math-num-integerp b))
|
||||
(math-reject-arg b 'integerp))
|
||||
(t (math-clip (cons 'bigpos
|
||||
(math-and-bignum (math-binary-arg a w)
|
||||
(math-binary-arg b w)))
|
||||
w))))
|
||||
(t (math-clip (logand (math-binary-arg a w) (math-binary-arg b w)) w))))
|
||||
|
||||
(defun math-binary-arg (a w)
|
||||
(if (not (Math-integerp a))
|
||||
(setq a (math-trunc a)))
|
||||
(if (Math-integer-negp a)
|
||||
(math-not-bignum (cdr (math-bignum-test (math-sub -1 a)))
|
||||
(math-abs (if w (math-trunc w) calc-word-size)))
|
||||
(cdr (Math-bignum-test a))))
|
||||
(if (< a 0)
|
||||
(logand a (1- (ash 1 (if w (math-trunc w) calc-word-size))))
|
||||
a))
|
||||
|
||||
(defun math-binary-modulo-args (f a b w)
|
||||
(let (mod)
|
||||
|
|
@ -310,15 +295,6 @@ the size of a Calc bignum digit.")
|
|||
(funcall f a w))
|
||||
mod))))
|
||||
|
||||
(defun math-and-bignum (a b) ; [l l l]
|
||||
(and a b
|
||||
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
|
||||
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
|
||||
(math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa))
|
||||
(math-norm-bignum (car qb)))
|
||||
math-bignum-digit-power-of-two
|
||||
(logand (cdr qa) (cdr qb))))))
|
||||
|
||||
(defun calcFunc-or (a b &optional w) ; [I I I] [Public]
|
||||
(cond ((Math-messy-integerp w)
|
||||
(calcFunc-or a b (math-trunc w)))
|
||||
|
|
@ -332,19 +308,7 @@ the size of a Calc bignum digit.")
|
|||
(math-reject-arg a 'integerp))
|
||||
((not (Math-num-integerp b))
|
||||
(math-reject-arg b 'integerp))
|
||||
(t (math-clip (cons 'bigpos
|
||||
(math-or-bignum (math-binary-arg a w)
|
||||
(math-binary-arg b w)))
|
||||
w))))
|
||||
|
||||
(defun math-or-bignum (a b) ; [l l l]
|
||||
(and (or a b)
|
||||
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
|
||||
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
|
||||
(math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa))
|
||||
(math-norm-bignum (car qb)))
|
||||
math-bignum-digit-power-of-two
|
||||
(logior (cdr qa) (cdr qb))))))
|
||||
(t (math-clip (logior (math-binary-arg a w) (math-binary-arg b w)) w))))
|
||||
|
||||
(defun calcFunc-xor (a b &optional w) ; [I I I] [Public]
|
||||
(cond ((Math-messy-integerp w)
|
||||
|
|
@ -359,19 +323,7 @@ the size of a Calc bignum digit.")
|
|||
(math-reject-arg a 'integerp))
|
||||
((not (Math-num-integerp b))
|
||||
(math-reject-arg b 'integerp))
|
||||
(t (math-clip (cons 'bigpos
|
||||
(math-xor-bignum (math-binary-arg a w)
|
||||
(math-binary-arg b w)))
|
||||
w))))
|
||||
|
||||
(defun math-xor-bignum (a b) ; [l l l]
|
||||
(and (or a b)
|
||||
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
|
||||
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
|
||||
(math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa))
|
||||
(math-norm-bignum (car qb)))
|
||||
math-bignum-digit-power-of-two
|
||||
(logxor (cdr qa) (cdr qb))))))
|
||||
(t (math-clip (logxor (math-binary-arg a w) (math-binary-arg b w)) w))))
|
||||
|
||||
(defun calcFunc-diff (a b &optional w) ; [I I I] [Public]
|
||||
(cond ((Math-messy-integerp w)
|
||||
|
|
@ -386,19 +338,9 @@ the size of a Calc bignum digit.")
|
|||
(math-reject-arg a 'integerp))
|
||||
((not (Math-num-integerp b))
|
||||
(math-reject-arg b 'integerp))
|
||||
(t (math-clip (cons 'bigpos
|
||||
(math-diff-bignum (math-binary-arg a w)
|
||||
(math-binary-arg b w)))
|
||||
w))))
|
||||
|
||||
(defun math-diff-bignum (a b) ; [l l l]
|
||||
(and a
|
||||
(let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
|
||||
(qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
|
||||
(math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa))
|
||||
(math-norm-bignum (car qb)))
|
||||
math-bignum-digit-power-of-two
|
||||
(logand (cdr qa) (lognot (cdr qb)))))))
|
||||
(t (math-clip (logand (math-binary-arg a w)
|
||||
(lognot (math-binary-arg b w)))
|
||||
w))))
|
||||
|
||||
(defun calcFunc-not (a &optional w) ; [I I] [Public]
|
||||
(cond ((Math-messy-integerp w)
|
||||
|
|
@ -411,21 +353,7 @@ the size of a Calc bignum digit.")
|
|||
(math-reject-arg a 'integerp))
|
||||
((< (or w (setq w calc-word-size)) 0)
|
||||
(math-clip (calcFunc-not a (- w)) w))
|
||||
(t (math-normalize
|
||||
(cons 'bigpos
|
||||
(math-not-bignum (math-binary-arg a w)
|
||||
w))))))
|
||||
|
||||
(defun math-not-bignum (a w) ; [l l]
|
||||
(let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
|
||||
(if (<= w math-bignum-logb-digit-size)
|
||||
(list (logand (lognot (cdr q))
|
||||
(1- (ash 1 w))))
|
||||
(math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
|
||||
(- w math-bignum-logb-digit-size))
|
||||
math-bignum-digit-power-of-two
|
||||
(logxor (cdr q)
|
||||
(1- math-bignum-digit-power-of-two))))))
|
||||
(t (math-clip (lognot (math-binary-arg a w)) w))))
|
||||
|
||||
(defun calcFunc-lsh (a &optional n w) ; [I I] [Public]
|
||||
(setq a (math-trunc a)
|
||||
|
|
@ -525,29 +453,12 @@ the size of a Calc bignum digit.")
|
|||
a
|
||||
(math-sub a (math-power-of-2 (- w)))))
|
||||
((Math-negp a)
|
||||
(math-normalize (cons 'bigpos (math-binary-arg a w))))
|
||||
((and (integerp a) (< a math-small-integer-size))
|
||||
(if (> w (logb math-small-integer-size))
|
||||
a
|
||||
(logand a (1- (ash 1 w)))))
|
||||
(t
|
||||
(math-normalize
|
||||
(cons 'bigpos
|
||||
(math-clip-bignum (cdr (math-bignum-test (math-trunc a)))
|
||||
w))))))
|
||||
(math-binary-arg a w))
|
||||
((integerp a)
|
||||
(logand a (1- (ash 1 w))))))
|
||||
|
||||
(defalias 'calcFunc-clip 'math-clip)
|
||||
|
||||
(defun math-clip-bignum (a w) ; [l l]
|
||||
(let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
|
||||
(if (<= w math-bignum-logb-digit-size)
|
||||
(list (logand (cdr q)
|
||||
(1- (ash 1 w))))
|
||||
(math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q))
|
||||
(- w math-bignum-logb-digit-size))
|
||||
math-bignum-digit-power-of-two
|
||||
(cdr q)))))
|
||||
|
||||
(defvar math-max-digits-cache nil)
|
||||
(defun math-compute-max-digits (w r)
|
||||
(let* ((pair (+ (* r 100000) w))
|
||||
|
|
@ -601,54 +512,12 @@ the size of a Calc bignum digit.")
|
|||
(if (< a 8)
|
||||
(if (< a 0)
|
||||
(concat "-" (math-format-binary (- a)))
|
||||
(math-format-radix a))
|
||||
(aref math-binary-digits a))
|
||||
(let ((s ""))
|
||||
(while (> a 7)
|
||||
(setq s (concat (aref math-binary-digits (% a 8)) s)
|
||||
a (/ a 8)))
|
||||
(concat (math-format-radix a) s))))
|
||||
|
||||
(defun math-format-bignum-radix (a) ; [X L]
|
||||
(cond ((null a) "0")
|
||||
((and (null (cdr a))
|
||||
(< (car a) calc-number-radix))
|
||||
(math-format-radix-digit (car a)))
|
||||
(t
|
||||
(let ((q (math-div-bignum-digit a calc-number-radix)))
|
||||
(concat (math-format-bignum-radix (math-norm-bignum (car q)))
|
||||
(math-format-radix-digit (cdr q)))))))
|
||||
|
||||
(defun math-format-bignum-binary (a) ; [X L]
|
||||
(cond ((null a) "0")
|
||||
((null (cdr a))
|
||||
(math-format-binary (car a)))
|
||||
(t
|
||||
(let ((q (math-div-bignum-digit a 512)))
|
||||
(concat (math-format-bignum-binary (math-norm-bignum (car q)))
|
||||
(aref math-binary-digits (/ (cdr q) 64))
|
||||
(aref math-binary-digits (% (/ (cdr q) 8) 8))
|
||||
(aref math-binary-digits (% (cdr q) 8)))))))
|
||||
|
||||
(defun math-format-bignum-octal (a) ; [X L]
|
||||
(cond ((null a) "0")
|
||||
((null (cdr a))
|
||||
(math-format-radix (car a)))
|
||||
(t
|
||||
(let ((q (math-div-bignum-digit a 512)))
|
||||
(concat (math-format-bignum-octal (math-norm-bignum (car q)))
|
||||
(math-format-radix-digit (/ (cdr q) 64))
|
||||
(math-format-radix-digit (% (/ (cdr q) 8) 8))
|
||||
(math-format-radix-digit (% (cdr q) 8)))))))
|
||||
|
||||
(defun math-format-bignum-hex (a) ; [X L]
|
||||
(cond ((null a) "0")
|
||||
((null (cdr a))
|
||||
(math-format-radix (car a)))
|
||||
(t
|
||||
(let ((q (math-div-bignum-digit a 256)))
|
||||
(concat (math-format-bignum-hex (math-norm-bignum (car q)))
|
||||
(math-format-radix-digit (/ (cdr q) 16))
|
||||
(math-format-radix-digit (% (cdr q) 16)))))))
|
||||
(concat (math-format-binary a) s))))
|
||||
|
||||
;;; Decompose into integer and fractional parts, without depending
|
||||
;;; on calc-internal-prec.
|
||||
|
|
@ -665,7 +534,7 @@ the size of a Calc bignum digit.")
|
|||
(list (math-scale-rounding (nth 1 a) (nth 2 a))
|
||||
'(float 0 0) 0)))))
|
||||
|
||||
(defun math-format-radix-float (a prec)
|
||||
(defun math-format-radix-float (a _prec)
|
||||
(let ((fmt (car calc-float-format))
|
||||
(figs (nth 1 calc-float-format))
|
||||
(point calc-point-char)
|
||||
|
|
@ -823,20 +692,14 @@ the size of a Calc bignum digit.")
|
|||
(defun math-format-twos-complement (a)
|
||||
"Format an integer in two's complement mode."
|
||||
(let* (;(calc-leading-zeros t)
|
||||
(overflow nil)
|
||||
(negative nil)
|
||||
(num
|
||||
(cond
|
||||
((or (eq a 0)
|
||||
(and (Math-integer-posp a)))
|
||||
(if (integerp a)
|
||||
(math-format-radix a)
|
||||
(math-format-bignum-radix (cdr a))))
|
||||
(Math-integer-posp a))
|
||||
(math-format-radix a))
|
||||
((Math-integer-negp a)
|
||||
(let ((newa (math-add a math-2-word-size)))
|
||||
(if (integerp newa)
|
||||
(math-format-radix newa)
|
||||
(math-format-bignum-radix (cdr newa))))))))
|
||||
(math-format-radix newa))))))
|
||||
(let* ((calc-internal-prec 6)
|
||||
(digs (math-compute-max-digits (math-abs calc-word-size)
|
||||
calc-number-radix))
|
||||
|
|
|
|||
|
|
@ -211,8 +211,8 @@
|
|||
(calc-invert-func)
|
||||
(calc-next-prime iters))
|
||||
|
||||
(defun calc-prime-factors (iters)
|
||||
(interactive "p")
|
||||
(defun calc-prime-factors (&optional _iters)
|
||||
(interactive)
|
||||
(calc-slow-wrapper
|
||||
(let ((res (calcFunc-prfac (calc-top-n 1))))
|
||||
(if (not math-prime-factors-finished)
|
||||
|
|
@ -806,7 +806,6 @@
|
|||
((Math-integer-negp n)
|
||||
'(nil))
|
||||
((Math-natnum-lessp n 8000000)
|
||||
(setq n (math-fixnum n))
|
||||
(let ((i -1) v)
|
||||
(while (and (> (% n (setq v (aref math-primes-table
|
||||
(setq i (1+ i)))))
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@
|
|||
|
||||
(require 'calc)
|
||||
(require 'calc-macs)
|
||||
(require 'cl-lib)
|
||||
|
||||
;; Declare functions which are defined elsewhere.
|
||||
(declare-function math-clip "calc-bin" (a &optional w))
|
||||
|
|
@ -62,10 +63,10 @@
|
|||
(declare-function math-format-radix-float "calc-bin" (a prec))
|
||||
(declare-function math-compose-expr "calccomp" (a prec &optional div))
|
||||
(declare-function math-abs "calc-arith" (a))
|
||||
(declare-function math-format-bignum-binary "calc-bin" (a))
|
||||
(declare-function math-format-bignum-octal "calc-bin" (a))
|
||||
(declare-function math-format-bignum-hex "calc-bin" (a))
|
||||
(declare-function math-format-bignum-radix "calc-bin" (a))
|
||||
(declare-function math-format-binary "calc-bin" (a))
|
||||
(declare-function math-format-octal "calc-bin" (a))
|
||||
(declare-function math-format-hex "calc-bin" (a))
|
||||
(declare-function math-format-radix "calc-bin" (a))
|
||||
(declare-function math-compute-max-digits "calc-bin" (w r))
|
||||
(declare-function math-map-vec "calc-vec" (f a))
|
||||
(declare-function math-make-frac "calc-frac" (num den))
|
||||
|
|
@ -779,8 +780,7 @@ math-sqr-float math-trunc-fancy math-trunc-special)
|
|||
calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or
|
||||
calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip
|
||||
math-compute-max-digits math-convert-radix-digits math-float-parts
|
||||
math-format-bignum-binary math-format-bignum-hex
|
||||
math-format-bignum-octal math-format-bignum-radix math-format-binary
|
||||
math-format-binary
|
||||
math-format-radix math-format-radix-float math-integer-log2
|
||||
math-power-of-2 math-radix-float-power)
|
||||
|
||||
|
|
@ -881,7 +881,7 @@ calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw
|
|||
math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw
|
||||
math-exp-minus-1-raw math-exp-raw
|
||||
math-from-radians math-from-radians-2 math-hypot math-infinite-dir
|
||||
math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float
|
||||
math-ln-raw math-nearly-equal math-nearly-equal-float
|
||||
math-nearly-zerop math-nearly-zerop-float math-nth-root
|
||||
math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw
|
||||
math-tan-raw math-to-radians math-to-radians-2)
|
||||
|
|
@ -2014,11 +2014,11 @@ calc-kill calc-kill-region calc-yank))))
|
|||
(defvar ,cache-prec (cond
|
||||
((consp ,init) (math-numdigs (nth 1 ,init)))
|
||||
(,init
|
||||
(nth 1 (math-numdigs (eval ,init))))
|
||||
(nth 1 (math-numdigs (eval ,init t))))
|
||||
(t
|
||||
-100)))
|
||||
(defvar ,cache-val (cond ((consp ,init) ,init)
|
||||
(,init (eval ,init))
|
||||
(,init (eval ,init t))
|
||||
(t ,init)))
|
||||
(defvar ,last-prec -100)
|
||||
(defvar ,last-val nil)
|
||||
|
|
@ -2117,77 +2117,61 @@ calc-kill calc-kill-region calc-yank))))
|
|||
|
||||
;;; True if A is an odd integer. [P R R] [Public]
|
||||
(defun math-oddp (a)
|
||||
(if (consp a)
|
||||
(and (memq (car a) '(bigpos bigneg))
|
||||
(= (% (nth 1 a) 2) 1))
|
||||
(/= (% a 2) 0)))
|
||||
(and (integerp a) (cl-oddp a)))
|
||||
|
||||
;;; True if A is a small or big integer. [P x] [Public]
|
||||
(defun math-integerp (a)
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg))))
|
||||
;;; True if A is an integer. [P x] [Public]
|
||||
(defalias 'math-integerp #'integerp)
|
||||
|
||||
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
|
||||
(defun math-natnump (a)
|
||||
(or (natnump a)
|
||||
(eq (car-safe a) 'bigpos)))
|
||||
(defalias 'math-natnump #'natnump)
|
||||
|
||||
;;; True if A is a rational (or integer). [P x] [Public]
|
||||
(defun math-ratp (a)
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac))))
|
||||
(defalias 'math-ratp #'Math-ratp)
|
||||
|
||||
;;; True if A is a real (or rational). [P x] [Public]
|
||||
(defun math-realp (a)
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac float))))
|
||||
(defalias 'math-realp #'Math-realp)
|
||||
|
||||
;;; True if A is a real or HMS form. [P x] [Public]
|
||||
(defun math-anglep (a)
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac float hms))))
|
||||
(defalias 'math-anglep #'Math-anglep)
|
||||
|
||||
;;; True if A is a number of any kind. [P x] [Public]
|
||||
(defun math-numberp (a)
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
|
||||
(defalias 'math-numberp #'Math-numberp)
|
||||
|
||||
;;; True if A is a complex number or angle. [P x] [Public]
|
||||
(defun math-scalarp (a)
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
|
||||
(defalias 'math-scalarp #'#'Math-scalarp)
|
||||
|
||||
;;; True if A is a vector. [P x] [Public]
|
||||
(defun math-vectorp (a)
|
||||
(eq (car-safe a) 'vec))
|
||||
(defalias 'math-vectorp #'Math-vectorp)
|
||||
|
||||
;;; True if A is any vector or scalar data object. [P x]
|
||||
(defun math-objvecp (a) ; [Public]
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac float cplx polar
|
||||
hms date sdev intv mod vec incomplete))))
|
||||
(memq (car-safe a) '(frac float cplx polar
|
||||
hms date sdev intv mod vec
|
||||
;; FIXME: Math-objvecp does not include this one!
|
||||
incomplete))))
|
||||
|
||||
;;; True if A is an object not composed of sub-formulas . [P x] [Public]
|
||||
(defun math-primp (a)
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac float cplx polar
|
||||
hms date mod var))))
|
||||
(memq (car-safe a) '(frac float cplx polar
|
||||
hms date mod var))))
|
||||
|
||||
;;; True if A is numerically (but not literally) an integer. [P x] [Public]
|
||||
(defun math-messy-integerp (a)
|
||||
(cond
|
||||
((eq (car-safe a) 'float) (>= (nth 2 a) 0))
|
||||
;; FIXME: Math-messy-integerp does not include this case!
|
||||
((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
|
||||
|
||||
;;; True if A is numerically an integer. [P x] [Public]
|
||||
(defun math-num-integerp (a)
|
||||
(or (Math-integerp a)
|
||||
(or (integerp a)
|
||||
(Math-messy-integerp a)))
|
||||
|
||||
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
|
||||
(defun math-num-natnump (a)
|
||||
(or (natnump a)
|
||||
(eq (car-safe a) 'bigpos)
|
||||
(and (eq (car-safe a) 'float)
|
||||
(Math-natnump (nth 1 a))
|
||||
(>= (nth 2 a) 0))))
|
||||
|
|
@ -2277,28 +2261,24 @@ calc-kill calc-kill-region calc-yank))))
|
|||
;;; True if A is any scalar data object. [P x]
|
||||
(defun math-objectp (a) ; [Public]
|
||||
(or (integerp a)
|
||||
(memq (car-safe a) '(bigpos bigneg frac float cplx
|
||||
polar hms date sdev intv mod))))
|
||||
(memq (car-safe a) '(frac float cplx
|
||||
polar hms date sdev intv mod))))
|
||||
|
||||
;;; Verify that A is an integer and return A in integer form. [I N; - x]
|
||||
(defun math-check-integer (a) ; [Public]
|
||||
(cond ((integerp a) a) ; for speed
|
||||
((math-integerp a) a)
|
||||
(cond ((integerp a) a)
|
||||
((math-messy-integerp a)
|
||||
(math-trunc a))
|
||||
(t (math-reject-arg a 'integerp))))
|
||||
|
||||
;;; Verify that A is a small integer and return A in integer form. [S N; - x]
|
||||
(defun math-check-fixnum (a &optional allow-inf) ; [Public]
|
||||
(cond ((integerp a) a) ; for speed
|
||||
(cond ((fixnump a) a) ; for speed
|
||||
((Math-num-integerp a)
|
||||
(let ((a (math-trunc a)))
|
||||
(if (integerp a)
|
||||
(if (fixnump a)
|
||||
a
|
||||
(if (or (Math-lessp most-positive-fixnum a)
|
||||
(Math-lessp a (- most-positive-fixnum)))
|
||||
(math-reject-arg a 'fixnump)
|
||||
(math-fixnum a)))))
|
||||
(math-reject-arg a 'fixnump))))
|
||||
((and allow-inf (equal a '(var inf var-inf)))
|
||||
most-positive-fixnum)
|
||||
((and allow-inf (equal a '(neg (var inf var-inf))))
|
||||
|
|
@ -2348,20 +2328,6 @@ If X is not an error form, return 1."
|
|||
(memq t (mapcar (lambda (x) (eq (car-safe x) 'sdev)) ls))))
|
||||
|
||||
;;; Coerce integer A to be a small integer. [S I]
|
||||
(defun math-fixnum (a)
|
||||
(if (consp a)
|
||||
(if (cdr a)
|
||||
(if (eq (car a) 'bigneg)
|
||||
(- (math-fixnum-big (cdr a)))
|
||||
(math-fixnum-big (cdr a)))
|
||||
0)
|
||||
a))
|
||||
|
||||
(defun math-fixnum-big (a)
|
||||
(if (cdr a)
|
||||
(+ (car a) (* (math-fixnum-big (cdr a)) math-bignum-digit-size))
|
||||
(car a)))
|
||||
|
||||
(defvar math-simplify-only nil)
|
||||
|
||||
(defun math-normalize-fancy (a)
|
||||
|
|
@ -2468,12 +2434,6 @@ If X is not an error form, return 1."
|
|||
(setcdr last nil)
|
||||
a))))
|
||||
|
||||
(defun math-bignum-test (a) ; [B N; B s; b b]
|
||||
(if (consp a)
|
||||
a
|
||||
(math-bignum a)))
|
||||
|
||||
|
||||
;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
|
||||
(defun calcFunc-sign (a &optional x)
|
||||
(let ((signs (math-possible-signs a)))
|
||||
|
|
@ -2496,17 +2456,7 @@ If X is not an error form, return 1."
|
|||
2
|
||||
0))
|
||||
((and (integerp a) (Math-integerp b))
|
||||
(if (consp b)
|
||||
(if (eq (car b) 'bigpos) -1 1)
|
||||
(if (< a b) -1 1)))
|
||||
((and (eq (car-safe a) 'bigpos) (Math-integerp b))
|
||||
(if (eq (car-safe b) 'bigpos)
|
||||
(math-compare-bignum (cdr a) (cdr b))
|
||||
1))
|
||||
((and (eq (car-safe a) 'bigneg) (Math-integerp b))
|
||||
(if (eq (car-safe b) 'bigneg)
|
||||
(math-compare-bignum (cdr b) (cdr a))
|
||||
-1))
|
||||
(if (< a b) -1 1))
|
||||
((eq (car-safe a) 'frac)
|
||||
(if (eq (car-safe b) 'frac)
|
||||
(math-compare (math-mul (nth 1 a) (nth 2 b))
|
||||
|
|
@ -3451,16 +3401,16 @@ If X is not an error form, return 1."
|
|||
(list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
|
||||
a))
|
||||
|
||||
(defun math-format-bignum-fancy (a) ; [X L]
|
||||
(defun math--format-integer-fancy (a) ; [I]
|
||||
(let ((str (cond ((= calc-number-radix 10)
|
||||
(math-format-bignum-decimal a))
|
||||
(number-to-string a))
|
||||
((= calc-number-radix 2)
|
||||
(math-format-bignum-binary a))
|
||||
(math-format-binary a))
|
||||
((= calc-number-radix 8)
|
||||
(math-format-bignum-octal a))
|
||||
(math-format-octal a))
|
||||
((= calc-number-radix 16)
|
||||
(math-format-bignum-hex a))
|
||||
(t (math-format-bignum-radix a)))))
|
||||
(math-format-hex a))
|
||||
(t (math-format-radix a)))))
|
||||
(if calc-leading-zeros
|
||||
(let* ((calc-internal-prec 6)
|
||||
(digs (math-compute-max-digits (math-abs calc-word-size)
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@
|
|||
|
||||
(require 'calc-ext)
|
||||
(require 'calc-macs)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defun calc-inc-gamma (arg)
|
||||
(interactive "P")
|
||||
|
|
@ -177,7 +178,7 @@
|
|||
'(float 0 0)
|
||||
2)))))))
|
||||
|
||||
(defun math-gamma-series (sum x xinvsqr oterm n)
|
||||
(defun math-gamma-series (sum x xinvsqr _oterm n)
|
||||
(math-working "gamma" sum)
|
||||
(let* ((bn (math-bernoulli-number n))
|
||||
(term (math-mul (math-div-float (math-float (nth 1 bn))
|
||||
|
|
@ -525,7 +526,7 @@
|
|||
bj))
|
||||
(t
|
||||
(if (Math-lessp 100 v) (math-reject-arg v 'range))
|
||||
(let* ((j (logior (+ v (math-isqrt-small (* 40 v))) 1))
|
||||
(let* ((j (logior (+ v (cl-isqrt (* 40 v))) 1))
|
||||
(two-over-x (math-div 2 x))
|
||||
(jsum nil)
|
||||
(bjp '(float 0 0))
|
||||
|
|
|
|||
|
|
@ -29,7 +29,6 @@
|
|||
(declare-function math-looks-negp "calc-misc" (a))
|
||||
(declare-function math-posp "calc-misc" (a))
|
||||
(declare-function math-compare "calc-ext" (a b))
|
||||
(declare-function math-bignum "calc" (a))
|
||||
(declare-function math-compare-bignum "calc-ext" (a b))
|
||||
|
||||
|
||||
|
|
@ -70,29 +69,22 @@
|
|||
;;; Faster in-line version zerop, normalized values only.
|
||||
(defsubst Math-zerop (a) ; [P N]
|
||||
(if (consp a)
|
||||
(and (not (memq (car a) '(bigpos bigneg)))
|
||||
(if (eq (car a) 'float)
|
||||
(eq (nth 1 a) 0)
|
||||
(math-zerop a)))
|
||||
(if (eq (car a) 'float)
|
||||
(eq (nth 1 a) 0)
|
||||
(math-zerop a))
|
||||
(eq a 0)))
|
||||
|
||||
(defsubst Math-integer-negp (a)
|
||||
(if (consp a)
|
||||
(eq (car a) 'bigneg)
|
||||
(< a 0)))
|
||||
(and (integerp a) (< a 0)))
|
||||
|
||||
(defsubst Math-integer-posp (a)
|
||||
(if (consp a)
|
||||
(eq (car a) 'bigpos)
|
||||
(> a 0)))
|
||||
(and (integerp a) (> a 0)))
|
||||
|
||||
(defsubst Math-negp (a)
|
||||
(if (consp a)
|
||||
(or (eq (car a) 'bigneg)
|
||||
(and (not (eq (car a) 'bigpos))
|
||||
(if (memq (car a) '(frac float))
|
||||
(Math-integer-negp (nth 1 a))
|
||||
(math-negp a))))
|
||||
(if (memq (car a) '(frac float))
|
||||
(Math-integer-negp (nth 1 a))
|
||||
(math-negp a))
|
||||
(< a 0)))
|
||||
|
||||
(defsubst Math-looks-negp (a) ; [P x] [Public]
|
||||
|
|
@ -104,44 +96,38 @@
|
|||
|
||||
(defsubst Math-posp (a)
|
||||
(if (consp a)
|
||||
(or (eq (car a) 'bigpos)
|
||||
(and (not (eq (car a) 'bigneg))
|
||||
(if (memq (car a) '(frac float))
|
||||
(Math-integer-posp (nth 1 a))
|
||||
(math-posp a))))
|
||||
(if (memq (car a) '(frac float))
|
||||
(Math-integer-posp (nth 1 a))
|
||||
(math-posp a))
|
||||
(> a 0)))
|
||||
|
||||
(defsubst Math-integerp (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg))))
|
||||
(defalias 'Math-integerp #'integerp)
|
||||
|
||||
(defsubst Math-natnump (a)
|
||||
(if (consp a)
|
||||
(eq (car a) 'bigpos)
|
||||
(>= a 0)))
|
||||
(and (integerp a) (>= a 0)))
|
||||
|
||||
(defsubst Math-ratp (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg frac))))
|
||||
(eq (car a) 'frac)))
|
||||
|
||||
(defsubst Math-realp (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg frac float))))
|
||||
(memq (car a) '(frac float))))
|
||||
|
||||
(defsubst Math-anglep (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg frac float hms))))
|
||||
(memq (car a) '(frac float hms))))
|
||||
|
||||
(defsubst Math-numberp (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg frac float cplx polar))))
|
||||
(memq (car a) '(frac float cplx polar))))
|
||||
|
||||
(defsubst Math-scalarp (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg frac float cplx polar hms))))
|
||||
(memq (car a) '(frac float cplx polar hms))))
|
||||
|
||||
(defsubst Math-vectorp (a)
|
||||
(and (consp a) (eq (car a) 'vec)))
|
||||
(eq (car-safe a) 'vec))
|
||||
|
||||
(defsubst Math-messy-integerp (a)
|
||||
(and (consp a)
|
||||
|
|
@ -151,21 +137,17 @@
|
|||
(defsubst Math-objectp (a) ; [Public]
|
||||
(or (not (consp a))
|
||||
(memq (car a)
|
||||
'(bigpos bigneg frac float cplx polar hms date sdev intv mod))))
|
||||
'(frac float cplx polar hms date sdev intv mod))))
|
||||
|
||||
(defsubst Math-objvecp (a) ; [Public]
|
||||
(or (not (consp a))
|
||||
(memq (car a)
|
||||
'(bigpos bigneg frac float cplx polar hms date
|
||||
sdev intv mod vec))))
|
||||
'(frac float cplx polar hms date
|
||||
sdev intv mod vec))))
|
||||
|
||||
;;; Compute the negative of A. [O O; o o] [Public]
|
||||
(defsubst Math-integer-neg (a)
|
||||
(if (consp a)
|
||||
(if (eq (car a) 'bigpos)
|
||||
(cons 'bigneg (cdr a))
|
||||
(cons 'bigpos (cdr a)))
|
||||
(- a)))
|
||||
(- a))
|
||||
|
||||
(defsubst Math-equal (a b)
|
||||
(= (math-compare a b) 0))
|
||||
|
|
@ -175,20 +157,14 @@
|
|||
|
||||
(defsubst Math-primp (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg frac float cplx polar
|
||||
hms date mod var))))
|
||||
(memq (car a) '(frac float cplx polar
|
||||
hms date mod var))))
|
||||
|
||||
(defsubst Math-num-integerp (a)
|
||||
(or (not (consp a))
|
||||
(memq (car a) '(bigpos bigneg))
|
||||
(and (eq (car a) 'float)
|
||||
(>= (nth 2 a) 0))))
|
||||
|
||||
(defsubst Math-bignum-test (a) ; [B N; B s; b b]
|
||||
(if (consp a)
|
||||
a
|
||||
(math-bignum a)))
|
||||
|
||||
(defsubst Math-equal-int (a b)
|
||||
(or (eq a b)
|
||||
(and (consp a)
|
||||
|
|
|
|||
|
|
@ -25,6 +25,8 @@
|
|||
|
||||
;; This file is autoloaded from calc-ext.el.
|
||||
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'calc-ext)
|
||||
(require 'calc-macs)
|
||||
|
||||
|
|
@ -95,8 +97,7 @@ If this can't be done, return NIL."
|
|||
(and
|
||||
(<= calc-internal-prec math-emacs-precision)
|
||||
(math-realp x)
|
||||
(let* ((fx (math-float x))
|
||||
(xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
|
||||
(let* ((xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
|
||||
(and (<= math-smallest-emacs-expt xpon)
|
||||
(<= xpon math-largest-emacs-expt)
|
||||
(condition-case nil
|
||||
|
|
@ -371,51 +372,15 @@ If this can't be done, return NIL."
|
|||
;;; with an overestimate always works, even using truncating integer division!
|
||||
(defun math-isqrt (a)
|
||||
(cond ((Math-zerop a) a)
|
||||
((not (math-natnump a))
|
||||
((not (natnump a))
|
||||
(math-reject-arg a 'natnump))
|
||||
((integerp a)
|
||||
(math-isqrt-small a))
|
||||
(t
|
||||
(math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a))))))))
|
||||
(t (cl-isqrt a))))
|
||||
|
||||
(defun calcFunc-isqrt (a)
|
||||
(if (math-realp a)
|
||||
(math-isqrt (math-floor a))
|
||||
(math-floor (math-sqrt a))))
|
||||
|
||||
|
||||
;;; This returns (flag . result) where the flag is t if A is a perfect square.
|
||||
(defun math-isqrt-bignum (a) ; [P.l L]
|
||||
(let ((len (length a)))
|
||||
(if (= (% len 2) 0)
|
||||
(let* ((top (nthcdr (- len 2) a)))
|
||||
(math-isqrt-bignum-iter
|
||||
a
|
||||
(math-scale-bignum-digit-size
|
||||
(math-bignum-big
|
||||
(1+ (math-isqrt-small
|
||||
(+ (* (nth 1 top) math-bignum-digit-size) (car top)))))
|
||||
(1- (/ len 2)))))
|
||||
(let* ((top (nth (1- len) a)))
|
||||
(math-isqrt-bignum-iter
|
||||
a
|
||||
(math-scale-bignum-digit-size
|
||||
(list (1+ (math-isqrt-small top)))
|
||||
(/ len 2)))))))
|
||||
|
||||
(defun math-isqrt-bignum-iter (a guess) ; [l L l]
|
||||
(math-working "isqrt" (cons 'bigpos guess))
|
||||
(let* ((q (math-div-bignum a guess))
|
||||
(s (math-add-bignum (car q) guess))
|
||||
(g2 (math-div2-bignum s))
|
||||
(comp (math-compare-bignum g2 guess)))
|
||||
(if (< comp 0)
|
||||
(math-isqrt-bignum-iter a g2)
|
||||
(cons (and (= comp 0)
|
||||
(math-zerop-bignum (cdr q))
|
||||
(= (% (car s) 2) 0))
|
||||
guess))))
|
||||
|
||||
(defun math-zerop-bignum (a)
|
||||
(and (eq (car a) 0)
|
||||
(progn
|
||||
|
|
@ -428,19 +393,6 @@ If this can't be done, return NIL."
|
|||
n (1- n)))
|
||||
a)
|
||||
|
||||
(defun math-isqrt-small (a) ; A > 0. [S S]
|
||||
(let ((g (cond ((>= a 1000000) 10000)
|
||||
((>= a 10000) 1000)
|
||||
((>= a 100) 100)
|
||||
(t 10)))
|
||||
g2)
|
||||
(while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
|
||||
(setq g g2))
|
||||
g))
|
||||
|
||||
|
||||
|
||||
|
||||
;;; Compute the square root of a number.
|
||||
;;; [T N] if possible, else [F N] if possible, else [C N]. [Public]
|
||||
(defun math-sqrt (a)
|
||||
|
|
@ -449,32 +401,24 @@ If this can't be done, return NIL."
|
|||
(and (math-known-nonposp a)
|
||||
(math-imaginary (math-sqrt (math-neg a))))
|
||||
(and (integerp a)
|
||||
(let ((sqrt (math-isqrt-small a)))
|
||||
(let ((sqrt (cl-isqrt a)))
|
||||
(if (= (* sqrt sqrt) a)
|
||||
sqrt
|
||||
(if calc-symbolic-mode
|
||||
(list 'calcFunc-sqrt a)
|
||||
(math-sqrt-float (math-float a) (math-float sqrt))))))
|
||||
(and (eq (car-safe a) 'bigpos)
|
||||
(let* ((res (math-isqrt-bignum (cdr a)))
|
||||
(sqrt (math-normalize (cons 'bigpos (cdr res)))))
|
||||
(if (car res)
|
||||
sqrt
|
||||
(if calc-symbolic-mode
|
||||
(list 'calcFunc-sqrt a)
|
||||
(math-sqrt-float (math-float a) (math-float sqrt))))))
|
||||
(and (eq (car-safe a) 'frac)
|
||||
(let* ((num-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 1 a)))))
|
||||
(num-sqrt (math-normalize (cons 'bigpos (cdr num-res))))
|
||||
(den-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 2 a)))))
|
||||
(den-sqrt (math-normalize (cons 'bigpos (cdr den-res)))))
|
||||
(if (and (car num-res) (car den-res))
|
||||
(let* ((num-sqrt (cl-isqrt (nth 1 a)))
|
||||
(num-exact (= (* num-sqrt num-sqrt) (nth 1 a)))
|
||||
(den-sqrt (cl-isqrt (nth 2 a)))
|
||||
(den-exact (= (* den-sqrt den-sqrt) (nth 2 a))))
|
||||
(if (and num-exact den-exact)
|
||||
(list 'frac num-sqrt den-sqrt)
|
||||
(if calc-symbolic-mode
|
||||
(if (or (car num-res) (car den-res))
|
||||
(math-div (if (car num-res)
|
||||
(if (or num-exact den-exact)
|
||||
(math-div (if num-exact
|
||||
num-sqrt (list 'calcFunc-sqrt (nth 1 a)))
|
||||
(if (car den-res)
|
||||
(if den-exact
|
||||
den-sqrt (list 'calcFunc-sqrt (nth 2 a))))
|
||||
(list 'calcFunc-sqrt a))
|
||||
(math-sqrt-float (math-float a)
|
||||
|
|
@ -482,12 +426,9 @@ If this can't be done, return NIL."
|
|||
(and (eq (car-safe a) 'float)
|
||||
(if calc-symbolic-mode
|
||||
(if (= (% (nth 2 a) 2) 0)
|
||||
(let ((res (math-isqrt-bignum
|
||||
(cdr (Math-bignum-test (nth 1 a))))))
|
||||
(if (car res)
|
||||
(math-make-float (math-normalize
|
||||
(cons 'bigpos (cdr res)))
|
||||
(/ (nth 2 a) 2))
|
||||
(let ((res (cl-isqrt (nth 1 a))))
|
||||
(if (= (* res res) (nth 1 a))
|
||||
(math-make-float res (/ (nth 2 a) 2))
|
||||
(signal 'inexact-result nil)))
|
||||
(signal 'inexact-result nil))
|
||||
(math-sqrt-float a)))
|
||||
|
|
@ -551,7 +492,7 @@ If this can't be done, return NIL."
|
|||
(if (null guess)
|
||||
(let ((ldiff (- (math-numdigs (nth 1 a)) 6)))
|
||||
(or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff)))
|
||||
(setq guess (math-make-float (math-isqrt-small
|
||||
(setq guess (math-make-float (cl-isqrt
|
||||
(math-scale-int (nth 1 a) (- ldiff)))
|
||||
(/ (+ (nth 2 a) ldiff) 2)))))
|
||||
(math-sqrt-float-iter a guess)))))
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@
|
|||
|
||||
(require 'calc)
|
||||
(require 'calc-macs)
|
||||
(require 'cl-lib)
|
||||
|
||||
;; Declare functions which are defined elsewhere.
|
||||
(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).
|
|||
"press SPC, DEL to scroll, C-g to cancel")
|
||||
(memq (setq key (read-event))
|
||||
'(? ?\C-h ?\C-? ?\C-v ?\M-v)))
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(if (memq key '(? ?\C-v))
|
||||
(scroll-up)
|
||||
(scroll-down))
|
||||
|
|
@ -658,10 +659,7 @@ loaded and the keystroke automatically re-typed."
|
|||
;;;###autoload
|
||||
(defun math-zerop (a)
|
||||
(if (consp a)
|
||||
(cond ((memq (car a) '(bigpos bigneg))
|
||||
(while (eq (car (setq a (cdr a))) 0))
|
||||
(null a))
|
||||
((memq (car a) '(frac float polar mod))
|
||||
(cond ((memq (car a) '(frac float polar mod))
|
||||
(math-zerop (nth 1 a)))
|
||||
((eq (car a) 'cplx)
|
||||
(and (math-zerop (nth 1 a)) (math-zerop (nth 2 a))))
|
||||
|
|
@ -677,9 +675,7 @@ loaded and the keystroke automatically re-typed."
|
|||
;;;###autoload
|
||||
(defun math-negp (a)
|
||||
(if (consp a)
|
||||
(cond ((eq (car a) 'bigpos) nil)
|
||||
((eq (car a) 'bigneg) (cdr a))
|
||||
((memq (car a) '(float frac))
|
||||
(cond ((memq (car a) '(float frac))
|
||||
(Math-integer-negp (nth 1 a)))
|
||||
((eq (car a) 'hms)
|
||||
(if (math-zerop (nth 1 a))
|
||||
|
|
@ -712,9 +708,7 @@ loaded and the keystroke automatically re-typed."
|
|||
;;;###autoload
|
||||
(defun math-posp (a)
|
||||
(if (consp a)
|
||||
(cond ((eq (car a) 'bigpos) (cdr a))
|
||||
((eq (car a) 'bigneg) nil)
|
||||
((memq (car a) '(float frac))
|
||||
(cond ((memq (car a) '(float frac))
|
||||
(Math-integer-posp (nth 1 a)))
|
||||
((eq (car a) 'hms)
|
||||
(if (math-zerop (nth 1 a))
|
||||
|
|
@ -734,36 +728,20 @@ loaded and the keystroke automatically re-typed."
|
|||
(> a 0)))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'math-fixnump 'integerp)
|
||||
(defalias 'math-fixnump #'fixnump)
|
||||
;;;###autoload
|
||||
(defalias 'math-fixnatnump 'natnump)
|
||||
|
||||
(defun math-fixnatnump (x) (and (fixnump x) (natnump x)))
|
||||
|
||||
;; True if A is an even integer. [P R R] [Public]
|
||||
;;;###autoload
|
||||
(defun math-evenp (a)
|
||||
(if (consp a)
|
||||
(and (memq (car a) '(bigpos bigneg))
|
||||
(= (% (nth 1 a) 2) 0))
|
||||
(= (% a 2) 0)))
|
||||
(and (integerp a) (cl-evenp a)))
|
||||
|
||||
;; Compute A / 2, for small or big integer A. [I i]
|
||||
;; If A is negative, type of truncation is undefined.
|
||||
;;;###autoload
|
||||
(defun math-div2 (a)
|
||||
(if (consp a)
|
||||
(if (cdr a)
|
||||
(math-normalize (cons (car a) (math-div2-bignum (cdr a))))
|
||||
0)
|
||||
(/ a 2)))
|
||||
|
||||
;;;###autoload
|
||||
(defun math-div2-bignum (a) ; [l l]
|
||||
(if (cdr a)
|
||||
(cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) (/ math-bignum-digit-size 2)))
|
||||
(math-div2-bignum (cdr a)))
|
||||
(list (/ (car a) 2))))
|
||||
|
||||
(/ a 2))
|
||||
|
||||
;; Reject an argument to a calculator function. [Public]
|
||||
;;;###autoload
|
||||
|
|
|
|||
|
|
@ -242,7 +242,7 @@
|
|||
(cdr item)))
|
||||
((> mode 0)
|
||||
(let ((dims nil)
|
||||
type new row)
|
||||
type new)
|
||||
(setq item (list item))
|
||||
(while (> mode 0)
|
||||
(setq type (calc-unpack-type (car item))
|
||||
|
|
@ -1375,9 +1375,7 @@
|
|||
(aa (if neg (math-sub -1 a) a))
|
||||
(str (if (eq aa 0)
|
||||
""
|
||||
(if (consp aa)
|
||||
(math-format-bignum-binary (cdr aa))
|
||||
(math-format-binary aa))))
|
||||
(math-format-binary aa)))
|
||||
(zero (if neg ?1 ?0))
|
||||
(one (if neg ?0 ?1))
|
||||
(len (length str))
|
||||
|
|
@ -1467,7 +1465,7 @@
|
|||
a)
|
||||
|
||||
(defun math-clean-set (a &optional always-vec)
|
||||
(let ((p a) res)
|
||||
(let ((p a))
|
||||
(while (cdr p)
|
||||
(if (and (eq (car-safe (nth 1 p)) 'intv)
|
||||
(Math-equal (nth 2 (nth 1 p)) (nth 3 (nth 1 p))))
|
||||
|
|
|
|||
|
|
@ -211,7 +211,6 @@
|
|||
(declare-function math-group-float "calc-ext" (str))
|
||||
(declare-function math-mod "calc-misc" (a b))
|
||||
(declare-function math-format-number-fancy "calc-ext" (a prec))
|
||||
(declare-function math-format-bignum-fancy "calc-ext" (a))
|
||||
(declare-function math-read-number-fancy "calc-ext" (s))
|
||||
(declare-function calc-do-grab-region "calc-yank" (top bot arg))
|
||||
(declare-function calc-do-grab-rectangle "calc-yank" (top bot arg &optional reduce))
|
||||
|
|
@ -232,7 +231,6 @@
|
|||
(defcustom calc-settings-file
|
||||
(locate-user-emacs-file "calc.el" ".calc.el")
|
||||
"File in which to record permanent settings."
|
||||
:group 'calc
|
||||
:type '(file))
|
||||
|
||||
(defcustom calc-language-alist
|
||||
|
|
@ -248,14 +246,12 @@
|
|||
(f90-mode . fortran)
|
||||
(texinfo-mode . calc-normal-language))
|
||||
"Alist of major modes with appropriate Calc languages."
|
||||
:group 'calc
|
||||
:type '(alist :key-type (symbol :tag "Major mode")
|
||||
:value-type (symbol :tag "Calc language")))
|
||||
|
||||
(defcustom calc-embedded-announce-formula
|
||||
"%Embed\n\\(% .*\n\\)*"
|
||||
"A regular expression which is sure to be followed by a calc-embedded formula."
|
||||
:group 'calc
|
||||
:type '(regexp))
|
||||
|
||||
(defcustom calc-embedded-announce-formula-alist
|
||||
|
|
@ -271,26 +267,22 @@
|
|||
(xml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*")
|
||||
(texinfo-mode . "@c Embed\n\\(@c .*\n\\)*"))
|
||||
"Alist of major modes with appropriate values for `calc-embedded-announce-formula'."
|
||||
:group 'calc
|
||||
:type '(alist :key-type (symbol :tag "Major mode")
|
||||
:value-type (regexp :tag "Regexp to announce formula")))
|
||||
|
||||
(defcustom calc-embedded-open-formula
|
||||
"\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
|
||||
"A regular expression for the opening delimiter of a formula used by calc-embedded."
|
||||
:group 'calc
|
||||
:type '(regexp))
|
||||
|
||||
(defcustom calc-embedded-close-formula
|
||||
"\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
|
||||
"A regular expression for the closing delimiter of a formula used by calc-embedded."
|
||||
:group 'calc
|
||||
:type '(regexp))
|
||||
|
||||
(defcustom calc-embedded-open-close-formula-alist
|
||||
nil
|
||||
"Alist of major modes with pairs of formula delimiters used by calc-embedded."
|
||||
:group 'calc
|
||||
:type '(alist :key-type (symbol :tag "Major mode")
|
||||
:value-type (list (regexp :tag "Opening formula delimiter")
|
||||
(regexp :tag "Closing formula delimiter"))))
|
||||
|
|
@ -298,13 +290,11 @@
|
|||
(defcustom calc-embedded-word-regexp
|
||||
"[-+]?[0-9]+\\(\\.[0-9]+\\)?\\([eE][-+]?[0-9]+\\)?"
|
||||
"A regular expression determining a word for calc-embedded-word."
|
||||
:group 'calc
|
||||
:type '(regexp))
|
||||
|
||||
(defcustom calc-embedded-word-regexp-alist
|
||||
nil
|
||||
"Alist of major modes with word regexps used by calc-embedded-word."
|
||||
:group 'calc
|
||||
:type '(alist :key-type (symbol :tag "Major mode")
|
||||
:value-type (regexp :tag "Regexp for word")))
|
||||
|
||||
|
|
@ -313,14 +303,12 @@
|
|||
"A string which is the opening delimiter for a \"plain\" formula.
|
||||
If calc-show-plain mode is enabled, this is inserted at the front of
|
||||
each formula."
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-embedded-close-plain
|
||||
" %%%\n"
|
||||
"A string which is the closing delimiter for a \"plain\" formula.
|
||||
See calc-embedded-open-plain."
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-embedded-open-close-plain-alist
|
||||
|
|
@ -336,7 +324,6 @@ See calc-embedded-open-plain."
|
|||
(xml-mode "<!-- %% " " %% -->\n")
|
||||
(texinfo-mode "@c %% " " %%\n"))
|
||||
"Alist of major modes with pairs of delimiters for \"plain\" formulas."
|
||||
:group 'calc
|
||||
:type '(alist :key-type (symbol :tag "Major mode")
|
||||
:value-type (list (string :tag "Opening \"plain\" delimiter")
|
||||
(string :tag "Closing \"plain\" delimiter"))))
|
||||
|
|
@ -344,19 +331,16 @@ See calc-embedded-open-plain."
|
|||
(defcustom calc-embedded-open-new-formula
|
||||
"\n\n"
|
||||
"A string which is inserted at front of formula by calc-embedded-new-formula."
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-embedded-close-new-formula
|
||||
"\n\n"
|
||||
"A string which is inserted at end of formula by calc-embedded-new-formula."
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-embedded-open-close-new-formula-alist
|
||||
nil
|
||||
"Alist of major modes with pairs of new formula delimiters used by calc-embedded."
|
||||
:group 'calc
|
||||
:type '(alist :key-type (symbol :tag "Major mode")
|
||||
:value-type (list (string :tag "Opening new formula delimiter")
|
||||
(string :tag "Closing new formula delimiter"))))
|
||||
|
|
@ -365,14 +349,12 @@ See calc-embedded-open-plain."
|
|||
"% "
|
||||
"A string which should precede calc-embedded mode annotations.
|
||||
This is not required to be present for user-written mode annotations."
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-embedded-close-mode
|
||||
"\n"
|
||||
"A string which should follow calc-embedded mode annotations.
|
||||
This is not required to be present for user-written mode annotations."
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-embedded-open-close-mode-alist
|
||||
|
|
@ -388,7 +370,6 @@ This is not required to be present for user-written mode annotations."
|
|||
(xml-mode "<!-- " " -->\n")
|
||||
(texinfo-mode "@c " "\n"))
|
||||
"Alist of major modes with pairs of strings to delimit annotations."
|
||||
:group 'calc
|
||||
:type '(alist :key-type (symbol :tag "Major mode")
|
||||
:value-type (list (string :tag "Opening annotation delimiter")
|
||||
(string :tag "Closing annotation delimiter"))))
|
||||
|
|
@ -402,34 +383,29 @@ This is not required to be present for user-written mode annotations."
|
|||
"pgnuplot"
|
||||
"gnuplot")
|
||||
"Name of GNUPLOT program, for calc-graph features."
|
||||
:group 'calc
|
||||
:type '(string)
|
||||
:version "26.2")
|
||||
|
||||
(defcustom calc-gnuplot-plot-command
|
||||
nil
|
||||
"Name of command for displaying GNUPLOT output; %s = file name to print."
|
||||
:group 'calc
|
||||
:type '(choice (string) (sexp)))
|
||||
|
||||
(defcustom calc-gnuplot-print-command
|
||||
"lp %s"
|
||||
"Name of command for printing GNUPLOT output; %s = file name to print."
|
||||
:group 'calc
|
||||
:type '(choice (string) (sexp)))
|
||||
|
||||
(defcustom calc-multiplication-has-precedence
|
||||
t
|
||||
"If non-nil, multiplication has precedence over division
|
||||
in normal mode."
|
||||
:group 'calc
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom calc-ensure-consistent-units
|
||||
nil
|
||||
"If non-nil, make sure new units are consistent with current units
|
||||
when converting units."
|
||||
:group 'calc
|
||||
:version "24.3"
|
||||
:type 'boolean)
|
||||
|
||||
|
|
@ -437,14 +413,12 @@ when converting units."
|
|||
nil
|
||||
"If non-nil, the stack element under the cursor will be copied by `calc-enter'
|
||||
and deleted by `calc-pop'."
|
||||
:group 'calc
|
||||
:version "24.4"
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom calc-undo-length
|
||||
100
|
||||
"The number of undo steps that will be preserved when Calc is quit."
|
||||
:group 'calc
|
||||
:type 'integer)
|
||||
|
||||
(defcustom calc-highlight-selections-with-faces
|
||||
|
|
@ -455,42 +429,36 @@ shown by displaying the rest of the formula in `calc-nonselected-face'.
|
|||
If option `calc-show-selections' is nil, then selected sub-formulas are shown
|
||||
by displaying the sub-formula in `calc-selected-face'."
|
||||
:version "24.1"
|
||||
:group 'calc
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom calc-lu-field-reference
|
||||
"20 uPa"
|
||||
"The default reference level for logarithmic units (field)."
|
||||
:version "24.1"
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-lu-power-reference
|
||||
"mW"
|
||||
"The default reference level for logarithmic units (power)."
|
||||
:version "24.1"
|
||||
:group 'calc
|
||||
:type '(string))
|
||||
|
||||
(defcustom calc-note-threshold "1"
|
||||
"The number of cents that a frequency should be near a note
|
||||
to be identified as that note."
|
||||
:version "24.1"
|
||||
:type 'string
|
||||
:group 'calc)
|
||||
:type 'string)
|
||||
|
||||
(defvar math-format-date-cache) ; calc-forms.el
|
||||
|
||||
(defface calc-nonselected-face
|
||||
'((t :inherit shadow
|
||||
:slant italic))
|
||||
"Face used to show the non-selected portion of a formula."
|
||||
:group 'calc)
|
||||
"Face used to show the non-selected portion of a formula.")
|
||||
|
||||
(defface calc-selected-face
|
||||
'((t :weight bold))
|
||||
"Face used to show the selected portion of a formula."
|
||||
:group 'calc)
|
||||
"Face used to show the selected portion of a formula.")
|
||||
|
||||
(define-obsolete-variable-alias 'calc-bug-address 'report-emacs-bug-address
|
||||
"26.2")
|
||||
|
|
@ -934,7 +902,6 @@ Used by `calc-user-invocation'.")
|
|||
|
||||
;; The following modes use specially-formatted data.
|
||||
(put 'calc-mode 'mode-class 'special)
|
||||
(put 'calc-trail-mode 'mode-class 'special)
|
||||
|
||||
(define-error 'calc-error "Calc internal error")
|
||||
(define-error 'inexact-result
|
||||
|
|
@ -1384,7 +1351,7 @@ Notations: 3.14e6 3.14 * 10^6
|
|||
(set-buffer "*Calculator*")
|
||||
(while plist
|
||||
(put 'calc-define (car plist) nil)
|
||||
(eval (nth 1 plist))
|
||||
(eval (nth 1 plist) t)
|
||||
(setq plist (cdr (cdr plist))))
|
||||
;; See if this has added any more calc-define properties.
|
||||
(calc-check-defines))
|
||||
|
|
@ -1410,7 +1377,7 @@ commands given here will actually operate on the *Calculator* stack."
|
|||
(make-local-variable 'overlay-arrow-position)
|
||||
(make-local-variable 'overlay-arrow-string)
|
||||
(when (= (buffer-size) 0)
|
||||
(let ((buffer-read-only nil))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
|
||||
|
||||
(defun calc-create-buffer ()
|
||||
|
|
@ -2043,7 +2010,6 @@ on 15 October 1582 (Gregorian), and many Catholic countries made
|
|||
the change then. Great Britain and its colonies had the Gregorian
|
||||
calendar take effect on 14 September 1752 (Gregorian); this includes
|
||||
the United States."
|
||||
:group 'calc
|
||||
:version "24.4"
|
||||
:type '(choice (const :tag "Always use the Gregorian calendar" nil)
|
||||
(const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736))
|
||||
|
|
@ -2490,51 +2456,18 @@ the United States."
|
|||
(setq last-command-event 13)
|
||||
(calcDigit-nondigit))))
|
||||
|
||||
|
||||
|
||||
|
||||
(defconst math-bignum-digit-length
|
||||
(truncate (/ (log (/ most-positive-fixnum 2) 10) 2))
|
||||
"The length of a \"digit\" in Calc bignums.
|
||||
If a big integer is of the form (bigpos N0 N1 ...), this is the
|
||||
length of the allowable Emacs integers N0, N1,...
|
||||
The value of 2*10^(2*MATH-BIGNUM-DIGIT-LENGTH) must be less than the
|
||||
largest Emacs integer.")
|
||||
|
||||
(defconst math-bignum-digit-size
|
||||
(expt 10 math-bignum-digit-length)
|
||||
"An upper bound for the size of the \"digit\"s in Calc bignums.")
|
||||
|
||||
(defconst math-small-integer-size
|
||||
(expt math-bignum-digit-size 2)
|
||||
"An upper bound for the size of \"small integer\"s in Calc.")
|
||||
|
||||
|
||||
;;;; Arithmetic routines.
|
||||
;;
|
||||
;; An object as manipulated by one of these routines may take any of the
|
||||
;; following forms:
|
||||
;;
|
||||
;; integer An integer. For normalized numbers, this format
|
||||
;; is used only for
|
||||
;; negative math-small-integer-size + 1 to
|
||||
;; math-small-integer-size - 1
|
||||
;; integer An integer.
|
||||
;;
|
||||
;; (bigpos N0 N1 N2 ...) A big positive integer,
|
||||
;; N0 + N1*math-bignum-digit-size
|
||||
;; + N2*(math-bignum-digit-size)^2 ...
|
||||
;; (bigneg N0 N1 N2 ...) A big negative integer,
|
||||
;; - N0 - N1*math-bignum-digit-size ...
|
||||
;; Each digit N is in the range
|
||||
;; 0 ... math-bignum-digit-size -1.
|
||||
;; Normalized, always at least three N present,
|
||||
;; and the most significant N is nonzero.
|
||||
;;
|
||||
;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers.
|
||||
;; (frac NUM DEN) A fraction. NUM and DEN are integers.
|
||||
;; Normalized, DEN > 1.
|
||||
;;
|
||||
;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
|
||||
;; NUM is a small or big integer, EXP is a small int.
|
||||
;; NUM and EXP are integers.
|
||||
;; Normalized, NUM is not a multiple of 10, and
|
||||
;; abs(NUM) < 10^calc-internal-prec.
|
||||
;; Normalized zero is stored as (float 0 0).
|
||||
|
|
@ -2595,8 +2528,7 @@ largest Emacs integer.")
|
|||
;; B Normalized big integer
|
||||
;; S Normalized small integer
|
||||
;; D Digit (small integer, 0..999)
|
||||
;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol)
|
||||
;; or normalized vector element list (without "vec")
|
||||
;; L normalized vector element list (without "vec")
|
||||
;; P Predicate (truth value)
|
||||
;; X Any Lisp object
|
||||
;; Z "nil"
|
||||
|
|
@ -2617,44 +2549,7 @@ largest Emacs integer.")
|
|||
(defun math-normalize (a)
|
||||
(setq math-normalize-error nil)
|
||||
(cond
|
||||
((not (consp a))
|
||||
(if (integerp a)
|
||||
(if (or (>= a math-small-integer-size)
|
||||
(<= a (- math-small-integer-size)))
|
||||
(math-bignum a)
|
||||
a)
|
||||
a))
|
||||
((eq (car a) 'bigpos)
|
||||
(if (eq (nth (1- (length a)) a) 0)
|
||||
(let* ((last (setq a
|
||||
(copy-sequence a)))
|
||||
(digs a))
|
||||
(while (setq digs (cdr digs))
|
||||
(or (eq (car digs) 0) (setq last digs)))
|
||||
(setcdr last nil)))
|
||||
(if (cdr (cdr (cdr a)))
|
||||
a
|
||||
(cond
|
||||
((cdr (cdr a)) (+ (nth 1 a)
|
||||
(* (nth 2 a)
|
||||
math-bignum-digit-size)))
|
||||
((cdr a) (nth 1 a))
|
||||
(t 0))))
|
||||
((eq (car a) 'bigneg)
|
||||
(if (eq (nth (1- (length a)) a) 0)
|
||||
(let* ((last (setq a (copy-sequence a)))
|
||||
(digs a))
|
||||
(while (setq digs (cdr digs))
|
||||
(or (eq (car digs) 0) (setq last digs)))
|
||||
(setcdr last nil)))
|
||||
(if (cdr (cdr (cdr a)))
|
||||
a
|
||||
(cond
|
||||
((cdr (cdr a)) (- (+ (nth 1 a)
|
||||
(* (nth 2 a)
|
||||
math-bignum-digit-size))))
|
||||
((cdr a) (- (nth 1 a)))
|
||||
(t 0))))
|
||||
((not (consp a)) a)
|
||||
((eq (car a) 'float)
|
||||
(math-make-float (math-normalize (nth 1 a))
|
||||
(nth 2 a)))
|
||||
|
|
@ -2766,23 +2661,6 @@ largest Emacs integer.")
|
|||
((consp a) a)
|
||||
(t (error "Invalid data object encountered"))))
|
||||
|
||||
|
||||
|
||||
;; Coerce integer A to be a bignum. [B S]
|
||||
(defun math-bignum (a)
|
||||
(cond
|
||||
((>= a 0)
|
||||
(cons 'bigpos (math-bignum-big a)))
|
||||
(t
|
||||
(cons 'bigneg (math-bignum-big (- a))))))
|
||||
|
||||
(defun math-bignum-big (a) ; [L s]
|
||||
(if (= a 0)
|
||||
nil
|
||||
(cons (% a math-bignum-digit-size)
|
||||
(math-bignum-big (/ a math-bignum-digit-size)))))
|
||||
|
||||
|
||||
;; Build a normalized floating-point number. [F I S]
|
||||
(defun math-make-float (mant exp)
|
||||
(if (eq mant 0)
|
||||
|
|
@ -2791,20 +2669,9 @@ largest Emacs integer.")
|
|||
(if (< ldiff 0)
|
||||
(setq mant (math-scale-rounding mant ldiff)
|
||||
exp (- exp ldiff))))
|
||||
(if (consp mant)
|
||||
(let ((digs (cdr mant)))
|
||||
(if (= (% (car digs) 10) 0)
|
||||
(progn
|
||||
(while (= (car digs) 0)
|
||||
(setq digs (cdr digs)
|
||||
exp (+ exp math-bignum-digit-length)))
|
||||
(while (= (% (car digs) 10) 0)
|
||||
(setq digs (math-div10-bignum digs)
|
||||
exp (1+ exp)))
|
||||
(setq mant (math-normalize (cons (car mant) digs))))))
|
||||
(while (= (% mant 10) 0)
|
||||
(setq mant (/ mant 10)
|
||||
exp (1+ exp))))
|
||||
(while (= (% mant 10) 0)
|
||||
(setq mant (/ mant 10)
|
||||
exp (1+ exp)))
|
||||
(if (and (<= exp -4000000)
|
||||
(<= (+ exp (math-numdigs mant) -1) -4000000))
|
||||
(signal 'math-underflow nil)
|
||||
|
|
@ -2813,13 +2680,6 @@ largest Emacs integer.")
|
|||
(signal 'math-overflow nil)
|
||||
(list 'float mant exp)))))
|
||||
|
||||
(defun math-div10-bignum (a) ; [l l]
|
||||
(if (cdr a)
|
||||
(cons (+ (/ (car a) 10) (* (% (nth 1 a) 10)
|
||||
(expt 10 (1- math-bignum-digit-length))))
|
||||
(math-div10-bignum (cdr a)))
|
||||
(list (/ (car a) 10))))
|
||||
|
||||
;;; Coerce A to be a float. [F N; V V] [Public]
|
||||
(defun math-float (a)
|
||||
(cond ((Math-integerp a) (math-make-float a 0))
|
||||
|
|
@ -2832,8 +2692,6 @@ largest Emacs integer.")
|
|||
|
||||
(defun math-neg (a)
|
||||
(cond ((not (consp a)) (- a))
|
||||
((eq (car a) 'bigpos) (cons 'bigneg (cdr a)))
|
||||
((eq (car a) 'bigneg) (cons 'bigpos (cdr a)))
|
||||
((memq (car a) '(frac float))
|
||||
(list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
|
||||
((memq (car a) '(cplx vec hms date calcFunc-idn))
|
||||
|
|
@ -2843,19 +2701,19 @@ largest Emacs integer.")
|
|||
|
||||
;;; Compute the number of decimal digits in integer A. [S I]
|
||||
(defun math-numdigs (a)
|
||||
(if (consp a)
|
||||
(if (cdr a)
|
||||
(let* ((len (1- (length a)))
|
||||
(top (nth len a)))
|
||||
(+ (* (1- len) math-bignum-digit-length) (math-numdigs top)))
|
||||
0)
|
||||
(cond ((>= a 100) (+ (math-numdigs (/ a 1000)) 3))
|
||||
((>= a 10) 2)
|
||||
((>= a 1) 1)
|
||||
((= a 0) 0)
|
||||
((> a -10) 1)
|
||||
((> a -100) 2)
|
||||
(t (math-numdigs (- a))))))
|
||||
(cond
|
||||
((= a 0) 0)
|
||||
((progn (when (< a 0) (setq a (- a)))
|
||||
(>= a 100))
|
||||
(let* ((bd (logb a))
|
||||
(d (truncate (/ bd (eval-when-compile (log 10 2))))))
|
||||
(let ((b (expt 10 d)))
|
||||
(cond
|
||||
((> b a) d)
|
||||
((> (* 10 b) a) (1+ d))
|
||||
(t (+ d 2))))))
|
||||
((>= a 10) 2)
|
||||
(t 1)))
|
||||
|
||||
;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S]
|
||||
(defun math-scale-int (a n)
|
||||
|
|
@ -2866,76 +2724,23 @@ largest Emacs integer.")
|
|||
(defun math-scale-left (a n) ; [I I S]
|
||||
(if (= n 0)
|
||||
a
|
||||
(if (consp a)
|
||||
(cons (car a) (math-scale-left-bignum (cdr a) n))
|
||||
(if (>= n math-bignum-digit-length)
|
||||
(if (or (>= a math-bignum-digit-size)
|
||||
(<= a (- math-bignum-digit-size)))
|
||||
(math-scale-left (math-bignum a) n)
|
||||
(math-scale-left (* a math-bignum-digit-size)
|
||||
(- n math-bignum-digit-length)))
|
||||
(let ((sz (expt 10 (- (* 2 math-bignum-digit-length) n))))
|
||||
(if (or (>= a sz) (<= a (- sz)))
|
||||
(math-scale-left (math-bignum a) n)
|
||||
(* a (expt 10 n))))))))
|
||||
|
||||
(defun math-scale-left-bignum (a n)
|
||||
(if (>= n math-bignum-digit-length)
|
||||
(while (>= (setq a (cons 0 a)
|
||||
n (- n math-bignum-digit-length))
|
||||
math-bignum-digit-length)))
|
||||
(if (> n 0)
|
||||
(math-mul-bignum-digit a (expt 10 n) 0)
|
||||
a))
|
||||
(* a (expt 10 n))))
|
||||
|
||||
(defun math-scale-right (a n) ; [i i S]
|
||||
(if (= n 0)
|
||||
a
|
||||
(if (consp a)
|
||||
(cons (car a) (math-scale-right-bignum (cdr a) n))
|
||||
(if (<= a 0)
|
||||
(if (= a 0)
|
||||
0
|
||||
(- (math-scale-right (- a) n)))
|
||||
(if (>= n math-bignum-digit-length)
|
||||
(while (and (> (setq a (/ a math-bignum-digit-size)) 0)
|
||||
(>= (setq n (- n math-bignum-digit-length))
|
||||
math-bignum-digit-length))))
|
||||
(if (> n 0)
|
||||
(/ a (expt 10 n))
|
||||
a)))))
|
||||
|
||||
(defun math-scale-right-bignum (a n) ; [L L S; l l S]
|
||||
(if (>= n math-bignum-digit-length)
|
||||
(setq a (nthcdr (/ n math-bignum-digit-length) a)
|
||||
n (% n math-bignum-digit-length)))
|
||||
(if (> n 0)
|
||||
(cdr (math-mul-bignum-digit a (expt 10 (- math-bignum-digit-length n)) 0))
|
||||
a))
|
||||
(if (<= a 0)
|
||||
(if (= a 0)
|
||||
0
|
||||
(- (math-scale-right (- a) n)))
|
||||
(if (> n 0)
|
||||
(/ a (expt 10 n))
|
||||
a))))
|
||||
|
||||
;;; Multiply (with rounding) the integer A by 10^N. [I i S]
|
||||
(defun math-scale-rounding (a n)
|
||||
(cond ((>= n 0)
|
||||
(math-scale-left a n))
|
||||
((consp a)
|
||||
(math-normalize
|
||||
(cons (car a)
|
||||
(let ((val (if (< n (- math-bignum-digit-length))
|
||||
(math-scale-right-bignum
|
||||
(cdr a)
|
||||
(- (- math-bignum-digit-length) n))
|
||||
(if (< n 0)
|
||||
(math-mul-bignum-digit
|
||||
(cdr a)
|
||||
(expt 10 (+ math-bignum-digit-length n)) 0)
|
||||
(cdr a))))) ; n = -math-bignum-digit-length
|
||||
(if (and val (>= (car val) (/ math-bignum-digit-size 2)))
|
||||
(if (cdr val)
|
||||
(if (eq (car (cdr val)) (1- math-bignum-digit-size))
|
||||
(math-add-bignum (cdr val) '(1))
|
||||
(cons (1+ (car (cdr val))) (cdr (cdr val))))
|
||||
'(1))
|
||||
(cdr val))))))
|
||||
(t
|
||||
(if (< a 0)
|
||||
(- (math-scale-rounding (- a) n))
|
||||
|
|
@ -2948,36 +2753,13 @@ largest Emacs integer.")
|
|||
(defun math-add (a b)
|
||||
(or
|
||||
(and (not (or (consp a) (consp b)))
|
||||
(progn
|
||||
(setq a (+ a b))
|
||||
(if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size))
|
||||
(math-bignum a)
|
||||
a)))
|
||||
(+ a b))
|
||||
(and (Math-zerop a) (not (eq (car-safe a) 'mod))
|
||||
(if (and (math-floatp a) (Math-ratp b)) (math-float b) b))
|
||||
(and (Math-zerop b) (not (eq (car-safe b) 'mod))
|
||||
(if (and (math-floatp b) (Math-ratp a)) (math-float a) a))
|
||||
(and (Math-objvecp a) (Math-objvecp b)
|
||||
(or
|
||||
(and (Math-integerp a) (Math-integerp b)
|
||||
(progn
|
||||
(or (consp a) (setq a (math-bignum a)))
|
||||
(or (consp b) (setq b (math-bignum b)))
|
||||
(if (eq (car a) 'bigneg)
|
||||
(if (eq (car b) 'bigneg)
|
||||
(cons 'bigneg (math-add-bignum (cdr a) (cdr b)))
|
||||
(math-normalize
|
||||
(let ((diff (math-sub-bignum (cdr b) (cdr a))))
|
||||
(if (eq diff 'neg)
|
||||
(cons 'bigneg (math-sub-bignum (cdr a) (cdr b)))
|
||||
(cons 'bigpos diff)))))
|
||||
(if (eq (car b) 'bigneg)
|
||||
(math-normalize
|
||||
(let ((diff (math-sub-bignum (cdr a) (cdr b))))
|
||||
(if (eq diff 'neg)
|
||||
(cons 'bigneg (math-sub-bignum (cdr b) (cdr a)))
|
||||
(cons 'bigpos diff))))
|
||||
(cons 'bigpos (math-add-bignum (cdr a) (cdr b)))))))
|
||||
(and (Math-ratp a) (Math-ratp b)
|
||||
(require 'calc-ext)
|
||||
(calc-add-fractions a b))
|
||||
|
|
@ -2993,79 +2775,6 @@ largest Emacs integer.")
|
|||
(and (require 'calc-ext)
|
||||
(math-add-symb-fancy a b))))
|
||||
|
||||
(defun math-add-bignum (a b) ; [L L L; l l l]
|
||||
(if a
|
||||
(if b
|
||||
(let* ((a (copy-sequence a)) (aa a) (carry nil) sum)
|
||||
(while (and aa b)
|
||||
(if carry
|
||||
(if (< (setq sum (+ (car aa) (car b)))
|
||||
(1- math-bignum-digit-size))
|
||||
(progn
|
||||
(setcar aa (1+ sum))
|
||||
(setq carry nil))
|
||||
(setcar aa (- sum (1- math-bignum-digit-size))))
|
||||
(if (< (setq sum (+ (car aa) (car b))) math-bignum-digit-size)
|
||||
(setcar aa sum)
|
||||
(setcar aa (- sum math-bignum-digit-size))
|
||||
(setq carry t)))
|
||||
(setq aa (cdr aa)
|
||||
b (cdr b)))
|
||||
(if carry
|
||||
(if b
|
||||
(nconc a (math-add-bignum b '(1)))
|
||||
(while (eq (car aa) (1- math-bignum-digit-size))
|
||||
(setcar aa 0)
|
||||
(setq aa (cdr aa)))
|
||||
(if aa
|
||||
(progn
|
||||
(setcar aa (1+ (car aa)))
|
||||
a)
|
||||
(nconc a '(1))))
|
||||
(if b
|
||||
(nconc a b)
|
||||
a)))
|
||||
a)
|
||||
b))
|
||||
|
||||
(defun math-sub-bignum (a b) ; [l l l]
|
||||
(if b
|
||||
(if a
|
||||
(let* ((a (copy-sequence a)) (aa a) (borrow nil) diff)
|
||||
(while (and aa b)
|
||||
(if borrow
|
||||
(if (>= (setq diff (- (car aa) (car b))) 1)
|
||||
(progn
|
||||
(setcar aa (1- diff))
|
||||
(setq borrow nil))
|
||||
(setcar aa (+ diff (1- math-bignum-digit-size))))
|
||||
(if (>= (setq diff (- (car aa) (car b))) 0)
|
||||
(setcar aa diff)
|
||||
(setcar aa (+ diff math-bignum-digit-size))
|
||||
(setq borrow t)))
|
||||
(setq aa (cdr aa)
|
||||
b (cdr b)))
|
||||
(if borrow
|
||||
(progn
|
||||
(while (eq (car aa) 0)
|
||||
(setcar aa (1- math-bignum-digit-size))
|
||||
(setq aa (cdr aa)))
|
||||
(if aa
|
||||
(progn
|
||||
(setcar aa (1- (car aa)))
|
||||
a)
|
||||
'neg))
|
||||
(while (eq (car b) 0)
|
||||
(setq b (cdr b)))
|
||||
(if b
|
||||
'neg
|
||||
a)))
|
||||
(while (eq (car b) 0)
|
||||
(setq b (cdr b)))
|
||||
(and b
|
||||
'neg))
|
||||
a))
|
||||
|
||||
(defun math-add-float (a b) ; [F F F]
|
||||
(let ((ediff (- (nth 2 a) (nth 2 b))))
|
||||
(if (>= ediff 0)
|
||||
|
|
@ -3088,9 +2797,7 @@ largest Emacs integer.")
|
|||
(if (or (consp a) (consp b))
|
||||
(math-add a (math-neg b))
|
||||
(setq a (- a b))
|
||||
(if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size))
|
||||
(math-bignum a)
|
||||
a)))
|
||||
a))
|
||||
|
||||
(defun math-sub-float (a b) ; [F F F]
|
||||
(let ((ediff (- (nth 2 a) (nth 2 b))))
|
||||
|
|
@ -3115,8 +2822,6 @@ largest Emacs integer.")
|
|||
(defun math-mul (a b)
|
||||
(or
|
||||
(and (not (consp a)) (not (consp b))
|
||||
(< a math-bignum-digit-size) (> a (- math-bignum-digit-size))
|
||||
(< b math-bignum-digit-size) (> b (- math-bignum-digit-size))
|
||||
(* a b))
|
||||
(and (Math-zerop a) (not (eq (car-safe b) 'mod))
|
||||
(if (Math-scalarp b)
|
||||
|
|
@ -3130,17 +2835,6 @@ largest Emacs integer.")
|
|||
(math-mul-zero b a)))
|
||||
(and (Math-objvecp a) (Math-objvecp b)
|
||||
(or
|
||||
(and (Math-integerp a) (Math-integerp b)
|
||||
(progn
|
||||
(or (consp a) (setq a (math-bignum a)))
|
||||
(or (consp b) (setq b (math-bignum b)))
|
||||
(math-normalize
|
||||
(cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
|
||||
(if (cdr (cdr a))
|
||||
(if (cdr (cdr b))
|
||||
(math-mul-bignum (cdr a) (cdr b))
|
||||
(math-mul-bignum-digit (cdr a) (nth 1 b) 0))
|
||||
(math-mul-bignum-digit (cdr b) (nth 1 a) 0))))))
|
||||
(and (Math-ratp a) (Math-ratp b)
|
||||
(require 'calc-ext)
|
||||
(calc-mul-fractions a b))
|
||||
|
|
@ -3169,146 +2863,19 @@ largest Emacs integer.")
|
|||
'(var uinf var-uinf)
|
||||
a)))
|
||||
|
||||
;;; Multiply digit lists A and B. [L L L; l l l]
|
||||
(defun math-mul-bignum (a b)
|
||||
(and a b
|
||||
(let* ((sum (if (<= (car b) 1)
|
||||
(if (= (car b) 0)
|
||||
(list 0)
|
||||
(copy-sequence a))
|
||||
(math-mul-bignum-digit a (car b) 0)))
|
||||
(sump sum) c d aa ss prod)
|
||||
(while (setq b (cdr b))
|
||||
(setq ss (setq sump (or (cdr sump) (setcdr sump (list 0))))
|
||||
d (car b)
|
||||
c 0
|
||||
aa a)
|
||||
(while (progn
|
||||
(setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d))
|
||||
c))
|
||||
math-bignum-digit-size))
|
||||
(setq aa (cdr aa)))
|
||||
(setq c (/ prod math-bignum-digit-size)
|
||||
ss (or (cdr ss) (setcdr ss (list 0)))))
|
||||
(if (>= prod math-bignum-digit-size)
|
||||
(if (cdr ss)
|
||||
(setcar (cdr ss) (+ (/ prod math-bignum-digit-size) (car (cdr ss))))
|
||||
(setcdr ss (list (/ prod math-bignum-digit-size))))))
|
||||
sum)))
|
||||
|
||||
;;; Multiply digit list A by digit D. [L L D D; l l D D]
|
||||
(defun math-mul-bignum-digit (a d c)
|
||||
(if a
|
||||
(if (<= d 1)
|
||||
(and (= d 1) a)
|
||||
(let* ((a (copy-sequence a)) (aa a) prod)
|
||||
(while (progn
|
||||
(setcar aa
|
||||
(% (setq prod (+ (* (car aa) d) c))
|
||||
math-bignum-digit-size))
|
||||
(cdr aa))
|
||||
(setq aa (cdr aa)
|
||||
c (/ prod math-bignum-digit-size)))
|
||||
(if (>= prod math-bignum-digit-size)
|
||||
(setcdr aa (list (/ prod math-bignum-digit-size))))
|
||||
a))
|
||||
(and (> c 0)
|
||||
(list c))))
|
||||
|
||||
|
||||
;;; Compute the integer (quotient . remainder) of A and B, which may be
|
||||
;;; small or big integers. Type and consistency of truncation is undefined
|
||||
;;; if A or B is negative. B must be nonzero. [I.I I I] [Public]
|
||||
(defun math-idivmod (a b)
|
||||
(if (eq b 0)
|
||||
(math-reject-arg a "*Division by zero"))
|
||||
(if (or (consp a) (consp b))
|
||||
(if (and (natnump b) (< b math-bignum-digit-size))
|
||||
(let ((res (math-div-bignum-digit (cdr a) b)))
|
||||
(cons
|
||||
(math-normalize (cons (car a) (car res)))
|
||||
(cdr res)))
|
||||
(or (consp a) (setq a (math-bignum a)))
|
||||
(or (consp b) (setq b (math-bignum b)))
|
||||
(let ((res (math-div-bignum (cdr a) (cdr b))))
|
||||
(cons
|
||||
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
|
||||
(car res)))
|
||||
(math-normalize (cons (car a) (cdr res))))))
|
||||
(cons (/ a b) (% a b))))
|
||||
(cons (/ a b) (% a b)))
|
||||
|
||||
(defun math-quotient (a b) ; [I I I] [Public]
|
||||
(if (and (not (consp a)) (not (consp b)))
|
||||
(if (= b 0)
|
||||
(math-reject-arg a "*Division by zero")
|
||||
(/ a b))
|
||||
(if (and (natnump b) (< b math-bignum-digit-size))
|
||||
(if (= b 0)
|
||||
(math-reject-arg a "*Division by zero")
|
||||
(math-normalize (cons (car a)
|
||||
(car (math-div-bignum-digit (cdr a) b)))))
|
||||
(or (consp a) (setq a (math-bignum a)))
|
||||
(or (consp b) (setq b (math-bignum b)))
|
||||
(let* ((alen (1- (length a)))
|
||||
(blen (1- (length b)))
|
||||
(d (/ math-bignum-digit-size (1+ (nth (1- blen) (cdr b)))))
|
||||
(res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0)
|
||||
(math-mul-bignum-digit (cdr b) d 0)
|
||||
alen blen)))
|
||||
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
|
||||
(car res)))))))
|
||||
|
||||
|
||||
;;; Divide a bignum digit list by another. [l.l l L]
|
||||
;;; The following division algorithm is borrowed from Knuth vol. II, sec. 4.3.1
|
||||
(defun math-div-bignum (a b)
|
||||
(if (cdr b)
|
||||
(let* ((alen (length a))
|
||||
(blen (length b))
|
||||
(d (/ math-bignum-digit-size (1+ (nth (1- blen) b))))
|
||||
(res (math-div-bignum-big (math-mul-bignum-digit a d 0)
|
||||
(math-mul-bignum-digit b d 0)
|
||||
alen blen)))
|
||||
(if (= d 1)
|
||||
res
|
||||
(cons (car res)
|
||||
(car (math-div-bignum-digit (cdr res) d)))))
|
||||
(let ((res (math-div-bignum-digit a (car b))))
|
||||
(cons (car res) (list (cdr res))))))
|
||||
|
||||
;;; Divide a bignum digit list by a digit. [l.D l D]
|
||||
(defun math-div-bignum-digit (a b)
|
||||
(if a
|
||||
(let* ((res (math-div-bignum-digit (cdr a) b))
|
||||
(num (+ (* (cdr res) math-bignum-digit-size) (car a))))
|
||||
(cons
|
||||
(cons (/ num b) (car res))
|
||||
(% num b)))
|
||||
'(nil . 0)))
|
||||
|
||||
(defun math-div-bignum-big (a b alen blen) ; [l.l l L]
|
||||
(if (< alen blen)
|
||||
(cons nil a)
|
||||
(let* ((res (math-div-bignum-big (cdr a) b (1- alen) blen))
|
||||
(num (cons (car a) (cdr res)))
|
||||
(res2 (math-div-bignum-part num b blen)))
|
||||
(cons
|
||||
(cons (car res2) (car res))
|
||||
(cdr res2)))))
|
||||
|
||||
(defun math-div-bignum-part (a b blen) ; a < b*math-bignum-digit-size [D.l l L]
|
||||
(let* ((num (+ (* (or (nth blen a) 0) math-bignum-digit-size)
|
||||
(or (nth (1- blen) a) 0)))
|
||||
(den (nth (1- blen) b))
|
||||
(guess (min (/ num den) (1- math-bignum-digit-size))))
|
||||
(math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)))
|
||||
|
||||
(defun math-div-bignum-try (a b c guess) ; [D.l l l D]
|
||||
(let ((rem (math-sub-bignum a c)))
|
||||
(if (eq rem 'neg)
|
||||
(math-div-bignum-try a b (math-sub-bignum c b) (1- guess))
|
||||
(cons guess rem))))
|
||||
|
||||
(/ a b))))
|
||||
|
||||
;;; Compute the quotient of A and B. [O O N] [Public]
|
||||
(defun math-div (a b)
|
||||
|
|
@ -3532,11 +3099,11 @@ largest Emacs integer.")
|
|||
(math-format-binary a)
|
||||
(math-format-radix a))))
|
||||
(math-format-radix a))))
|
||||
(math-format-number (math-bignum a))))
|
||||
(require 'calc-ext)
|
||||
(declare-function math--format-integer-fancy "calc-ext" (a))
|
||||
(concat (if (< a 0) "-") (math--format-integer-fancy (abs a)))))
|
||||
((stringp a) a)
|
||||
((not (consp a)) (prin1-to-string a))
|
||||
((eq (car a) 'bigpos) (math-format-bignum (cdr a)))
|
||||
((eq (car a) 'bigneg) (concat "-" (math-format-bignum (cdr a))))
|
||||
((and (eq (car a) 'float) (= calc-number-radix 10))
|
||||
(if (Math-integer-negp (nth 1 a))
|
||||
(concat "-" (math-format-number (math-neg a)))
|
||||
|
|
@ -3551,9 +3118,7 @@ largest Emacs integer.")
|
|||
(> (+ exp (math-numdigs mant)) (- figs))))
|
||||
(progn
|
||||
(setq mant (math-scale-rounding mant (+ exp figs))
|
||||
str (if (integerp mant)
|
||||
(int-to-string mant)
|
||||
(math-format-bignum-decimal (cdr mant))))
|
||||
str (int-to-string mant))
|
||||
(if (<= (length str) figs)
|
||||
(setq str (concat (make-string (1+ (- figs (length str))) ?0)
|
||||
str)))
|
||||
|
|
@ -3571,9 +3136,7 @@ largest Emacs integer.")
|
|||
(when (< adj 0)
|
||||
(setq mant (math-scale-rounding mant adj)
|
||||
exp (- exp adj)))))
|
||||
(setq str (if (integerp mant)
|
||||
(int-to-string mant)
|
||||
(math-format-bignum-decimal (cdr mant))))
|
||||
(setq str (int-to-string mant))
|
||||
(let* ((len (length str))
|
||||
(dpos (+ exp len)))
|
||||
(if (and (eq fmt 'float)
|
||||
|
|
@ -3617,31 +3180,6 @@ largest Emacs integer.")
|
|||
(require 'calc-ext)
|
||||
(math-format-number-fancy a prec))))
|
||||
|
||||
(defun math-format-bignum (a) ; [X L]
|
||||
(if (and (= calc-number-radix 10)
|
||||
(not calc-leading-zeros)
|
||||
(not calc-group-digits))
|
||||
(math-format-bignum-decimal a)
|
||||
(require 'calc-ext)
|
||||
(math-format-bignum-fancy a)))
|
||||
|
||||
(defun math-format-bignum-decimal (a) ; [X L]
|
||||
(if a
|
||||
(let ((s ""))
|
||||
(while (cdr (cdr a))
|
||||
(setq s (concat
|
||||
(format
|
||||
(concat "%0"
|
||||
(number-to-string (* 2 math-bignum-digit-length))
|
||||
"d")
|
||||
(+ (* (nth 1 a) math-bignum-digit-size) (car a))) s)
|
||||
a (cdr (cdr a))))
|
||||
(concat (int-to-string
|
||||
(+ (* (or (nth 1 a) 0) math-bignum-digit-size) (car a))) s))
|
||||
"0"))
|
||||
|
||||
|
||||
|
||||
;;; Parse a simple number in string form. [N X] [Public]
|
||||
(defun math-read-number (s &optional decimal)
|
||||
"Convert the string S into a Calc number."
|
||||
|
|
@ -3657,9 +3195,7 @@ largest Emacs integer.")
|
|||
(eq (aref digs 0) ?0)
|
||||
(null decimal))
|
||||
(math-read-number (concat "8#" digs))
|
||||
(if (<= (length digs) (* 2 math-bignum-digit-length))
|
||||
(string-to-number digs)
|
||||
(cons 'bigpos (math-read-bignum digs))))))
|
||||
(string-to-number digs))))
|
||||
|
||||
;; Clean up the string if necessary
|
||||
((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s)
|
||||
|
|
@ -3714,14 +3250,10 @@ and all digits are kept, regardless of Calc's current precision."
|
|||
((string-match "^[0-9]+$" s)
|
||||
(if (string-match "^\\(0+\\)" s)
|
||||
(setq s (substring s (match-end 0))))
|
||||
(if (<= (length s) (* 2 math-bignum-digit-length))
|
||||
(string-to-number s)
|
||||
(cons 'bigpos (math-read-bignum s))))
|
||||
(string-to-number s))
|
||||
;; Minus sign
|
||||
((string-match "^-[0-9]+$" s)
|
||||
(if (<= (length s) (1+ (* 2 math-bignum-digit-length)))
|
||||
(string-to-number s)
|
||||
(cons 'bigneg (math-read-bignum (substring s 1)))))
|
||||
(string-to-number s))
|
||||
;; Decimal point
|
||||
((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s)
|
||||
(let ((int (math-match-substring s 1))
|
||||
|
|
@ -3736,12 +3268,6 @@ and all digits are kept, regardless of Calc's current precision."
|
|||
(substring s (match-beginning n) (match-end n))
|
||||
""))
|
||||
|
||||
(defun math-read-bignum (s) ; [l X]
|
||||
(if (> (length s) math-bignum-digit-length)
|
||||
(cons (string-to-number (substring s (- math-bignum-digit-length)))
|
||||
(math-read-bignum (substring s 0 (- math-bignum-digit-length))))
|
||||
(list (string-to-number s))))
|
||||
|
||||
(defconst math-standard-opers
|
||||
'( ( "_" calcFunc-subscr 1200 1201 )
|
||||
( "%" calcFunc-percent 1100 -1 )
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue