diff options
Diffstat (limited to 'lisp/calc/calc.el')
| -rw-r--r-- | lisp/calc/calc.el | 566 |
1 files changed, 46 insertions, 520 deletions
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 2136a099eed..3a9a2804cf2 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -211,7 +211,6 @@ (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 -;; -;; (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). @@ -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 ) |