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.
" ")
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 " ("
(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)
(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)
(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)
(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)))
(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)
(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)
(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)
(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)
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))
(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.
(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)
(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))
(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)
((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)))))
(require 'calc)
(require 'calc-macs)
+(require 'cl-lib)
;; Declare functions which are defined elsewhere.
(declare-function math-clip "calc-bin" (a &optional w))
(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))
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)
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)
(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)
;;; 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))))
;;; 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))))
(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)
(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)))
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))
(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)
(require 'calc-ext)
(require 'calc-macs)
+(require 'cl-lib)
(defun calc-inc-gamma (arg)
(interactive "P")
'(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))
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))
(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))
;;; 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]
(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)
(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))
(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)
;; This file is autoloaded from calc-ext.el.
+
+(require 'cl-lib)
(require 'calc-ext)
(require 'calc-macs)
(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
;;; 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
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)
(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)
(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)))
(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)))))
(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))
"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))
;;;###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))))
;;;###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))
;;;###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))
(> 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
(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))
(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))
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))))
(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))
(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
(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
(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"))))
(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")))
"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
(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"))))
(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"))))
"% "
"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
(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"))))
"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)
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
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")
;; 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
(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))
(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 ()
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))
(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
-;;
-;; (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.
+;; integer An integer.
;;
-;; (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).
;; 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"
(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)))
((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)
(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)
(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))
(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))
;;; 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)
(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))
(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))
(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)
(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))))
(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)
(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))
'(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)
(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)))
(> (+ 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)))
(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)
(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."
(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)
((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))
(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 )
projects / emacs.git / commitdiff