diff options
Diffstat (limited to 'lisp/calc/calc-ext.el')
| -rw-r--r-- | lisp/calc/calc-ext.el | 130 |
1 files changed, 40 insertions, 90 deletions
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 @@ (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) |