summaryrefslogtreecommitdiff
path: root/lisp/calc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calc')
-rw-r--r--lisp/calc/calc-aent.el4
-rw-r--r--lisp/calc/calc-alg.el954
-rw-r--r--lisp/calc/calc-bin.el184
-rw-r--r--lisp/calc/calc-comb.el11
-rw-r--r--lisp/calc/calc-ext.el235
-rw-r--r--lisp/calc/calc-forms.el86
-rw-r--r--lisp/calc/calc-funcs.el5
-rw-r--r--lisp/calc/calc-graph.el4
-rw-r--r--lisp/calc/calc-help.el14
-rw-r--r--lisp/calc/calc-lang.el8
-rw-r--r--lisp/calc/calc-macs.el76
-rw-r--r--lisp/calc/calc-math.el97
-rw-r--r--lisp/calc/calc-misc.el46
-rw-r--r--lisp/calc/calc-poly.el122
-rw-r--r--lisp/calc/calc-prog.el2
-rw-r--r--lisp/calc/calc-store.el4
-rw-r--r--lisp/calc/calc-units.el222
-rw-r--r--lisp/calc/calc-vec.el8
-rw-r--r--lisp/calc/calc.el748
-rw-r--r--lisp/calc/calccomp.el51
20 files changed, 1028 insertions, 1853 deletions
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index f16e665fc34..f7731c95fc0 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -82,7 +82,7 @@
" ")
shortbuf buf)
(if (and (= (length alg-exp) 1)
- (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
+ (memq (car-safe (car alg-exp)) '(nil))
(< (length buf) 20)
(= calc-number-radix 10))
(setq buf (concat buf " ("
@@ -728,7 +728,7 @@ in Calc algebraic input.")
math-exp-str (1- math-exp-pos))
(1- math-exp-pos))))))
(or (and (memq calc-language calc-lang-c-type-hex)
- (eq (string-match "0[xX][0-9a-fA-F]+" math-exp-str
+ (eq (string-match "0[xX][[:xdigit:]]+" math-exp-str
math-exp-pos)
math-exp-pos))
(string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-zA-Zα-ωΑ-Ω:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?"
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 8e3476d191e..c3efeeeb62c 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -1,4 +1,4 @@
-;;; calc-alg.el --- algebraic functions for Calc
+;;; calc-alg.el --- algebraic functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2019 Free Software Foundation, Inc.
@@ -258,9 +258,9 @@
(and (eq comp 0)
(not (equal a b))
(> (length (memq (car-safe a)
- '(bigneg nil bigpos frac float)))
+ '(nil frac float)))
(length (memq (car-safe b)
- '(bigneg nil bigpos frac float))))))))
+ '(nil frac float))))))))
((equal b '(neg (var inf var-inf))) nil)
((equal a '(neg (var inf var-inf))) t)
((equal a '(var inf var-inf)) nil)
@@ -308,7 +308,7 @@
(let ((math-living-dangerously t))
(math-simplify a)))
-(defalias 'calcFunc-esimplify 'math-simplify-extended)
+(defalias 'calcFunc-esimplify #'math-simplify-extended)
;;; Rewrite the trig functions in a form easier to simplify.
(defun math-trig-rewrite (fn)
@@ -329,7 +329,7 @@
(list '/ (cons 'calcFunc-cos newfn)
(cons 'calcFunc-sin newfn))))
(t
- (mapcar 'math-trig-rewrite fn))))
+ (mapcar #'math-trig-rewrite fn))))
(defun math-hyperbolic-trig-rewrite (fn)
"Rewrite hyperbolic functions in terms of sinhs and coshs."
@@ -349,7 +349,7 @@
(list '/ (cons 'calcFunc-cosh newfn)
(cons 'calcFunc-sinh newfn))))
(t
- (mapcar 'math-hyperbolic-trig-rewrite fn))))
+ (mapcar #'math-hyperbolic-trig-rewrite fn))))
;; math-top-only is local to math-simplify, but is used by
;; math-simplify-step, which is called by math-simplify.
@@ -402,11 +402,11 @@
(setq top-expr res)))))
top-expr)
-(defalias 'calcFunc-simplify 'math-simplify)
+(defalias 'calcFunc-simplify #'math-simplify)
-;;; The following has a "bug" in that if any recursive simplifications
-;;; occur only the first handler will be tried; this doesn't really
-;;; matter, since math-simplify-step is iterated to a fixed point anyway.
+;; The following has a "bug" in that if any recursive simplifications
+;; occur only the first handler will be tried; this doesn't really
+;; matter, since math-simplify-step is iterated to a fixed point anyway.
(defun math-simplify-step (a)
(if (Math-primp a)
a
@@ -414,7 +414,7 @@
(memq (car a) '(calcFunc-quote calcFunc-condition
calcFunc-evalto)))
a
- (cons (car a) (mapcar 'math-simplify-step (cdr a))))))
+ (cons (car a) (mapcar #'math-simplify-step (cdr a))))))
(and (symbolp (car aa))
(let ((handler (get (car aa) 'math-simplify)))
(and handler
@@ -427,159 +427,155 @@
(defmacro math-defsimplify (funcs &rest code)
+ "Define the simplification code for functions FUNCS.
+Code can refer to the expression to simplify via lexical variable `expr'
+and should return the simplified expression to use (or nil)."
+ (declare (indent 1) (debug (sexp body)))
(cons 'progn
(mapcar #'(lambda (func)
`(put ',func 'math-simplify
(nconc
(get ',func 'math-simplify)
(list
- #'(lambda (math-simplify-expr) ,@code)))))
+ #'(lambda (expr) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
-(put 'math-defsimplify 'lisp-indent-hook 1)
-
-;; The function created by math-defsimplify uses the variable
-;; math-simplify-expr, and so is used by functions in math-defsimplify
-(defvar math-simplify-expr)
(math-defsimplify (+ -)
- (math-simplify-plus))
-
-(defun math-simplify-plus ()
- (cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -))
- (Math-numberp (nth 2 (nth 1 math-simplify-expr)))
- (not (Math-numberp (nth 2 math-simplify-expr))))
- (let ((x (nth 2 math-simplify-expr))
- (op (car math-simplify-expr)))
- (setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr)))
- (setcar math-simplify-expr (car (nth 1 math-simplify-expr)))
- (setcar (cdr (cdr (nth 1 math-simplify-expr))) x)
- (setcar (nth 1 math-simplify-expr) op)))
- ((and (eq (car math-simplify-expr) '+)
- (Math-numberp (nth 1 math-simplify-expr))
- (not (Math-numberp (nth 2 math-simplify-expr))))
- (let ((x (nth 2 math-simplify-expr)))
- (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
- (setcar (cdr math-simplify-expr) x))))
- (let ((aa math-simplify-expr)
+ (cond ((and (memq (car-safe (nth 1 expr)) '(+ -))
+ (Math-numberp (nth 2 (nth 1 expr)))
+ (not (Math-numberp (nth 2 expr))))
+ (let ((x (nth 2 expr))
+ (op (car expr)))
+ (setcar (cdr (cdr expr)) (nth 2 (nth 1 expr)))
+ (setcar expr (car (nth 1 expr)))
+ (setcar (cdr (cdr (nth 1 expr))) x)
+ (setcar (nth 1 expr) op)))
+ ((and (eq (car expr) '+)
+ (Math-numberp (nth 1 expr))
+ (not (Math-numberp (nth 2 expr))))
+ (let ((x (nth 2 expr)))
+ (setcar (cdr (cdr expr)) (nth 1 expr))
+ (setcar (cdr expr) x))))
+ (let ((aa expr)
aaa temp)
(while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -))
- (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr)
+ (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr)
(eq (car aaa) '-)
- (eq (car math-simplify-expr) '-) t))
+ (eq (car expr) '-) t))
(progn
- (setcar (cdr (cdr math-simplify-expr)) temp)
- (setcar math-simplify-expr '+)
+ (setcar (cdr (cdr expr)) temp)
+ (setcar expr '+)
(setcar (cdr (cdr aaa)) 0)))
(setq aa (nth 1 aa)))
- (if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr)
- nil (eq (car math-simplify-expr) '-) t))
+ (if (setq temp (math-combine-sum aaa (nth 2 expr)
+ nil (eq (car expr) '-) t))
(progn
- (setcar (cdr (cdr math-simplify-expr)) temp)
- (setcar math-simplify-expr '+)
+ (setcar (cdr (cdr expr)) temp)
+ (setcar expr '+)
(setcar (cdr aa) 0)))
- math-simplify-expr))
+ expr))
(math-defsimplify *
- (math-simplify-times))
-
-(defun math-simplify-times ()
- (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
- (and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr))
- (or (math-known-scalarp (nth 1 math-simplify-expr) t)
- (math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t))
- (let ((x (nth 1 math-simplify-expr)))
- (setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr)))
- (setcar (cdr (nth 2 math-simplify-expr)) x)))
- (and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr))
- (or (math-known-scalarp (nth 1 math-simplify-expr) t)
- (math-known-scalarp (nth 2 math-simplify-expr) t))
- (let ((x (nth 2 math-simplify-expr)))
- (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
- (setcar (cdr math-simplify-expr) x))))
- (let ((aa math-simplify-expr)
+ (if (eq (car-safe (nth 2 expr)) '*)
+ (and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr))
+ (or (math-known-scalarp (nth 1 expr) t)
+ (math-known-scalarp (nth 1 (nth 2 expr)) t))
+ (let ((x (nth 1 expr)))
+ (setcar (cdr expr) (nth 1 (nth 2 expr)))
+ (setcar (cdr (nth 2 expr)) x)))
+ (and (math-beforep (nth 2 expr) (nth 1 expr))
+ (or (math-known-scalarp (nth 1 expr) t)
+ (math-known-scalarp (nth 2 expr) t))
+ (let ((x (nth 2 expr)))
+ (setcar (cdr (cdr expr)) (nth 1 expr))
+ (setcar (cdr expr) x))))
+ (let ((aa expr)
aaa temp
- (safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr))))
- (if (and (Math-ratp (nth 1 math-simplify-expr))
- (setq temp (math-common-constant-factor (nth 2 math-simplify-expr))))
+ (safe t) (scalar (math-known-scalarp (nth 1 expr))))
+ (if (and (Math-ratp (nth 1 expr))
+ (setq temp (math-common-constant-factor (nth 2 expr))))
(progn
- (setcar (cdr (cdr math-simplify-expr))
- (math-cancel-common-factor (nth 2 math-simplify-expr) temp))
- (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp))))
+ (setcar (cdr (cdr expr))
+ (math-cancel-common-factor (nth 2 expr) temp))
+ (setcar (cdr expr) (math-mul (nth 1 expr) temp))))
(while (and (eq (car-safe (setq aaa (nth 2 aa))) '*)
safe)
- (if (setq temp (math-combine-prod (nth 1 math-simplify-expr)
+ (if (setq temp (math-combine-prod (nth 1 expr)
(nth 1 aaa) nil nil t))
(progn
- (setcar (cdr math-simplify-expr) temp)
+ (setcar (cdr expr) temp)
(setcar (cdr aaa) 1)))
(setq safe (or scalar (math-known-scalarp (nth 1 aaa) t))
aa (nth 2 aa)))
- (if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t))
+ (if (and (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t))
safe)
(progn
- (setcar (cdr math-simplify-expr) temp)
+ (setcar (cdr expr) temp)
(setcar (cdr (cdr aa)) 1)))
- (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
- (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1)))
- (math-div (math-mul (nth 2 math-simplify-expr)
- (nth 1 (nth 1 math-simplify-expr)))
- (nth 2 (nth 1 math-simplify-expr)))
- math-simplify-expr)))
+ (if (and (eq (car-safe (nth 1 expr)) 'frac)
+ (memq (nth 1 (nth 1 expr)) '(1 -1)))
+ (math-div (math-mul (nth 2 expr)
+ (nth 1 (nth 1 expr)))
+ (nth 2 (nth 1 expr)))
+ expr)))
(math-defsimplify /
- (math-simplify-divide))
+ (math-simplify-divide expr))
-(defun math-simplify-divide ()
- (let ((np (cdr math-simplify-expr))
+(defvar math--simplify-divide-expr)
+
+(defun math-simplify-divide (expr)
+ (let ((np (cdr expr))
(nover nil)
- (nn (and (or (eq (car math-simplify-expr) '/)
- (not (Math-realp (nth 2 math-simplify-expr))))
- (math-common-constant-factor (nth 2 math-simplify-expr))))
+ (nn (and (or (eq (car expr) '/)
+ (not (Math-realp (nth 2 expr))))
+ (math-common-constant-factor (nth 2 expr))))
n op)
(if nn
(progn
- (setq n (and (or (eq (car math-simplify-expr) '/)
- (not (Math-realp (nth 1 math-simplify-expr))))
- (math-common-constant-factor (nth 1 math-simplify-expr))))
+ (setq n (and (or (eq (car expr) '/)
+ (not (Math-realp (nth 1 expr))))
+ (math-common-constant-factor (nth 1 expr))))
(if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
- (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq)
- (eq (car-safe (nth 1 math-simplify-expr)) 'var)
- (not (math-expr-contains (nth 2 math-simplify-expr)
- (nth 1 math-simplify-expr))))
- (setcar (cdr math-simplify-expr)
- (math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
- (setcar (cdr (cdr math-simplify-expr))
- (math-cancel-common-factor (nth 2 math-simplify-expr) nn))
+ (unless (and (eq (car-safe expr) 'calcFunc-eq)
+ (eq (car-safe (nth 1 expr)) 'var)
+ (not (math-expr-contains (nth 2 expr)
+ (nth 1 expr))))
+ (setcar (cdr expr)
+ (math-mul (nth 2 nn) (nth 1 expr)))
+ (setcar (cdr (cdr expr))
+ (math-cancel-common-factor (nth 2 expr) nn))
(if (and (math-negp nn)
- (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)))
- (setcar math-simplify-expr (nth 1 op))))
+ (setq op (assq (car expr) calc-tweak-eqn-table)))
+ (setcar expr (nth 1 op))))
(if (and n (not (eq (setq n (math-frac-gcd n nn)) 1)))
(progn
- (setcar (cdr math-simplify-expr)
- (math-cancel-common-factor (nth 1 math-simplify-expr) n))
- (setcar (cdr (cdr math-simplify-expr))
- (math-cancel-common-factor (nth 2 math-simplify-expr) n))
+ (setcar (cdr expr)
+ (math-cancel-common-factor (nth 1 expr) n))
+ (setcar (cdr (cdr expr))
+ (math-cancel-common-factor (nth 2 expr) n))
(if (and (math-negp n)
- (setq op (assq (car math-simplify-expr)
+ (setq op (assq (car expr)
calc-tweak-eqn-table)))
- (setcar math-simplify-expr (nth 1 op))))))))
- (if (and (eq (car-safe (car np)) '/)
- (math-known-scalarp (nth 2 math-simplify-expr) t))
- (progn
- (setq np (cdr (nth 1 math-simplify-expr)))
- (while (eq (car-safe (setq n (car np))) '*)
- (and (math-known-scalarp (nth 2 n) t)
- (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t))
- (setq np (cdr (cdr n))))
- (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t)
- (setq nover t
- np (cdr (cdr (nth 1 math-simplify-expr))))))
- (while (eq (car-safe (setq n (car np))) '*)
- (and (math-known-scalarp (nth 2 n) t)
- (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t))
- (setq np (cdr (cdr n))))
- (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t)
- math-simplify-expr))
+ (setcar expr (nth 1 op))))))))
+ (let ((math--simplify-divide-expr expr)) ;For use in math-simplify-divisor
+ (if (and (eq (car-safe (car np)) '/)
+ (math-known-scalarp (nth 2 expr) t))
+ (progn
+ (setq np (cdr (nth 1 expr)))
+ (while (eq (car-safe (setq n (car np))) '*)
+ (and (math-known-scalarp (nth 2 n) t)
+ (math-simplify-divisor (cdr n) (cdr (cdr expr)) nil t))
+ (setq np (cdr (cdr n))))
+ (math-simplify-divisor np (cdr (cdr expr)) nil t)
+ (setq nover t
+ np (cdr (cdr (nth 1 expr))))))
+ (while (eq (car-safe (setq n (car np))) '*)
+ (and (math-known-scalarp (nth 2 n) t)
+ (math-simplify-divisor (cdr n) (cdr (cdr expr)) nover t))
+ (setq np (cdr (cdr n))))
+ (math-simplify-divisor np (cdr (cdr expr)) nover t)
+ expr)))
;; The variables math-simplify-divisor-nover and math-simplify-divisor-dover
;; are local variables for math-simplify-divisor, but are used by
@@ -587,25 +583,25 @@
(defvar math-simplify-divisor-nover)
(defvar math-simplify-divisor-dover)
-(defun math-simplify-divisor (np dp math-simplify-divisor-nover
- math-simplify-divisor-dover)
+(defun math-simplify-divisor (np dp nover dover)
(cond ((eq (car-safe (car dp)) '/)
(math-simplify-divisor np (cdr (car dp))
- math-simplify-divisor-nover
- math-simplify-divisor-dover)
+ nover dover)
(and (math-known-scalarp (nth 1 (car dp)) t)
(math-simplify-divisor np (cdr (cdr (car dp)))
- math-simplify-divisor-nover
- (not math-simplify-divisor-dover))))
- ((or (or (eq (car math-simplify-expr) '/)
+ nover (not dover))))
+ ((or (or (eq (car math--simplify-divide-expr) '/)
(let ((signs (math-possible-signs (car np))))
(or (memq signs '(1 4))
- (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq))
+ (and (memq (car math--simplify-divide-expr)
+ '(calcFunc-eq calcFunc-neq))
(eq signs 5))
math-living-dangerously)))
(math-numberp (car np)))
(let (d
(safe t)
+ (math-simplify-divisor-nover nover)
+ (math-simplify-divisor-dover dover)
(scalar (math-known-scalarp (car np))))
(while (and (eq (car-safe (setq d (car dp))) '*)
safe)
@@ -621,14 +617,16 @@
op)
(if temp
(progn
- (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq)))
+ (and (not (memq (car math--simplify-divide-expr)
+ '(/ calcFunc-eq calcFunc-neq)))
(math-known-negp (car dp))
- (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))
- (setcar math-simplify-expr (nth 1 op)))
+ (setq op (assq (car math--simplify-divide-expr)
+ calc-tweak-eqn-table))
+ (setcar math--simplify-divide-expr (nth 1 op)))
(setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp))
(setcar dp 1))
(and math-simplify-divisor-dover (not math-simplify-divisor-nover)
- (eq (car math-simplify-expr) '/)
+ (eq (car math--simplify-divide-expr) '/)
(eq (car-safe (car dp)) 'calcFunc-sqrt)
(Math-integerp (nth 1 (car dp)))
(progn
@@ -680,26 +678,23 @@
(math-gcd (nth 2 a) (nth 2 b)))))))
(math-defsimplify %
- (math-simplify-mod))
-
-(defun math-simplify-mod ()
- (and (Math-realp (nth 2 math-simplify-expr))
- (Math-posp (nth 2 math-simplify-expr))
- (let ((lin (math-is-linear (nth 1 math-simplify-expr)))
- t1 t2 t3)
+ (and (Math-realp (nth 2 expr))
+ (Math-posp (nth 2 expr))
+ (let ((lin (math-is-linear (nth 1 expr)))
+ t1)
(or (and lin
(or (math-negp (car lin))
- (not (Math-lessp (car lin) (nth 2 math-simplify-expr))))
+ (not (Math-lessp (car lin) (nth 2 expr))))
(list '%
(list '+
(math-mul (nth 1 lin) (nth 2 lin))
- (math-mod (car lin) (nth 2 math-simplify-expr)))
- (nth 2 math-simplify-expr)))
+ (math-mod (car lin) (nth 2 expr)))
+ (nth 2 expr)))
(and lin
(not (math-equal-int (nth 1 lin) 1))
(math-num-integerp (nth 1 lin))
- (math-num-integerp (nth 2 math-simplify-expr))
- (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr)))
+ (math-num-integerp (nth 2 expr))
+ (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 expr)))
(not (math-equal-int t1 1))
(list '*
t1
@@ -709,53 +704,53 @@
(nth 2 lin))
(let ((calc-prefer-frac t))
(math-div (car lin) t1)))
- (math-div (nth 2 math-simplify-expr) t1))))
- (and (math-equal-int (nth 2 math-simplify-expr) 1)
+ (math-div (nth 2 expr) t1))))
+ (and (math-equal-int (nth 2 expr) 1)
(math-known-integerp (if lin
(math-mul (nth 1 lin) (nth 2 lin))
- (nth 1 math-simplify-expr)))
+ (nth 1 expr)))
(if lin (math-mod (car lin) 1) 0))))))
(math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt
calcFunc-gt calcFunc-leq calcFunc-geq)
- (if (= (length math-simplify-expr) 3)
- (math-simplify-ineq)))
+ (if (= (length expr) 3)
+ (math-simplify-ineq expr)))
-(defun math-simplify-ineq ()
- (let ((np (cdr math-simplify-expr))
+(defun math-simplify-ineq (expr)
+ (let ((np (cdr expr))
n)
(while (memq (car-safe (setq n (car np))) '(+ -))
- (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr))
+ (math-simplify-add-term (cdr (cdr n)) (cdr (cdr expr))
(eq (car n) '-) nil)
(setq np (cdr n)))
- (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil
- (eq np (cdr math-simplify-expr)))
- (math-simplify-divide)
- (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr)))))
- (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq)
+ (math-simplify-add-term np (cdr (cdr expr)) nil
+ (eq np (cdr expr)))
+ (math-simplify-divide expr)
+ (let ((signs (math-possible-signs (cons '- (cdr expr)))))
+ (or (cond ((eq (car expr) 'calcFunc-eq)
(or (and (eq signs 2) 1)
(and (memq signs '(1 4 5)) 0)))
- ((eq (car math-simplify-expr) 'calcFunc-neq)
+ ((eq (car expr) 'calcFunc-neq)
(or (and (eq signs 2) 0)
(and (memq signs '(1 4 5)) 1)))
- ((eq (car math-simplify-expr) 'calcFunc-lt)
+ ((eq (car expr) 'calcFunc-lt)
(or (and (eq signs 1) 1)
(and (memq signs '(2 4 6)) 0)))
- ((eq (car math-simplify-expr) 'calcFunc-gt)
+ ((eq (car expr) 'calcFunc-gt)
(or (and (eq signs 4) 1)
(and (memq signs '(1 2 3)) 0)))
- ((eq (car math-simplify-expr) 'calcFunc-leq)
+ ((eq (car expr) 'calcFunc-leq)
(or (and (eq signs 4) 0)
(and (memq signs '(1 2 3)) 1)))
- ((eq (car math-simplify-expr) 'calcFunc-geq)
+ ((eq (car expr) 'calcFunc-geq)
(or (and (eq signs 1) 0)
(and (memq signs '(2 4 6)) 1))))
- math-simplify-expr))))
+ expr))))
(defun math-simplify-add-term (np dp minus lplain)
(or (math-vectorp (car np))
(let ((rplain t)
- n d dd temp)
+ n d temp)
(while (memq (car-safe (setq n (car np) d (car dp))) '(+ -))
(setq rplain nil)
(if (setq temp (math-combine-sum n (nth 2 d)
@@ -782,27 +777,27 @@
(setcar dp (setq n (math-neg temp)))))))))
(math-defsimplify calcFunc-sin
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
- (nth 1 (nth 1 math-simplify-expr)))
- (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr)))))
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
+ (nth 1 (nth 1 expr)))
+ (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-sin (math-neg (nth 1 expr)))))
(and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
(and n
(math-known-sin (car n) (nth 1 n) 120 0))))
(and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (let ((n (math-integer-plus (nth 1 expr))))
(and n
(math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
(list 'calcFunc-sqrt (math-sub 1 (math-sqr
- (nth 1 (nth 1 math-simplify-expr))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
- (math-div (nth 1 (nth 1 math-simplify-expr))
+ (nth 1 (nth 1 expr))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
+ (math-div (nth 1 (nth 1 expr))
(list 'calcFunc-sqrt
(math-add 1 (math-sqr
- (nth 1 (nth 1 math-simplify-expr)))))))
- (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
+ (nth 1 (nth 1 expr)))))))
+ (let ((m (math-should-expand-trig (nth 1 expr))))
(and m (integerp (car m))
(let ((n (car m)) (a (nth 1 m)))
(list '+
@@ -812,27 +807,27 @@
(list 'calcFunc-sin a))))))))
(math-defsimplify calcFunc-cos
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
- (nth 1 (nth 1 math-simplify-expr)))
- (and (math-looks-negp (nth 1 math-simplify-expr))
- (list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr))))
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
+ (nth 1 (nth 1 expr)))
+ (and (math-looks-negp (nth 1 expr))
+ (list 'calcFunc-cos (math-neg (nth 1 expr))))
(and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
(and n
(math-known-sin (car n) (nth 1 n) 120 300))))
(and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (let ((n (math-integer-plus (nth 1 expr))))
(and n
(math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
(list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
(math-div 1
(list 'calcFunc-sqrt
(math-add 1
- (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
- (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
+ (math-sqr (nth 1 (nth 1 expr)))))))
+ (let ((m (math-should-expand-trig (nth 1 expr))))
(and m (integerp (car m))
(let ((n (car m)) (a (nth 1 m)))
(list '-
@@ -842,53 +837,57 @@
(list 'calcFunc-sin a))))))))
(math-defsimplify calcFunc-sec
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (list 'calcFunc-sec (math-neg (nth 1 math-simplify-expr))))
+ (or (and (math-looks-negp (nth 1 expr))
+ (list 'calcFunc-sec (math-neg (nth 1 expr))))
(and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
(and n
- (math-div 1 (math-known-sin (car n) (nth 1 n) 120 300)))))
+ (let ((s (math-known-sin (car n) (nth 1 n) 120 300)))
+ (and s (math-div 1 s))))))
(and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (let ((n (math-integer-plus (nth 1 expr))))
(and n
- (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
+ (let ((s (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))
+ (and s (math-div 1 s))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
(math-div
1
(list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
(math-div
1
- (nth 1 (nth 1 math-simplify-expr))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
+ (nth 1 (nth 1 expr))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
(list 'calcFunc-sqrt
(math-add 1
- (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
+ (math-sqr (nth 1 (nth 1 expr))))))))
(math-defsimplify calcFunc-csc
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr)))))
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-csc (math-neg (nth 1 expr)))))
(and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
(and n
- (math-div 1 (math-known-sin (car n) (nth 1 n) 120 0)))))
+ (let ((s (math-known-sin (car n) (nth 1 n) 120 0)))
+ (and s (math-div 1 s))))))
(and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (let ((n (math-integer-plus (nth 1 expr))))
(and n
- (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
- (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
+ (let ((s (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))
+ (and s (math-div 1 s))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
+ (math-div 1 (nth 1 (nth 1 expr))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
(math-div
1
(list 'calcFunc-sqrt (math-sub 1 (math-sqr
- (nth 1 (nth 1 math-simplify-expr)))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
+ (nth 1 (nth 1 expr)))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
(math-div (list 'calcFunc-sqrt
(math-add 1 (math-sqr
- (nth 1 (nth 1 math-simplify-expr)))))
- (nth 1 (nth 1 math-simplify-expr))))))
+ (nth 1 (nth 1 expr)))))
+ (nth 1 (nth 1 expr))))))
(defun math-should-expand-trig (x &optional hyperbolic)
(let ((m (math-is-multiple x)))
@@ -943,55 +942,57 @@
(t nil))))))
(math-defsimplify calcFunc-tan
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
- (nth 1 (nth 1 math-simplify-expr)))
- (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr)))))
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
+ (nth 1 (nth 1 expr)))
+ (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-tan (math-neg (nth 1 expr)))))
(and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
(and n
(math-known-tan (car n) (nth 1 n) 120))))
(and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (let ((n (math-integer-plus (nth 1 expr))))
(and n
(math-known-tan (car n) (nth 1 n) '(frac 2 3)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
- (math-div (nth 1 (nth 1 math-simplify-expr))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
+ (math-div (nth 1 (nth 1 expr))
(list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
(math-div (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
- (nth 1 (nth 1 math-simplify-expr))))
- (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))
+ (nth 1 (nth 1 expr))))
+ (let ((m (math-should-expand-trig (nth 1 expr))))
(and m
(if (equal (car m) '(frac 1 2))
(math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m)))
(list 'calcFunc-sin (nth 1 m)))
- (math-div (list 'calcFunc-sin (nth 1 math-simplify-expr))
- (list 'calcFunc-cos (nth 1 math-simplify-expr))))))))
+ (math-div (list 'calcFunc-sin (nth 1 expr))
+ (list 'calcFunc-cos (nth 1 expr))))))))
(math-defsimplify calcFunc-cot
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-cot (math-neg (nth 1 math-simplify-expr)))))
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-cot (math-neg (nth 1 expr)))))
(and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
(and n
- (math-div 1 (math-known-tan (car n) (nth 1 n) 120)))))
+ (let ((tn (math-known-tan (car n) (nth 1 n) 120)))
+ (and tn (math-div 1 tn))))))
(and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (let ((n (math-integer-plus (nth 1 expr))))
(and n
- (math-div 1 (math-known-tan (car n) (nth 1 n) '(frac 2 3))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
+ (let ((tn (math-known-tan (car n) (nth 1 n) '(frac 2 3))))
+ (and tn (math-div 1 tn))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
(math-div (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
- (nth 1 (nth 1 math-simplify-expr))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
- (math-div (nth 1 (nth 1 math-simplify-expr))
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))
+ (nth 1 (nth 1 expr))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
+ (math-div (nth 1 (nth 1 expr))
(list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
- (math-div 1 (nth 1 (nth 1 math-simplify-expr))))))
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
+ (math-div 1 (nth 1 (nth 1 expr))))))
(defun math-known-tan (plus n mul)
(setq n (math-mul n mul))
@@ -1026,20 +1027,20 @@
(t nil))))))
(math-defsimplify calcFunc-sinh
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
- (nth 1 (nth 1 math-simplify-expr)))
- (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
+ (nth 1 (nth 1 expr)))
+ (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-sinh (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
math-living-dangerously
(list 'calcFunc-sqrt
- (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
math-living-dangerously
- (math-div (nth 1 (nth 1 math-simplify-expr))
+ (math-div (nth 1 (nth 1 expr))
(list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
- (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
+ (let ((m (math-should-expand-trig (nth 1 expr) t)))
(and m (integerp (car m))
(let ((n (car m)) (a (nth 1 m)))
(if (> n 1)
@@ -1050,20 +1051,20 @@
(list 'calcFunc-sinh a)))))))))
(math-defsimplify calcFunc-cosh
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
- (nth 1 (nth 1 math-simplify-expr)))
- (and (math-looks-negp (nth 1 math-simplify-expr))
- (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
+ (nth 1 (nth 1 expr)))
+ (and (math-looks-negp (nth 1 expr))
+ (list 'calcFunc-cosh (math-neg (nth 1 expr))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
math-living-dangerously
(list 'calcFunc-sqrt
- (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
math-living-dangerously
(math-div 1
(list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
- (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
+ (let ((m (math-should-expand-trig (nth 1 expr) t)))
(and m (integerp (car m))
(let ((n (car m)) (a (nth 1 m)))
(if (> n 1)
@@ -1074,188 +1075,188 @@
(list 'calcFunc-sinh a)))))))))
(math-defsimplify calcFunc-tanh
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
- (nth 1 (nth 1 math-simplify-expr)))
- (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
+ (nth 1 (nth 1 expr)))
+ (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-tanh (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
math-living-dangerously
- (math-div (nth 1 (nth 1 math-simplify-expr))
+ (math-div (nth 1 (nth 1 expr))
(list 'calcFunc-sqrt
- (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ (math-add (math-sqr (nth 1 (nth 1 expr))) 1))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
math-living-dangerously
(math-div (list 'calcFunc-sqrt
- (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))
- (nth 1 (nth 1 math-simplify-expr))))
- (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
+ (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))
+ (nth 1 (nth 1 expr))))
+ (let ((m (math-should-expand-trig (nth 1 expr) t)))
(and m
(if (equal (car m) '(frac 1 2))
(math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1)
(list 'calcFunc-sinh (nth 1 m)))
- (math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr))
- (list 'calcFunc-cosh (nth 1 math-simplify-expr))))))))
+ (math-div (list 'calcFunc-sinh (nth 1 expr))
+ (list 'calcFunc-cosh (nth 1 expr))))))))
(math-defsimplify calcFunc-sech
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ (or (and (math-looks-negp (nth 1 expr))
+ (list 'calcFunc-sech (math-neg (nth 1 expr))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
math-living-dangerously
(math-div
1
(list 'calcFunc-sqrt
- (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ (math-add (math-sqr (nth 1 (nth 1 expr))) 1))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
math-living-dangerously
- (math-div 1 (nth 1 (nth 1 math-simplify-expr))) 1)
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ (math-div 1 (nth 1 (nth 1 expr))) 1)
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
math-living-dangerously
(list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))))
(math-defsimplify calcFunc-csch
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-csch (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-csch (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
math-living-dangerously
- (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ (math-div 1 (nth 1 (nth 1 expr))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
math-living-dangerously
(math-div
1
(list 'calcFunc-sqrt
- (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
math-living-dangerously
(math-div (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
- (nth 1 (nth 1 math-simplify-expr))))))
+ (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))
+ (nth 1 (nth 1 expr))))))
(math-defsimplify calcFunc-coth
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-coth (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-coth (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
math-living-dangerously
(math-div (list 'calcFunc-sqrt
- (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))
- (nth 1 (nth 1 math-simplify-expr))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ (math-add (math-sqr (nth 1 (nth 1 expr))) 1))
+ (nth 1 (nth 1 expr))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
math-living-dangerously
- (math-div (nth 1 (nth 1 math-simplify-expr))
+ (math-div (nth 1 (nth 1 expr))
(list 'calcFunc-sqrt
- (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
math-living-dangerously
- (math-div 1 (nth 1 (nth 1 math-simplify-expr))))))
+ (math-div 1 (nth 1 (nth 1 expr))))))
(math-defsimplify calcFunc-arcsin
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (nth 1 math-simplify-expr) 1)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr)))))
+ (and (eq (nth 1 expr) 1)
(math-quarter-circle t))
- (and (equal (nth 1 math-simplify-expr) '(frac 1 2))
+ (and (equal (nth 1 expr) '(frac 1 2))
(math-div (math-half-circle t) 6))
(and math-living-dangerously
- (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin)
- (nth 1 (nth 1 math-simplify-expr)))
+ (eq (car-safe (nth 1 expr)) 'calcFunc-sin)
+ (nth 1 (nth 1 expr)))
(and math-living-dangerously
- (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
+ (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
(math-sub (math-quarter-circle t)
- (nth 1 (nth 1 math-simplify-expr))))))
+ (nth 1 (nth 1 expr))))))
(math-defsimplify calcFunc-arccos
- (or (and (eq (nth 1 math-simplify-expr) 0)
+ (or (and (eq (nth 1 expr) 0)
(math-quarter-circle t))
- (and (eq (nth 1 math-simplify-expr) -1)
+ (and (eq (nth 1 expr) -1)
(math-half-circle t))
- (and (equal (nth 1 math-simplify-expr) '(frac 1 2))
+ (and (equal (nth 1 expr) '(frac 1 2))
(math-div (math-half-circle t) 3))
- (and (equal (nth 1 math-simplify-expr) '(frac -1 2))
+ (and (equal (nth 1 expr) '(frac -1 2))
(math-div (math-mul (math-half-circle t) 2) 3))
(and math-living-dangerously
- (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
- (nth 1 (nth 1 math-simplify-expr)))
+ (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
+ (nth 1 (nth 1 expr)))
(and math-living-dangerously
- (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin)
+ (eq (car-safe (nth 1 expr)) 'calcFunc-sin)
(math-sub (math-quarter-circle t)
- (nth 1 (nth 1 math-simplify-expr))))))
+ (nth 1 (nth 1 expr))))))
(math-defsimplify calcFunc-arctan
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-arctan (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (nth 1 math-simplify-expr) 1)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr)))))
+ (and (eq (nth 1 expr) 1)
(math-div (math-half-circle t) 4))
(and math-living-dangerously
- (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tan)
- (nth 1 (nth 1 math-simplify-expr)))))
+ (eq (car-safe (nth 1 expr)) 'calcFunc-tan)
+ (nth 1 (nth 1 expr)))))
(math-defsimplify calcFunc-arcsinh
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sinh)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-sinh)
(or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
- (nth 1 (nth 1 math-simplify-expr)))))
+ (math-known-realp (nth 1 (nth 1 expr))))
+ (nth 1 (nth 1 expr)))))
(math-defsimplify calcFunc-arccosh
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh)
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh)
(or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
- (nth 1 (nth 1 math-simplify-expr))))
+ (math-known-realp (nth 1 (nth 1 expr))))
+ (nth 1 (nth 1 expr))))
(math-defsimplify calcFunc-arctanh
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tanh)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-tanh)
(or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
- (nth 1 (nth 1 math-simplify-expr)))))
+ (math-known-realp (nth 1 (nth 1 expr))))
+ (nth 1 (nth 1 expr)))))
(math-defsimplify calcFunc-sqrt
- (math-simplify-sqrt))
+ (math-simplify-sqrt expr))
-(defun math-simplify-sqrt ()
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
+(defun math-simplify-sqrt (expr)
+ (or (and (eq (car-safe (nth 1 expr)) 'frac)
(math-div (list 'calcFunc-sqrt
- (math-mul (nth 1 (nth 1 math-simplify-expr))
- (nth 2 (nth 1 math-simplify-expr))))
- (nth 2 (nth 1 math-simplify-expr))))
- (let ((fac (if (math-objectp (nth 1 math-simplify-expr))
- (math-squared-factor (nth 1 math-simplify-expr))
- (math-common-constant-factor (nth 1 math-simplify-expr)))))
+ (math-mul (nth 1 (nth 1 expr))
+ (nth 2 (nth 1 expr))))
+ (nth 2 (nth 1 expr))))
+ (let ((fac (if (math-objectp (nth 1 expr))
+ (math-squared-factor (nth 1 expr))
+ (math-common-constant-factor (nth 1 expr)))))
(and fac (not (eq fac 1))
(math-mul (math-normalize (list 'calcFunc-sqrt fac))
(math-normalize
(list 'calcFunc-sqrt
(math-cancel-common-factor
- (nth 1 math-simplify-expr) fac))))))
+ (nth 1 expr) fac))))))
(and math-living-dangerously
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
- (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1)
- (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^)
- (math-equal-int (nth 2 (nth 2 (nth 1 math-simplify-expr))) 2)
- (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
+ (or (and (eq (car-safe (nth 1 expr)) '-)
+ (math-equal-int (nth 1 (nth 1 expr)) 1)
+ (eq (car-safe (nth 2 (nth 1 expr))) '^)
+ (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2)
+ (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))
'calcFunc-sin)
(list 'calcFunc-cos
- (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr))))))
- (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
+ (nth 1 (nth 1 (nth 2 (nth 1 expr))))))
+ (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))
'calcFunc-cos)
(list 'calcFunc-sin
(nth 1 (nth 1 (nth 2
- (nth 1 math-simplify-expr))))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
- (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1)
- (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^)
- (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2)
- (and (eq (car-safe (nth 1 (nth 1 (nth 1 math-simplify-expr))))
+ (nth 1 expr))))))))
+ (and (eq (car-safe (nth 1 expr)) '-)
+ (math-equal-int (nth 2 (nth 1 expr)) 1)
+ (eq (car-safe (nth 1 (nth 1 expr))) '^)
+ (math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2)
+ (and (eq (car-safe (nth 1 (nth 1 (nth 1 expr))))
'calcFunc-cosh)
(list 'calcFunc-sinh
- (nth 1 (nth 1 (nth 1 (nth 1 math-simplify-expr)))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) '+)
- (let ((a (nth 1 (nth 1 math-simplify-expr)))
- (b (nth 2 (nth 1 math-simplify-expr))))
+ (nth 1 (nth 1 (nth 1 (nth 1 expr)))))))
+ (and (eq (car-safe (nth 1 expr)) '+)
+ (let ((a (nth 1 (nth 1 expr)))
+ (b (nth 2 (nth 1 expr))))
(and (or (and (math-equal-int a 1)
- (setq a b b (nth 1 (nth 1 math-simplify-expr))))
+ (setq a b b (nth 1 (nth 1 expr))))
(math-equal-int b 1))
(eq (car-safe a) '^)
(math-equal-int (nth 2 a) 2)
@@ -1269,20 +1270,20 @@
(and (eq (car-safe (nth 1 a)) 'calcFunc-cot)
(list '/ 1 (list 'calcFunc-sin
(nth 1 (nth 1 a)))))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
+ (and (eq (car-safe (nth 1 expr)) '^)
(list '^
- (nth 1 (nth 1 math-simplify-expr))
- (math-div (nth 2 (nth 1 math-simplify-expr)) 2)))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt)
- (list '^ (nth 1 (nth 1 math-simplify-expr)) (math-div 1 4)))
- (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
- (list (car (nth 1 math-simplify-expr))
- (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr)))
- (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr)))))
- (and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -))
- (not (math-any-floats (nth 1 math-simplify-expr)))
+ (nth 1 (nth 1 expr))
+ (math-div (nth 2 (nth 1 expr)) 2)))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)
+ (list '^ (nth 1 (nth 1 expr)) (math-div 1 4)))
+ (and (memq (car-safe (nth 1 expr)) '(* /))
+ (list (car (nth 1 expr))
+ (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))
+ (list 'calcFunc-sqrt (nth 2 (nth 1 expr)))))
+ (and (memq (car-safe (nth 1 expr)) '(+ -))
+ (not (math-any-floats (nth 1 expr)))
(let ((f (calcFunc-factors (calcFunc-expand
- (nth 1 math-simplify-expr)))))
+ (nth 1 expr)))))
(and (math-vectorp f)
(or (> (length f) 2)
(> (nth 2 (nth 1 f)) 1))
@@ -1318,7 +1319,7 @@
fac)))
(math-defsimplify calcFunc-exp
- (math-simplify-exp (nth 1 math-simplify-expr)))
+ (math-simplify-exp (nth 1 expr)))
(defun math-simplify-exp (x)
(or (and (eq (car-safe x) 'calcFunc-ln)
@@ -1349,22 +1350,22 @@
(list '+ c (list '* s '(var i var-i))))))))
(math-defsimplify calcFunc-ln
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp)
(or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
- (nth 1 (nth 1 math-simplify-expr)))
- (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
- (equal (nth 1 (nth 1 math-simplify-expr)) '(var e var-e))
+ (math-known-realp (nth 1 (nth 1 expr))))
+ (nth 1 (nth 1 expr)))
+ (and (eq (car-safe (nth 1 expr)) '^)
+ (equal (nth 1 (nth 1 expr)) '(var e var-e))
(or math-living-dangerously
- (math-known-realp (nth 2 (nth 1 math-simplify-expr))))
- (nth 2 (nth 1 math-simplify-expr)))
+ (math-known-realp (nth 2 (nth 1 expr))))
+ (nth 2 (nth 1 expr)))
(and calc-symbolic-mode
- (math-known-negp (nth 1 math-simplify-expr))
- (math-add (list 'calcFunc-ln (math-neg (nth 1 math-simplify-expr)))
+ (math-known-negp (nth 1 expr))
+ (math-add (list 'calcFunc-ln (math-neg (nth 1 expr)))
'(* (var pi var-pi) (var i var-i))))
(and calc-symbolic-mode
- (math-known-imagp (nth 1 math-simplify-expr))
- (let* ((ip (calcFunc-im (nth 1 math-simplify-expr)))
+ (math-known-imagp (nth 1 expr))
+ (let* ((ip (calcFunc-im (nth 1 expr)))
(ips (math-possible-signs ip)))
(or (and (memq ips '(4 6))
(math-add (list 'calcFunc-ln ip)
@@ -1374,95 +1375,92 @@
'(/ (* (var pi var-pi) (var i var-i)) 2))))))))
(math-defsimplify ^
- (math-simplify-pow))
-
-(defun math-simplify-pow ()
(or (and math-living-dangerously
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
+ (or (and (eq (car-safe (nth 1 expr)) '^)
(list '^
- (nth 1 (nth 1 math-simplify-expr))
- (math-mul (nth 2 math-simplify-expr)
- (nth 2 (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt)
+ (nth 1 (nth 1 expr))
+ (math-mul (nth 2 expr)
+ (nth 2 (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)
(list '^
- (nth 1 (nth 1 math-simplify-expr))
- (math-div (nth 2 math-simplify-expr) 2)))
- (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
- (list (car (nth 1 math-simplify-expr))
- (list '^ (nth 1 (nth 1 math-simplify-expr))
- (nth 2 math-simplify-expr))
- (list '^ (nth 2 (nth 1 math-simplify-expr))
- (nth 2 math-simplify-expr))))))
- (and (math-equal-int (nth 1 math-simplify-expr) 10)
- (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10)
- (nth 1 (nth 2 math-simplify-expr)))
- (and (equal (nth 1 math-simplify-expr) '(var e var-e))
- (math-simplify-exp (nth 2 math-simplify-expr)))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
+ (nth 1 (nth 1 expr))
+ (math-div (nth 2 expr) 2)))
+ (and (memq (car-safe (nth 1 expr)) '(* /))
+ (list (car (nth 1 expr))
+ (list '^ (nth 1 (nth 1 expr))
+ (nth 2 expr))
+ (list '^ (nth 2 (nth 1 expr))
+ (nth 2 expr))))))
+ (and (math-equal-int (nth 1 expr) 10)
+ (eq (car-safe (nth 2 expr)) 'calcFunc-log10)
+ (nth 1 (nth 2 expr)))
+ (and (equal (nth 1 expr) '(var e var-e))
+ (math-simplify-exp (nth 2 expr)))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp)
(not math-integrating)
- (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr))
- (nth 2 math-simplify-expr))))
- (and (equal (nth 1 math-simplify-expr) '(var i var-i))
+ (list 'calcFunc-exp (math-mul (nth 1 (nth 1 expr))
+ (nth 2 expr))))
+ (and (equal (nth 1 expr) '(var i var-i))
(math-imaginary-i)
- (math-num-integerp (nth 2 math-simplify-expr))
- (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4)))
+ (math-num-integerp (nth 2 expr))
+ (let ((x (math-mod (math-trunc (nth 2 expr)) 4)))
(cond ((eq x 0) 1)
- ((eq x 1) (nth 1 math-simplify-expr))
+ ((eq x 1) (nth 1 expr))
((eq x 2) -1)
- ((eq x 3) (math-neg (nth 1 math-simplify-expr))))))
+ ((eq x 3) (math-neg (nth 1 expr))))))
(and math-integrating
- (integerp (nth 2 math-simplify-expr))
- (>= (nth 2 math-simplify-expr) 2)
- (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
- (math-mul (math-pow (nth 1 math-simplify-expr)
- (- (nth 2 math-simplify-expr) 2))
+ (integerp (nth 2 expr))
+ (>= (nth 2 expr) 2)
+ (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
+ (math-mul (math-pow (nth 1 expr)
+ (- (nth 2 expr) 2))
(math-sub 1
(math-sqr
(list 'calcFunc-sin
- (nth 1 (nth 1 math-simplify-expr)))))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh)
- (math-mul (math-pow (nth 1 math-simplify-expr)
- (- (nth 2 math-simplify-expr) 2))
+ (nth 1 (nth 1 expr)))))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh)
+ (math-mul (math-pow (nth 1 expr)
+ (- (nth 2 expr) 2))
(math-add 1
(math-sqr
(list 'calcFunc-sinh
- (nth 1 (nth 1 math-simplify-expr)))))))))
- (and (eq (car-safe (nth 2 math-simplify-expr)) 'frac)
- (Math-ratp (nth 1 math-simplify-expr))
- (Math-posp (nth 1 math-simplify-expr))
- (if (equal (nth 2 math-simplify-expr) '(frac 1 2))
- (list 'calcFunc-sqrt (nth 1 math-simplify-expr))
- (let ((flr (math-floor (nth 2 math-simplify-expr))))
+ (nth 1 (nth 1 expr)))))))))
+ (and (eq (car-safe (nth 2 expr)) 'frac)
+ (Math-ratp (nth 1 expr))
+ (Math-posp (nth 1 expr))
+ (if (equal (nth 2 expr) '(frac 1 2))
+ (list 'calcFunc-sqrt (nth 1 expr))
+ (let ((flr (math-floor (nth 2 expr))))
(and (not (Math-zerop flr))
- (list '* (list '^ (nth 1 math-simplify-expr) flr)
- (list '^ (nth 1 math-simplify-expr)
- (math-sub (nth 2 math-simplify-expr) flr)))))))
- (and (eq (math-quarter-integer (nth 2 math-simplify-expr)) 2)
- (let ((temp (math-simplify-sqrt)))
+ (list '* (list '^ (nth 1 expr) flr)
+ (list '^ (nth 1 expr)
+ (math-sub (nth 2 expr) flr)))))))
+ (and (eq (math-quarter-integer (nth 2 expr)) 2)
+ (let ((temp (math-simplify-sqrt expr)))
(and temp
- (list '^ temp (math-mul (nth 2 math-simplify-expr) 2)))))))
+ (list '^ temp (math-mul (nth 2 expr) 2)))))))
(math-defsimplify calcFunc-log10
- (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
- (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 10)
+ (and (eq (car-safe (nth 1 expr)) '^)
+ (math-equal-int (nth 1 (nth 1 expr)) 10)
(or math-living-dangerously
- (math-known-realp (nth 2 (nth 1 math-simplify-expr))))
- (nth 2 (nth 1 math-simplify-expr))))
+ (math-known-realp (nth 2 (nth 1 expr))))
+ (nth 2 (nth 1 expr))))
(math-defsimplify calcFunc-erf
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-neg (list 'calcFunc-erf (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj)
(list 'calcFunc-conj
- (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr)))))))
+ (list 'calcFunc-erf (nth 1 (nth 1 expr)))))))
(math-defsimplify calcFunc-erfc
- (or (and (math-looks-negp (nth 1 math-simplify-expr))
- (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr)))))
- (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
+ (or (and (math-looks-negp (nth 1 expr))
+ (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 expr)))))
+ (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj)
(list 'calcFunc-conj
- (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr)))))))
+ (list 'calcFunc-erfc (nth 1 (nth 1 expr)))))))
(defun math-linear-in (expr term &optional always)
@@ -1614,10 +1612,12 @@
(defvar math-expr-subst-old)
(defvar math-expr-subst-new)
-(defun math-expr-subst (expr math-expr-subst-old math-expr-subst-new)
- (math-expr-subst-rec expr))
+(defun math-expr-subst (expr old new)
+ (let ((math-expr-subst-old old)
+ (math-expr-subst-new new))
+ (math-expr-subst-rec expr)))
-(defalias 'calcFunc-subst 'math-expr-subst)
+(defalias 'calcFunc-subst #'math-expr-subst)
(defun math-expr-subst-rec (expr)
(cond ((equal expr math-expr-subst-old) math-expr-subst-new)
@@ -1632,7 +1632,7 @@
(math-expr-subst-rec (nth 2 expr)))))
(t
(cons (car expr)
- (mapcar 'math-expr-subst-rec (cdr expr))))))
+ (mapcar #'math-expr-subst-rec (cdr expr))))))
;;; Various measures of the size of an expression.
(defun math-expr-weight (expr)
@@ -1659,7 +1659,7 @@
(defun calcFunc-collect (expr base)
(let ((p (math-is-polynomial expr base 50 t)))
(if (cdr p)
- (math-build-polynomial-expr (mapcar 'math-normalize p) base)
+ (math-build-polynomial-expr (mapcar #'math-normalize p) base)
(car p))))
;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...),
@@ -1672,13 +1672,16 @@
(defvar math-is-poly-loose)
(defvar math-var)
-(defun math-is-polynomial (expr math-var &optional math-is-poly-degree math-is-poly-loose)
- (let* ((math-poly-base-variable (if math-is-poly-loose
- (if (eq math-is-poly-loose 'gen) math-var '(var XXX XXX))
+(defun math-is-polynomial (expr var &optional degree loose)
+ (let* ((math-poly-base-variable (if loose
+ (if (eq loose 'gen) var '(var XXX XXX))
math-poly-base-variable))
+ (math-var var)
+ (math-is-poly-loose loose)
+ (math-is-poly-degree degree)
(poly (math-is-poly-rec expr math-poly-neg-powers)))
- (and (or (null math-is-poly-degree)
- (<= (length poly) (1+ math-is-poly-degree)))
+ (and (or (null degree)
+ (<= (length poly) (1+ degree)))
poly)))
(defun math-is-poly-rec (expr negpow)
@@ -1749,7 +1752,7 @@
(math-poly-mix p1 1 p2
(if (eq (car expr) '+) 1 -1)))))))
((eq (car expr) 'neg)
- (mapcar 'math-neg (math-is-poly-rec (nth 1 expr) negpow)))
+ (mapcar #'math-neg (math-is-poly-rec (nth 1 expr) negpow)))
((eq (car expr) '*)
(let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
(and p1
@@ -1812,24 +1815,20 @@
(math-expr-contains expr math-poly-base-variable)
(math-expr-depends expr var)))
-;;; Find the variable (or sub-expression) which is the base of polynomial expr.
;; The variables math-poly-base-const-ok and math-poly-base-pred are
;; local to math-polynomial-base, but are used by math-polynomial-base-rec.
(defvar math-poly-base-const-ok)
(defvar math-poly-base-pred)
-;; The variable math-poly-base-top-expr is local to math-polynomial-base,
-;; but is used by math-polynomial-p1 in calc-poly.el, which is called
-;; by math-polynomial-base.
-
-(defun math-polynomial-base (math-poly-base-top-expr &optional math-poly-base-pred)
- (or math-poly-base-pred
- (setq math-poly-base-pred (function (lambda (base) (math-polynomial-p
- math-poly-base-top-expr base)))))
+(defun math-polynomial-base (top-expr &optional pred)
+ "Find the variable (or sub-expression) which is the base of polynomial expr."
+ (let ((math-poly-base-pred
+ (or pred (function (lambda (base) (math-polynomial-p
+ top-expr base))))))
(or (let ((math-poly-base-const-ok nil))
- (math-polynomial-base-rec math-poly-base-top-expr))
+ (math-polynomial-base-rec top-expr))
(let ((math-poly-base-const-ok t))
- (math-polynomial-base-rec math-poly-base-top-expr))))
+ (math-polynomial-base-rec top-expr)))))
(defun math-polynomial-base-rec (mpb-expr)
(and (not (Math-objvecp mpb-expr))
@@ -1846,8 +1845,8 @@
(funcall math-poly-base-pred mpb-expr)
mpb-expr))))
-;;; Return non-nil if expr refers to any variables.
(defun math-expr-contains-vars (expr)
+ "Return non-nil if expr refers to any variables."
(or (eq (car-safe expr) 'var)
(and (not (Math-primp expr))
(progn
@@ -1855,9 +1854,9 @@
(not (math-expr-contains-vars (car expr)))))
expr))))
-;;; Simplify a polynomial in list form by stripping off high-end zeros.
-;;; This always leaves the constant part, i.e., nil->nil and non-nil->non-nil.
(defun math-poly-simplify (p)
+ "Simplify a polynomial in list form by stripping off high-end zeros.
+This always leaves the constant part, i.e., nil->nil and non-nil->non-nil."
(and p
(if (Math-zerop (nth (1- (length p)) p))
(let ((pp (copy-sequence p)))
@@ -1879,14 +1878,14 @@
(or (null a)
(and (null (cdr a)) (Math-zerop (car a)))))
-;;; Multiply two polynomials in list form.
(defun math-poly-mul (a b)
+ "Multiply two polynomials in list form."
(and a b
(math-poly-mix b (car a)
(math-poly-mul (cdr a) (cons 0 b)) 1)))
-;;; Build an expression from a polynomial list.
(defun math-build-polynomial-expr (p var)
+ "Build an expression from a polynomial list."
(if p
(if (Math-numberp var)
(math-with-extra-prec 1
@@ -1897,8 +1896,7 @@
accum))
(let* ((rp (reverse p))
(n (1- (length rp)))
- (accum (math-mul (car rp) (math-pow var n)))
- term)
+ (accum (math-mul (car rp) (math-pow var n))))
(while (setq rp (cdr rp))
(setq n (1- n))
(or (math-zerop (car rp))
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index a85792a6113..558e309e472 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -28,17 +28,6 @@
(require 'calc-ext)
(require 'calc-macs)
-;;; Some useful numbers
-(defconst math-bignum-logb-digit-size
- (logb math-bignum-digit-size)
- "The logb of the size of a bignum digit.
-This is the largest value of B such that 2^B is less than
-the size of a Calc bignum digit.")
-
-(defconst math-bignum-digit-power-of-two
- (expt 2 (logb math-bignum-digit-size))
- "The largest power of 2 less than the size of a Calc bignum digit.")
-
;;; b-prefix binary commands.
(defun calc-and (n)
@@ -268,18 +257,14 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-and-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
+ (t (math-clip (logand (math-binary-arg a w) (math-binary-arg b w)) w))))
(defun math-binary-arg (a w)
(if (not (Math-integerp a))
(setq a (math-trunc a)))
- (if (Math-integer-negp a)
- (math-not-bignum (cdr (math-bignum-test (math-sub -1 a)))
- (math-abs (if w (math-trunc w) calc-word-size)))
- (cdr (Math-bignum-test a))))
+ (if (< a 0)
+ (logand a (1- (ash 1 (if w (math-trunc w) calc-word-size))))
+ a))
(defun math-binary-modulo-args (f a b w)
(let (mod)
@@ -310,15 +295,6 @@ the size of a Calc bignum digit.")
(funcall f a w))
mod))))
-(defun math-and-bignum (a b) ; [l l l]
- (and a b
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logand (cdr qa) (cdr qb))))))
-
(defun calcFunc-or (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
(calcFunc-or a b (math-trunc w)))
@@ -332,19 +308,7 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-or-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
-
-(defun math-or-bignum (a b) ; [l l l]
- (and (or a b)
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logior (cdr qa) (cdr qb))))))
+ (t (math-clip (logior (math-binary-arg a w) (math-binary-arg b w)) w))))
(defun calcFunc-xor (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
@@ -359,19 +323,7 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-xor-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
-
-(defun math-xor-bignum (a b) ; [l l l]
- (and (or a b)
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logxor (cdr qa) (cdr qb))))))
+ (t (math-clip (logxor (math-binary-arg a w) (math-binary-arg b w)) w))))
(defun calcFunc-diff (a b &optional w) ; [I I I] [Public]
(cond ((Math-messy-integerp w)
@@ -386,19 +338,9 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((not (Math-num-integerp b))
(math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-diff-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
-
-(defun math-diff-bignum (a b) ; [l l l]
- (and a
- (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two))
- (qb (math-div-bignum-digit b math-bignum-digit-power-of-two)))
- (math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- math-bignum-digit-power-of-two
- (logand (cdr qa) (lognot (cdr qb)))))))
+ (t (math-clip (logand (math-binary-arg a w)
+ (lognot (math-binary-arg b w)))
+ w))))
(defun calcFunc-not (a &optional w) ; [I I] [Public]
(cond ((Math-messy-integerp w)
@@ -411,21 +353,7 @@ the size of a Calc bignum digit.")
(math-reject-arg a 'integerp))
((< (or w (setq w calc-word-size)) 0)
(math-clip (calcFunc-not a (- w)) w))
- (t (math-normalize
- (cons 'bigpos
- (math-not-bignum (math-binary-arg a w)
- w))))))
-
-(defun math-not-bignum (a w) ; [l l]
- (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
- (if (<= w math-bignum-logb-digit-size)
- (list (logand (lognot (cdr q))
- (1- (lsh 1 w))))
- (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
- (- w math-bignum-logb-digit-size))
- math-bignum-digit-power-of-two
- (logxor (cdr q)
- (1- math-bignum-digit-power-of-two))))))
+ (t (math-clip (lognot (math-binary-arg a w)) w))))
(defun calcFunc-lsh (a &optional n w) ; [I I] [Public]
(setq a (math-trunc a)
@@ -525,29 +453,12 @@ the size of a Calc bignum digit.")
a
(math-sub a (math-power-of-2 (- w)))))
((Math-negp a)
- (math-normalize (cons 'bigpos (math-binary-arg a w))))
- ((and (integerp a) (< a math-small-integer-size))
- (if (> w (logb math-small-integer-size))
- a
- (logand a (1- (lsh 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- (lsh 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))
@@ -595,60 +506,9 @@ the size of a Calc bignum digit.")
a (/ a calc-number-radix)))
s)))
-(defconst math-binary-digits ["000" "001" "010" "011"
- "100" "101" "110" "111"])
(defun math-format-binary (a) ; [X S]
- (if (< a 8)
- (if (< a 0)
- (concat "-" (math-format-binary (- a)))
- (math-format-radix 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)))))))
+ (let ((calc-number-radix 2))
+ (math-format-radix a)))
;;; Decompose into integer and fractional parts, without depending
;;; on calc-internal-prec.
@@ -665,7 +525,7 @@ the size of a Calc bignum digit.")
(list (math-scale-rounding (nth 1 a) (nth 2 a))
'(float 0 0) 0)))))
-(defun math-format-radix-float (a prec)
+(defun math-format-radix-float (a _prec)
(let ((fmt (car calc-float-format))
(figs (nth 1 calc-float-format))
(point calc-point-char)
@@ -823,20 +683,14 @@ the size of a Calc bignum digit.")
(defun math-format-twos-complement (a)
"Format an integer in two's complement mode."
(let* (;(calc-leading-zeros t)
- (overflow nil)
- (negative nil)
(num
(cond
((or (eq a 0)
- (and (Math-integer-posp a)))
- (if (integerp a)
- (math-format-radix a)
- (math-format-bignum-radix (cdr a))))
+ (Math-integer-posp a))
+ (math-format-radix a))
((Math-integer-negp a)
(let ((newa (math-add a math-2-word-size)))
- (if (integerp newa)
- (math-format-radix newa)
- (math-format-bignum-radix (cdr newa))))))))
+ (math-format-radix newa))))))
(let* ((calc-internal-prec 6)
(digs (math-compute-max-digits (math-abs calc-word-size)
calc-number-radix))
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index d74c815bd24..5bede650dd3 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -211,8 +211,8 @@
(calc-invert-func)
(calc-next-prime iters))
-(defun calc-prime-factors (iters)
- (interactive "p")
+(defun calc-prime-factors (&optional _iters)
+ (interactive)
(calc-slow-wrapper
(let ((res (calcFunc-prfac (calc-top-n 1))))
(if (not math-prime-factors-finished)
@@ -580,7 +580,7 @@
;; deduce a better value for RAND_MAX.
(let ((i 0))
(while (< (setq i (1+ i)) 30)
- (if (> (lsh (math-abs (random)) math-random-shift) 4095)
+ (if (> (ash (math-abs (random)) math-random-shift) 4095)
(setq math-random-shift (1- math-random-shift))))))
(setq math-last-RandSeed var-RandSeed
math-gaussian-cache nil))
@@ -592,11 +592,11 @@
(cdr math-random-table))
math-random-ptr2 (or (cdr math-random-ptr2)
(cdr math-random-table)))
- (logand (lsh (setcar math-random-ptr1
+ (logand (ash (setcar math-random-ptr1
(logand (- (car math-random-ptr1)
(car math-random-ptr2)) 524287))
-6) 1023))
- (logand (lsh (random) math-random-shift) 1023)))
+ (logand (ash (random) math-random-shift) 1023)))
;;; Produce a random digit in the range 0..999.
@@ -806,7 +806,6 @@
((Math-integer-negp n)
'(nil))
((Math-natnum-lessp n 8000000)
- (setq n (math-fixnum n))
(let ((i -1) v)
(while (and (> (% n (setq v (aref math-primes-table
(setq i (1+ i)))))
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index f2e70906e94..0b3c489d453 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1,4 +1,4 @@
-;;; calc-ext.el --- various extension functions for Calc
+;;; calc-ext.el --- various extension functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2019 Free Software Foundation, Inc.
@@ -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,8 @@
(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-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))
@@ -88,7 +87,7 @@
(defvar calc-alg-map)
(defvar calc-alg-esc-map)
-;;; The following was made a function so that it could be byte-compiled.
+;; The following was made a function so that it could be byte-compiled.
(defun calc-init-extensions ()
(define-key calc-mode-map ":" 'calc-fdiv)
@@ -714,8 +713,8 @@
;;;; (Autoloads here)
(mapc (function (lambda (x)
- (mapcar (function (lambda (func)
- (autoload func (car x)))) (cdr x))))
+ (mapcar (function (lambda (func) (autoload func (car x))))
+ (cdr x))))
'(
("calc-alg" calc-has-rules math-defsimplify
@@ -779,8 +778,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 +879,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)
@@ -894,8 +892,8 @@ calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide
calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim
calcFunc-prem math-accum-factors math-atomic-factorp
math-div-poly-const math-div-thru math-expand-power math-expand-term
-math-factor-contains math-factor-expr math-factor-expr-part
-math-factor-expr-try math-factor-finish math-factor-poly-coefs
+math-factor-contains math-factor-expr
+math-factor-finish
math-factor-protect math-mul-thru math-padded-polynomial
math-partial-fractions math-poly-degree math-poly-deriv-coefs
math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p
@@ -984,8 +982,8 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
))
(mapcar (function (lambda (x)
- (mapcar (function (lambda (cmd)
- (autoload cmd (car x) nil t))) (cdr x))))
+ (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t)))
+ (cdr x))))
'(
("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@@ -1307,8 +1305,9 @@ calc-kill calc-kill-region calc-yank))))
(message "%s" (if msg
(concat group ": " msg ":"
(make-string
- (- (apply 'max (mapcar 'length msgs))
- (length msg)) 32)
+ (- (apply #'max (mapcar #'length msgs))
+ (length msg))
+ ?\s)
" [MORE]"
(if key
(concat " " (char-to-string key)
@@ -1334,6 +1333,8 @@ calc-kill calc-kill-region calc-yank))))
;;; General.
+(defvar calc-embedded-quiet)
+
(defun calc-reset (arg)
(interactive "P")
(setq arg (if arg (prefix-numeric-value arg) nil))
@@ -1398,7 +1399,7 @@ calc-kill calc-kill-region calc-yank))))
(defun calc-scroll-up (n)
(interactive "P")
- (condition-case err
+ (condition-case nil
(scroll-up (or n (/ (window-height) 2)))
(error nil))
(if (pos-visible-in-window-p (max 1 (- (point-max) 2)))
@@ -1484,14 +1485,14 @@ calc-kill calc-kill-region calc-yank))))
(not calc-is-keypad-press)
(if (boundp 'overriding-terminal-local-map)
(setq overriding-terminal-local-map calc-fancy-prefix-map)
- (let ((event (calc-read-key t)))
- (if (eq (setq last-command-event (car event)) ?\C-u)
+ (let ((event (read-event)))
+ (if (eq (setq last-command-event event) ?\C-u)
(universal-argument)
(if (or (not (integerp last-command-event))
(and (>= last-command-event 0) (< last-command-event ? )
(not (memq last-command-event '(?\e)))))
(calc-wrapper)) ; clear flags if not a Calc command.
- (setq last-command-event (cdr event))
+ (setq last-command-event event)
(if (or (not (integerp last-command-event))
(eq last-command-event ?-))
(calc-unread-command)
@@ -1657,7 +1658,7 @@ calc-kill calc-kill-region calc-yank))))
(let ((entries (calc-top-list n 1 'entry))
(calc-undo-list nil) (calc-redo-list nil))
(calc-pop-stack n 1 t)
- (calc-push-list (mapcar 'car entries)
+ (calc-push-list (mapcar #'car entries)
1
(mapcar (function (lambda (x) (nth 2 x)))
entries)))))))
@@ -1707,7 +1708,7 @@ calc-kill calc-kill-region calc-yank))))
(calc-pop-push-record-list 1 "eval"
(math-evaluate-expr (calc-top (- n)))
(- n))
- (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr
+ (calc-pop-push-record-list n "eval" (mapcar #'math-evaluate-expr
(calc-top-list n)))))
(calc-handle-whys)))
@@ -1912,8 +1913,6 @@ calc-kill calc-kill-region calc-yank))))
;;; User menu.
(defun calc-user-key-map ()
- (if (featurep 'xemacs)
- (error "User-defined keys are not supported in XEmacs"))
(let ((res (cdr (lookup-key calc-mode-map "z"))))
(if (eq (car (car res)) 27)
(cdr res)
@@ -1928,7 +1927,7 @@ calc-kill calc-kill-region calc-yank))))
(calc-z-prefix-buf "")
(kmap (sort (copy-sequence (calc-user-key-map))
(function (lambda (x y) (< (car x) (car y))))))
- (flags (apply 'logior
+ (flags (apply #'logior
(mapcar (function
(lambda (k)
(calc-user-function-classify (car k))))
@@ -2003,20 +2002,21 @@ calc-kill calc-kill-region calc-yank))))
;;;; Caches.
(defmacro math-defcache (name init form)
+ (declare (indent 2) (debug (symbolp sexp form)))
(let ((cache-prec (intern (concat (symbol-name name) "-cache-prec")))
(cache-val (intern (concat (symbol-name name) "-cache")))
(last-prec (intern (concat (symbol-name name) "-last-prec")))
(last-val (intern (concat (symbol-name name) "-last"))))
`(progn
-; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
+ ;; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
(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)
@@ -2037,7 +2037,6 @@ calc-kill calc-kill-region calc-yank))))
,cache-val))
,last-prec calc-internal-prec))
,last-val))))
-(put 'math-defcache 'lisp-indent-hook 2)
;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
(defconst math-approx-pi
@@ -2116,77 +2115,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))))
@@ -2276,32 +2259,28 @@ 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 (lsh -1 -1) a)
- (Math-lessp a (- (lsh -1 -1))))
- (math-reject-arg a 'fixnump)
- (math-fixnum a)))))
+ (math-reject-arg a 'fixnump))))
((and allow-inf (equal a '(var inf var-inf)))
- (lsh -1 -1))
+ most-positive-fixnum)
((and allow-inf (equal a '(neg (var inf var-inf))))
- (- (lsh -1 -1)))
+ (- most-positive-fixnum))
(t (math-reject-arg a 'fixnump))))
;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x]
@@ -2347,20 +2326,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)
@@ -2400,7 +2365,7 @@ If X is not an error form, return 1."
(list 'calcFunc-intv mask lo hi)
(math-make-intv mask lo hi))))
((eq (car a) 'vec)
- (cons 'vec (mapcar 'math-normalize (cdr a))))
+ (cons 'vec (mapcar #'math-normalize (cdr a))))
((eq (car a) 'quote)
(math-normalize (nth 1 a)))
((eq (car a) 'special-const)
@@ -2412,7 +2377,7 @@ If X is not an error form, return 1."
(math-normalize-logical-op a))
((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition))
(let ((calc-simplify-mode 'none))
- (cons (car a) (mapcar 'math-normalize (cdr a)))))
+ (cons (car a) (mapcar #'math-normalize (cdr a)))))
((eq (car a) 'calcFunc-evalto)
(setq a (or (nth 1 a) 0))
(or calc-refreshing-evaltos
@@ -2435,27 +2400,25 @@ If X is not an error form, return 1."
;; The variable math-normalize-a is local to math-normalize in calc.el,
;; but is used by math-normalize-nonstandard, which is called by
;; math-normalize.
-(defvar math-normalize-a)
-
-(defun math-normalize-nonstandard ()
+(defun math-normalize-nonstandard (a)
(if (consp calc-simplify-mode)
(progn
(setq calc-simplify-mode 'none
- math-simplify-only (car-safe (cdr-safe math-normalize-a)))
+ math-simplify-only (car-safe (cdr-safe a)))
nil)
- (and (symbolp (car math-normalize-a))
+ (and (symbolp (car a))
(or (eq calc-simplify-mode 'none)
(and (eq calc-simplify-mode 'num)
- (let ((aptr (setq math-normalize-a
+ (let ((aptr (setq a
(cons
- (car math-normalize-a)
- (mapcar 'math-normalize
- (cdr math-normalize-a))))))
+ (car a)
+ (mapcar #'math-normalize
+ (cdr a))))))
(while (and aptr (math-constp (car aptr)))
(setq aptr (cdr aptr)))
aptr)))
- (cons (car math-normalize-a)
- (mapcar 'math-normalize (cdr math-normalize-a))))))
+ (cons (car a)
+ (mapcar #'math-normalize (cdr a))))))
;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
@@ -2469,12 +2432,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)))
@@ -2497,17 +2454,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))
@@ -2808,7 +2755,7 @@ If X is not an error form, return 1."
x)
(if (Math-primp x)
x
- (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
+ (cons (car x) (mapcar #'math-evaluate-expr-rec (cdr x))))))
x))
(defun math-any-floats (expr)
@@ -2822,9 +2769,10 @@ If X is not an error form, return 1."
(defvar math-mt-many nil)
(defvar math-mt-func nil)
-(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many)
- (or math-mt-many (setq math-mt-many 1000000))
- (math-map-tree-rec mmt-expr))
+(defun math-map-tree (func mmt-expr &optional many)
+ (let ((math-mt-func func)
+ (math-mt-many (or many 1000000)))
+ (math-map-tree-rec mmt-expr)))
(defun math-map-tree-rec (mmt-expr)
(or (= math-mt-many 0)
@@ -2842,7 +2790,7 @@ If X is not an error form, return 1."
(<= math-mt-many 0))
(setq mmt-done t)
(setq mmt-nextval (cons (car mmt-expr)
- (mapcar 'math-map-tree-rec
+ (mapcar #'math-map-tree-rec
(cdr mmt-expr))))
(if (equal mmt-nextval mmt-expr)
(setq mmt-done t)
@@ -2867,6 +2815,7 @@ If X is not an error form, return 1."
(defvar math-integral-cache)
(defmacro math-defintegral (funcs &rest code)
+ (declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
(mapcar #'(lambda (func)
@@ -2876,9 +2825,9 @@ If X is not an error form, return 1."
(list
#'(lambda (u) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
-(put 'math-defintegral 'lisp-indent-hook 1)
(defmacro math-defintegral-2 (funcs &rest code)
+ (declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
(mapcar #'(lambda (func)
@@ -2887,7 +2836,6 @@ If X is not an error form, return 1."
(get ',func 'math-integral-2)
(list #'(lambda (u v) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
-(put 'math-defintegral-2 'lisp-indent-hook 1)
(defvar var-IntegAfterRules 'calc-IntegAfterRules)
@@ -3017,13 +2965,13 @@ If X is not an error form, return 1."
;; C language hexadecimal notation
((and (eq calc-language 'c)
- (string-match "^0[xX]\\([0-9a-fA-F]+\\)$" s))
+ (string-match "^0[xX]\\([[:xdigit:]]+\\)$" s))
(let ((digs (math-match-substring s 1)))
(math-read-radix digs 16)))
;; Pascal language hexadecimal notation
((and (eq calc-language 'pascal)
- (string-match "^\\$\\([0-9a-fA-F]+\\)$" s))
+ (string-match "^\\$\\([[:xdigit:]]+\\)$" s))
(let ((digs (math-match-substring s 1)))
(math-read-radix digs 16)))
@@ -3097,9 +3045,16 @@ If X is not an error form, return 1."
;;; Expression parsing.
(defvar math-expr-data)
+(defvar math-exp-pos)
+(defvar math-exp-old-pos)
+(defvar math-exp-keep-spaces)
+(defvar math-exp-token)
+(defvar math-expr-data)
+(defvar math-exp-str)
-(defun math-read-expr (math-exp-str)
+(defun math-read-expr (str)
(let ((math-exp-pos 0)
+ (math-exp-str str)
(math-exp-old-pos 0)
(math-exp-keep-spaces nil)
math-exp-token math-expr-data)
@@ -3138,6 +3093,10 @@ If X is not an error form, return 1."
;;; They said it couldn't be done...
+(defvar math-read-big-baseline)
+(defvar math-read-big-h2)
+(defvar math-read-big-err-msg)
+
(defun math-read-big-expr (str)
(and (> (length calc-left-label) 0)
(string-match (concat "^" (regexp-quote calc-left-label)) str)
@@ -3179,6 +3138,8 @@ If X is not an error form, return 1."
'(error 0 "Syntax error"))
(math-read-expr str)))))
+(defvar math-rb-h2)
+
(defun math-read-big-bigp (math-read-big-lines)
(and (cdr math-read-big-lines)
(let ((matrix nil)
@@ -3438,16 +3399,10 @@ 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]
- (let ((str (cond ((= calc-number-radix 10)
- (math-format-bignum-decimal a))
- ((= calc-number-radix 2)
- (math-format-bignum-binary a))
- ((= calc-number-radix 8)
- (math-format-bignum-octal a))
- ((= calc-number-radix 16)
- (math-format-bignum-hex a))
- (t (math-format-bignum-radix a)))))
+(defun math--format-integer-fancy (a) ; [I]
+ (let ((str (if (= calc-number-radix 10)
+ (number-to-string a)
+ (math-format-radix a))))
(if calc-leading-zeros
(let* ((calc-internal-prec 6)
(digs (math-compute-max-digits (math-abs calc-word-size)
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index e521eaeaff2..7e8a8dcc9d0 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -37,13 +37,13 @@
(defun calc-time ()
(interactive)
(calc-wrapper
- (let ((time (current-time-string)))
+ (let ((time (decode-time nil nil 'integer))) ;; FIXME: Support subseconds.
(calc-enter-result 0 "time"
(list 'mod
(list 'hms
- (string-to-number (substring time 11 13))
- (string-to-number (substring time 14 16))
- (string-to-number (substring time 17 19)))
+ (decoded-time-hour time)
+ (decoded-time-minute time)
+ (decoded-time-second time))
(list 'hms 24 0 0))))))
(defun calc-to-hms (arg)
@@ -62,7 +62,7 @@
(defun calc-hms-notation (fmt)
- (interactive "sHours-minutes-seconds format (hms, @ \\=' \", etc.): ")
+ (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ")
(calc-wrapper
(if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,; ]*\\)\\([^,; ]\\)\\'" fmt)
(progn
@@ -499,7 +499,8 @@ in the Gregorian calendar and the remaining part determines the time."
(math-add (math-float date)
(math-div (math-add (+ (* (nth 3 dt) 3600)
(* (nth 4 dt) 60))
- (nth 5 dt))
+ ;; FIXME: Support subseconds.
+ (time-convert (nth 5 dt) 'integer))
'(float 864 2)))
date)))
@@ -525,7 +526,7 @@ in the Gregorian calendar and the remaining part determines the time."
(defun math-this-year ()
- (nth 5 (decode-time)))
+ (decoded-time-year (decode-time)))
(defun math-leap-year-p (year &optional julian)
"Non-nil if YEAR is a leap year.
@@ -587,29 +588,15 @@ A DT is a list of the form (YEAR MONTH DAY)."
"Return the DATE of the day given by the Gregorian day YEAR MONTH DAY.
Recall that DATE is the number of days since December 31, -1
in the Gregorian calendar."
- (if (eq year 0) (setq year -1))
- (let ((yearm1 (math-sub year 1)))
- (math-sub
- ;; Add the number of days of the year and the numbers of days
- ;; in the previous years (leap year days to be added separately)
- (math-add (math-day-in-year year month day)
- (math-add (math-mul 365 yearm1)
- ;; Add the number of Julian leap years
- (if (math-posp year)
- (math-quotient yearm1 4)
- (math-sub 365
- (math-quotient (math-sub 3 year)
- 4)))))
- ;; Subtract the number of Julian leap years which are not
- ;; Gregorian leap years. In C=4N+r centuries, there will
- ;; be 3N+r of these days. The following will compute
- ;; 3N+r.
- (let* ((correction (math-mul (math-quotient yearm1 100) 3))
- (res (math-idivmod correction 4)))
- (math-add (if (= (cdr res) 0)
- 0
- 1)
- (car res))))))
+ (when (zerop year) ; Year -1 precedes year 1.
+ (setq year -1))
+ (let* ((y (if (> year 0) year (+ year 1))) ; Astronomical year (with 0).
+ (y1 (- y 1))) ; Previous year.
+ (+ (* y1 365) ; Days up to the previous year...
+ (floor y1 4) ; ... including leap days.
+ (- (floor y1 100))
+ (floor y1 400)
+ (math-day-in-year year month day))))
(defun math-absolute-from-julian-dt (year month day)
"Return the DATE of the day given by the Julian day YEAR MONTH DAY.
@@ -620,7 +607,7 @@ in the Gregorian calendar."
(math-sub
;; Add the number of days of the year and the numbers of days
;; in the previous years (leap year days to be added separately)
- (math-add (math-day-in-year year month day)
+ (math-add (math-day-in-year year month day t)
(math-add (math-mul 365 yearm1)
;; Add the number of Julian leap years
(if (math-posp year)
@@ -714,11 +701,11 @@ in the Gregorian calendar."
(setcdr math-fd-dt nil))
fmt))))
-(defconst math-julian-date-beginning '(float 17214225 -1)
+(defconst math-julian-date-beginning '(float 17214245 -1)
"The beginning of the Julian date calendar,
as measured in the number of days before December 31, 1 BC (Gregorian).")
-(defconst math-julian-date-beginning-int 1721423
+(defconst math-julian-date-beginning-int 1721425
"The beginning of the Julian date calendar,
as measured in the integer number of days before December 31, 1 BC (Gregorian).")
@@ -1341,16 +1328,20 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(math-parse-iso-date-validate isoyear isoweek isoweekday hour minute second)))))
(defun calcFunc-now (&optional zone)
- (let ((date (let ((calc-date-format nil))
- (math-parse-date (current-time-string)))))
- (if (consp date)
- (if zone
- (math-add date (math-div (math-sub (calcFunc-tzone nil date)
- (calcFunc-tzone zone date))
- '(float 864 2)))
- date)
- (calc-record-why "*Unable to interpret current date from system")
- (append (list 'calcFunc-now) (and zone (list zone))))))
+ ;; FIXME: Support subseconds.
+ (let ((date (let ((now (decode-time nil nil 'integer)))
+ (list 'date (math-dt-to-date
+ (list (decoded-time-year now)
+ (decoded-time-month now)
+ (decoded-time-day now)
+ (decoded-time-hour now)
+ (decoded-time-minute now)
+ (decoded-time-second now)))))))
+ (if zone
+ (math-add date (math-div (math-sub (calcFunc-tzone nil date)
+ (calcFunc-tzone zone date))
+ '(float 864 2)))
+ date)))
(defun calcFunc-year (date)
(car (math-date-to-dt date)))
@@ -1475,9 +1466,6 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(defvar var-TimeZone nil)
-;; From cal-dst
-(defvar calendar-current-time-zone-cache)
-
(defvar math-calendar-tzinfo
nil
"Information about the timezone, retrieved from the calendar.")
@@ -1490,11 +1478,9 @@ second, the number of seconds offset for daylight savings."
(if math-calendar-tzinfo
math-calendar-tzinfo
(require 'cal-dst)
- (let ((tzinfo (progn
- (calendar-current-time-zone)
- calendar-current-time-zone-cache)))
+ (let ((tzinfo (calendar-current-time-zone)))
(setq math-calendar-tzinfo
- (list (* 60 (abs (nth 0 tzinfo)))
+ (list (* 60 (- (nth 0 tzinfo)))
(* 60 (nth 1 tzinfo)))))))
(defun calcFunc-tzone (&optional zone date)
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index a9d153961d8..17e79354835 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -27,6 +27,7 @@
(require 'calc-ext)
(require 'calc-macs)
+(require 'cl-lib)
(defun calc-inc-gamma (arg)
(interactive "P")
@@ -177,7 +178,7 @@
'(float 0 0)
2)))))))
-(defun math-gamma-series (sum x xinvsqr oterm n)
+(defun math-gamma-series (sum x xinvsqr _oterm n)
(math-working "gamma" sum)
(let* ((bn (math-bernoulli-number n))
(term (math-mul (math-div-float (math-float (nth 1 bn))
@@ -525,7 +526,7 @@
bj))
(t
(if (Math-lessp 100 v) (math-reject-arg v 'range))
- (let* ((j (logior (+ v (math-isqrt-small (* 40 v))) 1))
+ (let* ((j (logior (+ v (cl-isqrt (* 40 v))) 1))
(two-over-x (math-div 2 x))
(jsum nil)
(bjp '(float 0 0))
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 317f403ead6..56f11c67119 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1121,7 +1121,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(eval (intern
(concat "var-"
(save-excursion
- (re-search-backward ":\\(.*\\)\\}")
+ (re-search-backward ":\\(.*\\)}")
(match-string 1))))))
(error nil)))
(if yerr
@@ -1186,7 +1186,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(or (looking-at "{")
(error "Can't hide this curve (wrong format)"))
(forward-char 1)
- (if (looking-at "*")
+ (if (looking-at "\\*")
(if (or (null flag) (<= (prefix-numeric-value flag) 0))
(delete-char 1))
(if (or (null flag) (> (prefix-numeric-value flag) 0))
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index cf7574e7385..3b8bfda4a02 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -77,14 +77,14 @@ C-w Describe how there is no warranty for Calc."
(select-window (get-buffer-window "*Help*"))
(while (progn
(message "Calc Help options: Help, Info, ... press SPC, DEL to scroll, C-g to cancel")
- (memq (car (setq key (calc-read-key t)))
+ (memq (setq key (read-event))
'(? ?\C-h ?\C-? ?\C-v ?\M-v)))
(condition-case err
- (if (memq (car key) '(? ?\C-v))
+ (if (memq key '(? ?\C-v))
(scroll-up)
(scroll-down))
(error (beep)))))
- (calc-unread-command (cdr key))
+ (calc-unread-command key)
(calc-help-prefix nil))
(let ((calc-dispatch-help t))
(calc-help-prefix arg))))
@@ -172,7 +172,7 @@ C-w Describe how there is no warranty for Calc."
(setq desc (concat "M-" (substring desc 4))))
(while (string-match "^M-# \\(ESC \\|C-\\)" desc)
(setq desc (concat "M-# " (substring desc (match-end 0)))))
- (if (string-match "\\(DEL\\|\\LFD\\|RET\\|SPC\\|TAB\\)" desc)
+ (if (string-match "\\(DEL\\|LFD\\|RET\\|SPC\\|TAB\\)" desc)
(setq desc (replace-match "<\\&>" nil nil desc)))
(if briefly
(let ((msg (with-current-buffer (get-buffer-create "*Calc Summary*")
@@ -255,8 +255,8 @@ C-w Describe how there is no warranty for Calc."
msg
(if (equal notes "") ""
(format " (?=notes %s)" notes)))
- (let ((key (calc-read-key t)))
- (if (eq (car key) ??)
+ (let ((key (read-event)))
+ (if (eq key ??)
(if (equal notes "")
(message "No notes for this command")
(while (string-match "," notes)
@@ -280,7 +280,7 @@ C-w Describe how there is no warranty for Calc."
(princ (buffer-substring pt (point))))
(setq notes (cdr notes)))
(help-print-return-message)))
- (calc-unread-command (cdr key)))))
+ (calc-unread-command key))))
(if (or (null defn) (integerp defn))
(message "%s is undefined" desc)
(message "%s runs the command %s"
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 3f55fb15d56..4a9771d7438 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -243,7 +243,7 @@
(put 'pascal 'math-lang-read-symbol
'((?\$
(eq (string-match
- "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Zα-ωΑ-Ω]\\)"
+ "\\(\\$[[:xdigit:]]+\\)\\($\\|[^0-9a-zA-Zα-ωΑ-Ω]\\)"
math-exp-str math-exp-pos)
math-exp-pos)
(setq math-exp-token 'number
@@ -753,8 +753,8 @@
right " \\right)"))
((and (eq (aref func 0) ?\\)
(not (or
- (string-match "\\hbox{" func)
- (string-match "\\text{" func)))
+ (string-match "\\\\hbox{" func)
+ (string-match "\\\\text{" func)))
(= (length a) 2)
(or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *))))
@@ -1127,7 +1127,7 @@
(math-read-token)))))))
(put 'eqn 'math-lang-read
- '((eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
+ '((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^"
math-exp-str math-exp-pos)
math-exp-pos)
(progn
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 033f6e9080c..aadfabbd21e 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -1,4 +1,4 @@
-;;; calc-macs.el --- important macros for Calc
+;;; calc-macs.el --- important macros for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2019 Free Software Foundation, Inc.
@@ -29,7 +29,6 @@
(declare-function math-looks-negp "calc-misc" (a))
(declare-function math-posp "calc-misc" (a))
(declare-function math-compare "calc-ext" (a b))
-(declare-function math-bignum "calc" (a))
(declare-function math-compare-bignum "calc-ext" (a b))
@@ -70,29 +69,22 @@
;;; Faster in-line version zerop, normalized values only.
(defsubst Math-zerop (a) ; [P N]
(if (consp a)
- (and (not (memq (car a) '(bigpos bigneg)))
- (if (eq (car a) 'float)
- (eq (nth 1 a) 0)
- (math-zerop a)))
+ (if (eq (car a) 'float)
+ (eq (nth 1 a) 0)
+ (math-zerop a))
(eq a 0)))
(defsubst Math-integer-negp (a)
- (if (consp a)
- (eq (car a) 'bigneg)
- (< a 0)))
+ (and (integerp a) (< a 0)))
(defsubst Math-integer-posp (a)
- (if (consp a)
- (eq (car a) 'bigpos)
- (> a 0)))
+ (and (integerp a) (> a 0)))
(defsubst Math-negp (a)
(if (consp a)
- (or (eq (car a) 'bigneg)
- (and (not (eq (car a) 'bigpos))
- (if (memq (car a) '(frac float))
- (Math-integer-negp (nth 1 a))
- (math-negp a))))
+ (if (memq (car a) '(frac float))
+ (Math-integer-negp (nth 1 a))
+ (math-negp a))
(< a 0)))
(defsubst Math-looks-negp (a) ; [P x] [Public]
@@ -104,44 +96,38 @@
(defsubst Math-posp (a)
(if (consp a)
- (or (eq (car a) 'bigpos)
- (and (not (eq (car a) 'bigneg))
- (if (memq (car a) '(frac float))
- (Math-integer-posp (nth 1 a))
- (math-posp a))))
+ (if (memq (car a) '(frac float))
+ (Math-integer-posp (nth 1 a))
+ (math-posp a))
(> a 0)))
-(defsubst Math-integerp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg))))
+(defalias 'Math-integerp #'integerp)
(defsubst Math-natnump (a)
- (if (consp a)
- (eq (car a) 'bigpos)
- (>= a 0)))
+ (and (integerp a) (>= a 0)))
(defsubst Math-ratp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac))))
+ (eq (car a) 'frac)))
(defsubst Math-realp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float))))
+ (memq (car a) '(frac float))))
(defsubst Math-anglep (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float hms))))
+ (memq (car a) '(frac float hms))))
(defsubst Math-numberp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar))))
+ (memq (car a) '(frac float cplx polar))))
(defsubst Math-scalarp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar hms))))
+ (memq (car a) '(frac float cplx polar hms))))
(defsubst Math-vectorp (a)
- (and (consp a) (eq (car a) 'vec)))
+ (eq (car-safe a) 'vec))
(defsubst Math-messy-integerp (a)
(and (consp a)
@@ -151,21 +137,17 @@
(defsubst Math-objectp (a) ; [Public]
(or (not (consp a))
(memq (car a)
- '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))
+ '(frac float cplx polar hms date sdev intv mod))))
(defsubst Math-objvecp (a) ; [Public]
(or (not (consp a))
(memq (car a)
- '(bigpos bigneg frac float cplx polar hms date
- sdev intv mod vec))))
+ '(frac float cplx polar hms date
+ sdev intv mod vec))))
;;; Compute the negative of A. [O O; o o] [Public]
(defsubst Math-integer-neg (a)
- (if (consp a)
- (if (eq (car a) 'bigpos)
- (cons 'bigneg (cdr a))
- (cons 'bigpos (cdr a)))
- (- a)))
+ (- a))
(defsubst Math-equal (a b)
(= (math-compare a b) 0))
@@ -175,20 +157,14 @@
(defsubst Math-primp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar
- hms date mod var))))
+ (memq (car a) '(frac float cplx polar
+ hms date mod var))))
(defsubst Math-num-integerp (a)
(or (not (consp a))
- (memq (car a) '(bigpos bigneg))
(and (eq (car a) 'float)
(>= (nth 2 a) 0))))
-(defsubst Math-bignum-test (a) ; [B N; B s; b b]
- (if (consp a)
- a
- (math-bignum a)))
-
(defsubst Math-equal-int (a b)
(or (eq a b)
(and (consp a)
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 50c8758ace2..4ca8515989b 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -25,6 +25,8 @@
;; This file is autoloaded from calc-ext.el.
+
+(require 'cl-lib)
(require 'calc-ext)
(require 'calc-macs)
@@ -95,8 +97,7 @@ If this can't be done, return NIL."
(and
(<= calc-internal-prec math-emacs-precision)
(math-realp x)
- (let* ((fx (math-float x))
- (xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
+ (let* ((xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
(and (<= math-smallest-emacs-expt xpon)
(<= xpon math-largest-emacs-expt)
(condition-case nil
@@ -371,51 +372,15 @@ If this can't be done, return NIL."
;;; with an overestimate always works, even using truncating integer division!
(defun math-isqrt (a)
(cond ((Math-zerop a) a)
- ((not (math-natnump a))
+ ((not (natnump a))
(math-reject-arg a 'natnump))
- ((integerp a)
- (math-isqrt-small a))
- (t
- (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a))))))))
+ (t (cl-isqrt a))))
(defun calcFunc-isqrt (a)
(if (math-realp a)
(math-isqrt (math-floor a))
(math-floor (math-sqrt a))))
-
-;;; This returns (flag . result) where the flag is t if A is a perfect square.
-(defun math-isqrt-bignum (a) ; [P.l L]
- (let ((len (length a)))
- (if (= (% len 2) 0)
- (let* ((top (nthcdr (- len 2) a)))
- (math-isqrt-bignum-iter
- a
- (math-scale-bignum-digit-size
- (math-bignum-big
- (1+ (math-isqrt-small
- (+ (* (nth 1 top) math-bignum-digit-size) (car top)))))
- (1- (/ len 2)))))
- (let* ((top (nth (1- len) a)))
- (math-isqrt-bignum-iter
- a
- (math-scale-bignum-digit-size
- (list (1+ (math-isqrt-small top)))
- (/ len 2)))))))
-
-(defun math-isqrt-bignum-iter (a guess) ; [l L l]
- (math-working "isqrt" (cons 'bigpos guess))
- (let* ((q (math-div-bignum a guess))
- (s (math-add-bignum (car q) guess))
- (g2 (math-div2-bignum s))
- (comp (math-compare-bignum g2 guess)))
- (if (< comp 0)
- (math-isqrt-bignum-iter a g2)
- (cons (and (= comp 0)
- (math-zerop-bignum (cdr q))
- (= (% (car s) 2) 0))
- guess))))
-
(defun math-zerop-bignum (a)
(and (eq (car a) 0)
(progn
@@ -428,19 +393,6 @@ If this can't be done, return NIL."
n (1- n)))
a)
-(defun math-isqrt-small (a) ; A > 0. [S S]
- (let ((g (cond ((>= a 1000000) 10000)
- ((>= a 10000) 1000)
- ((>= a 100) 100)
- (t 10)))
- g2)
- (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
- (setq g g2))
- g))
-
-
-
-
;;; Compute the square root of a number.
;;; [T N] if possible, else [F N] if possible, else [C N]. [Public]
(defun math-sqrt (a)
@@ -449,32 +401,24 @@ If this can't be done, return NIL."
(and (math-known-nonposp a)
(math-imaginary (math-sqrt (math-neg a))))
(and (integerp a)
- (let ((sqrt (math-isqrt-small a)))
+ (let ((sqrt (cl-isqrt a)))
(if (= (* sqrt sqrt) a)
sqrt
(if calc-symbolic-mode
(list 'calcFunc-sqrt a)
(math-sqrt-float (math-float a) (math-float sqrt))))))
- (and (eq (car-safe a) 'bigpos)
- (let* ((res (math-isqrt-bignum (cdr a)))
- (sqrt (math-normalize (cons 'bigpos (cdr res)))))
- (if (car res)
- sqrt
- (if calc-symbolic-mode
- (list 'calcFunc-sqrt a)
- (math-sqrt-float (math-float a) (math-float sqrt))))))
(and (eq (car-safe a) 'frac)
- (let* ((num-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 1 a)))))
- (num-sqrt (math-normalize (cons 'bigpos (cdr num-res))))
- (den-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 2 a)))))
- (den-sqrt (math-normalize (cons 'bigpos (cdr den-res)))))
- (if (and (car num-res) (car den-res))
+ (let* ((num-sqrt (cl-isqrt (nth 1 a)))
+ (num-exact (= (* num-sqrt num-sqrt) (nth 1 a)))
+ (den-sqrt (cl-isqrt (nth 2 a)))
+ (den-exact (= (* den-sqrt den-sqrt) (nth 2 a))))
+ (if (and num-exact den-exact)
(list 'frac num-sqrt den-sqrt)
(if calc-symbolic-mode
- (if (or (car num-res) (car den-res))
- (math-div (if (car num-res)
+ (if (or num-exact den-exact)
+ (math-div (if num-exact
num-sqrt (list 'calcFunc-sqrt (nth 1 a)))
- (if (car den-res)
+ (if den-exact
den-sqrt (list 'calcFunc-sqrt (nth 2 a))))
(list 'calcFunc-sqrt a))
(math-sqrt-float (math-float a)
@@ -482,12 +426,9 @@ If this can't be done, return NIL."
(and (eq (car-safe a) 'float)
(if calc-symbolic-mode
(if (= (% (nth 2 a) 2) 0)
- (let ((res (math-isqrt-bignum
- (cdr (Math-bignum-test (nth 1 a))))))
- (if (car res)
- (math-make-float (math-normalize
- (cons 'bigpos (cdr res)))
- (/ (nth 2 a) 2))
+ (let ((res (cl-isqrt (nth 1 a))))
+ (if (= (* res res) (nth 1 a))
+ (math-make-float res (/ (nth 2 a) 2))
(signal 'inexact-result nil)))
(signal 'inexact-result nil))
(math-sqrt-float a)))
@@ -551,7 +492,7 @@ If this can't be done, return NIL."
(if (null guess)
(let ((ldiff (- (math-numdigs (nth 1 a)) 6)))
(or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff)))
- (setq guess (math-make-float (math-isqrt-small
+ (setq guess (math-make-float (cl-isqrt
(math-scale-int (nth 1 a) (- ldiff)))
(/ (+ (nth 2 a) ldiff) 2)))))
(math-sqrt-float-iter a guess)))))
@@ -1697,7 +1638,7 @@ If this can't be done, return NIL."
(while (not (Math-lessp x pow))
(setq pows (cons pow pows)
pow (math-sqr pow)))
- (setq n (lsh 1 (1- (length pows)))
+ (setq n (ash 1 (1- (length pows)))
sum n
pow (car pows))
(while (and (setq pows (cdr pows))
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index aedb68726a5..d86b117c1f1 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -27,6 +27,7 @@
(require 'calc)
(require 'calc-macs)
+(require 'cl-lib)
;; Declare functions which are defined elsewhere.
(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive))
@@ -116,14 +117,14 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
(while (progn
(message "Calc options: Calc, Keypad, ... %s"
"press SPC, DEL to scroll, C-g to cancel")
- (memq (car (setq key (calc-read-key t)))
+ (memq (setq key (read-event))
'(? ?\C-h ?\C-? ?\C-v ?\M-v)))
- (condition-case err
- (if (memq (car key) '(? ?\C-v))
+ (condition-case nil
+ (if (memq key '(? ?\C-v))
(scroll-up)
(scroll-down))
(error (beep))))
- (calc-unread-command (cdr key))))))
+ (calc-unread-command key)))))
(calc-do-dispatch nil))
(let ((calc-dispatch-help t))
(calc-do-dispatch arg))))
@@ -658,10 +659,7 @@ loaded and the keystroke automatically re-typed."
;;;###autoload
(defun math-zerop (a)
(if (consp a)
- (cond ((memq (car a) '(bigpos bigneg))
- (while (eq (car (setq a (cdr a))) 0))
- (null a))
- ((memq (car a) '(frac float polar mod))
+ (cond ((memq (car a) '(frac float polar mod))
(math-zerop (nth 1 a)))
((eq (car a) 'cplx)
(and (math-zerop (nth 1 a)) (math-zerop (nth 2 a))))
@@ -677,9 +675,7 @@ loaded and the keystroke automatically re-typed."
;;;###autoload
(defun math-negp (a)
(if (consp a)
- (cond ((eq (car a) 'bigpos) nil)
- ((eq (car a) 'bigneg) (cdr a))
- ((memq (car a) '(float frac))
+ (cond ((memq (car a) '(float frac))
(Math-integer-negp (nth 1 a)))
((eq (car a) 'hms)
(if (math-zerop (nth 1 a))
@@ -712,9 +708,7 @@ loaded and the keystroke automatically re-typed."
;;;###autoload
(defun math-posp (a)
(if (consp a)
- (cond ((eq (car a) 'bigpos) (cdr a))
- ((eq (car a) 'bigneg) nil)
- ((memq (car a) '(float frac))
+ (cond ((memq (car a) '(float frac))
(Math-integer-posp (nth 1 a)))
((eq (car a) 'hms)
(if (math-zerop (nth 1 a))
@@ -734,36 +728,20 @@ loaded and the keystroke automatically re-typed."
(> a 0)))
;;;###autoload
-(defalias 'math-fixnump 'integerp)
+(defalias 'math-fixnump #'fixnump)
;;;###autoload
-(defalias 'math-fixnatnump 'natnump)
-
+(defun math-fixnatnump (x) (and (fixnump x) (natnump x)))
;; True if A is an even integer. [P R R] [Public]
;;;###autoload
(defun math-evenp (a)
- (if (consp a)
- (and (memq (car a) '(bigpos bigneg))
- (= (% (nth 1 a) 2) 0))
- (= (% a 2) 0)))
+ (and (integerp a) (cl-evenp a)))
;; Compute A / 2, for small or big integer A. [I i]
;; If A is negative, type of truncation is undefined.
;;;###autoload
(defun math-div2 (a)
- (if (consp a)
- (if (cdr a)
- (math-normalize (cons (car a) (math-div2-bignum (cdr a))))
- 0)
- (/ a 2)))
-
-;;;###autoload
-(defun math-div2-bignum (a) ; [l l]
- (if (cdr a)
- (cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) (/ math-bignum-digit-size 2)))
- (math-div2-bignum (cdr a)))
- (list (/ (car a) 2))))
-
+ (/ a 2))
;; Reject an argument to a calculator function. [Public]
;;;###autoload
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index 7e3e423868c..5fba85e059d 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -1,4 +1,4 @@
-;;; calc-poly.el --- polynomial functions for Calc
+;;; calc-poly.el --- polynomial functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2019 Free Software Foundation, Inc.
@@ -177,8 +177,8 @@
(math-add (car res) (math-div (cdr res) pd))))
-;;; Multiply two terms, expanding out products of sums.
(defun math-mul-thru (lhs rhs)
+ "Multiply two terms, expanding out products of sums."
(if (memq (car-safe lhs) '(+ -))
(list (car lhs)
(math-mul-thru (nth 1 lhs) rhs)
@@ -197,8 +197,8 @@
(math-div num den)))
-;;; Sort the terms of a sum into canonical order.
(defun math-sort-terms (expr)
+ "Sort the terms of a sum into canonical order."
(if (memq (car-safe expr) '(+ -))
(math-list-to-sum
(sort (math-sum-to-list expr)
@@ -223,8 +223,8 @@
(math-sum-to-list (nth 2 tree) (not neg))))
(t (list (cons tree neg)))))
-;;; Check if the polynomial coefficients are modulo forms.
(defun math-poly-modulus (expr &optional expr2)
+ "Check if the polynomial coefficients are modulo forms."
(or (math-poly-modulus-rec expr)
(and expr2 (math-poly-modulus-rec expr2))
1))
@@ -237,12 +237,13 @@
(math-poly-modulus-rec (nth 2 expr))))))
-;;; Divide two polynomials. Return (quotient . remainder).
(defvar math-poly-div-base nil)
-(defun math-poly-div (u v &optional math-poly-div-base)
- (if math-poly-div-base
- (math-do-poly-div u v)
- (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v))))
+(defun math-poly-div (u v &optional div-base)
+ "Divide two polynomials. Return (quotient . remainder)."
+ (let ((math-poly-div-base div-base))
+ (if div-base
+ (math-do-poly-div u v)
+ (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))))
(defun math-poly-div-exact (u v &optional base)
(let ((res (math-poly-div u v base)))
@@ -308,8 +309,8 @@
(math-div (math-build-polynomial-expr (cdr res) base)
v)))))))
-;;; Divide two polynomials in coefficient-list form. Return (quot . rem).
(defun math-poly-div-coefs (u v)
+ "Divide two polynomials in coefficient-list form. Return (quot . rem)."
(cond ((null v) (math-reject-arg nil "Division by zero"))
((< (length u) (length v)) (cons nil u))
((cdr u)
@@ -334,9 +335,9 @@
(cons (list (math-poly-div-rec (car u) (car v)))
nil))))
-;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.)
-;;; This returns only the remainder from the pseudo-division.
(defun math-poly-pseudo-div (u v)
+ "Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.)
+This returns only the remainder from the pseudo-division."
(cond ((null v) nil)
((< (length u) (length v)) u)
((or (cdr u) (cdr v))
@@ -359,8 +360,8 @@
(nreverse (mapcar 'math-simplify urev))))
(t nil)))
-;;; Compute the GCD of two multivariate polynomials.
(defun math-poly-gcd (u v)
+ "Compute the GCD of two multivariate polynomials."
(cond ((Math-equal u v) u)
((math-constp u)
(if (Math-zerop u)
@@ -423,7 +424,7 @@
(defun math-poly-gcd-coefs (u v)
(let ((d (math-poly-gcd (math-poly-gcd-list u)
(math-poly-gcd-list v)))
- (g 1) (h 1) (z 0) hh r delta ghd)
+ (g 1) (h 1) (z 0) r delta)
(while (and u v (Math-zerop (car u)) (Math-zerop (car v)))
(setq u (cdr u) v (cdr v) z (1+ z)))
(or (eq d 1)
@@ -452,8 +453,8 @@
v))
-;;; Return true if is a factor containing no sums or quotients.
(defun math-atomic-factorp (expr)
+ "Return true if is a factor containing no sums or quotients."
(cond ((eq (car-safe expr) '*)
(and (math-atomic-factorp (nth 1 expr))
(math-atomic-factorp (nth 2 expr))))
@@ -463,14 +464,13 @@
(math-atomic-factorp (nth 1 expr)))
(t t)))
-;;; Find a suitable base for dividing a by b.
-;;; The base must exist in both expressions.
-;;; The degree in the numerator must be higher or equal than the
-;;; degree in the denominator.
-;;; If the above conditions are not met the quotient is just a remainder.
-;;; Return nil if this is the case.
-
(defun math-poly-div-base (a b)
+ "Find a suitable base for dividing a by b.
+The base must exist in both expressions.
+The degree in the numerator must be higher or equal than the
+degree in the denominator.
+If the above conditions are not met the quotient is just a remainder.
+Return nil if this is the case."
(let (a-base b-base)
(and (setq a-base (math-total-polynomial-base a))
(setq b-base (math-total-polynomial-base b))
@@ -482,12 +482,11 @@
(throw 'return (car (car a-base))))))
(setq a-base (cdr a-base)))))))
-;;; Same as above but for gcd algorithm.
-;;; Here there is no requirement that degree(a) > degree(b).
-;;; Take the base that has the highest degree considering both a and b.
-;;; ("a^20+b^21+x^3+a+b", "a+b^2+x^5+a^22+b^10") --> (a 22)
-
(defun math-poly-gcd-base (a b)
+ "Same as `math-poly-div-base' but for gcd algorithm.
+Here there is no requirement that degree(a) > degree(b).
+Take the base that has the highest degree considering both a and b.
+ (\"a^20+b^21+x^3+a+b\", \"a+b^2+x^5+a^22+b^10\") --> (a 22)"
(let (a-base b-base)
(and (setq a-base (math-total-polynomial-base a))
(setq b-base (math-total-polynomial-base b))
@@ -501,8 +500,8 @@
(throw 'return (car (car b-base)))
(setq b-base (cdr b-base)))))))))
-;;; Sort a list of polynomial bases.
(defun math-sort-poly-base-list (lst)
+ "Sort a list of polynomial bases."
(sort lst (function (lambda (a b)
(or (> (nth 1 a) (nth 1 b))
(and (= (nth 1 a) (nth 1 b))
@@ -511,21 +510,18 @@
;;; Given an expression find all variables that are polynomial bases.
;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
-;; The variable math-poly-base-total-base is local to
-;; math-total-polynomial-base, but is used by math-polynomial-p1,
-;; which is called by math-total-polynomial-base.
+;; The variable math-poly-base-total-base and math-poly-base-top-expr are local
+;; to math-total-polynomial-base, but used by math-polynomial-p1, which is
+;; called by math-total-polynomial-base.
(defvar math-poly-base-total-base)
+(defvar math-poly-base-top-expr)
(defun math-total-polynomial-base (expr)
- (let ((math-poly-base-total-base nil))
- (math-polynomial-base expr 'math-polynomial-p1)
+ (let ((math-poly-base-total-base nil)
+ (math-poly-base-top-expr expr))
+ (math-polynomial-base expr #'math-polynomial-p1)
(math-sort-poly-base-list math-poly-base-total-base)))
-;; The variable math-poly-base-top-expr is local to math-polynomial-base
-;; in calc-alg.el, but is used by math-polynomial-p1 which is called
-;; by math-polynomial-base.
-(defvar math-poly-base-top-expr)
-
(defun math-polynomial-p1 (subexpr)
(or (assoc subexpr math-poly-base-total-base)
(memq (car subexpr) '(+ - * / neg))
@@ -554,28 +550,30 @@
;; called (indirectly) by calcFunc-factors and calcFunc-factor.
(defvar math-to-list)
-(defun calcFunc-factors (math-fact-expr &optional var)
+(defun calcFunc-factors (expr &optional var)
(let ((math-factored-vars (if var t nil))
(math-to-list t)
(calc-prefer-frac t))
(or var
- (setq var (math-polynomial-base math-fact-expr)))
+ (setq var (math-polynomial-base expr)))
(let ((res (math-factor-finish
- (or (catch 'factor (math-factor-expr-try var))
- math-fact-expr))))
+ (or (catch 'factor
+ (let ((math-fact-expr expr)) (math-factor-expr-try var)))
+ expr))))
(math-simplify (if (math-vectorp res)
res
(list 'vec (list 'vec res 1)))))))
-(defun calcFunc-factor (math-fact-expr &optional var)
+(defun calcFunc-factor (expr &optional var)
(let ((math-factored-vars nil)
(math-to-list nil)
(calc-prefer-frac t))
(math-simplify (math-factor-finish
(if var
- (let ((math-factored-vars t))
- (or (catch 'factor (math-factor-expr-try var)) math-fact-expr))
- (math-factor-expr math-fact-expr))))))
+ (let ((math-factored-vars t)
+ (math-fact-expr expr))
+ (or (catch 'factor (math-factor-expr-try var)) expr))
+ (math-factor-expr expr))))))
(defun math-factor-finish (x)
(if (Math-primp x)
@@ -589,18 +587,19 @@
(list 'calcFunc-Fac-Prot x)
x))
-(defun math-factor-expr (math-fact-expr)
- (cond ((eq math-factored-vars t) math-fact-expr)
- ((or (memq (car-safe math-fact-expr) '(* / ^ neg))
- (assq (car-safe math-fact-expr) calc-tweak-eqn-table))
- (cons (car math-fact-expr) (mapcar 'math-factor-expr (cdr math-fact-expr))))
- ((memq (car-safe math-fact-expr) '(+ -))
+(defun math-factor-expr (expr)
+ (cond ((eq math-factored-vars t) expr)
+ ((or (memq (car-safe expr) '(* / ^ neg))
+ (assq (car-safe expr) calc-tweak-eqn-table))
+ (cons (car expr) (mapcar 'math-factor-expr (cdr expr))))
+ ((memq (car-safe expr) '(+ -))
(let* ((math-factored-vars math-factored-vars)
- (y (catch 'factor (math-factor-expr-part math-fact-expr))))
+ (y (catch 'factor (let ((math-fact-expr expr))
+ (math-factor-expr-part expr)))))
(if y
(math-factor-expr y)
- math-fact-expr)))
- (t math-fact-expr)))
+ expr)))
+ (t expr)))
(defun math-factor-expr-part (x) ; uses "expr"
(if (memq (car-safe x) '(+ - * / ^ neg))
@@ -616,20 +615,20 @@
;; used by math-factor-poly-coefs, which is called by math-factor-expr-try.
(defvar math-fet-x)
-(defun math-factor-expr-try (math-fet-x)
+(defun math-factor-expr-try (x)
(if (eq (car-safe math-fact-expr) '*)
(let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr)))
- (math-factor-expr-try math-fet-x))))
+ (math-factor-expr-try x))))
(res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr)))
- (math-factor-expr-try math-fet-x)))))
+ (math-factor-expr-try x)))))
(and (or res1 res2)
(throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1
(or res2 (nth 2 math-fact-expr))))))
- (let* ((p (math-is-polynomial math-fact-expr math-fet-x 30 'gen))
+ (let* ((p (math-is-polynomial math-fact-expr x 30 'gen))
(math-poly-modulus (math-poly-modulus math-fact-expr))
res)
(and (cdr p)
- (setq res (math-factor-poly-coefs p))
+ (setq res (let ((math-fet-x x)) (math-factor-poly-coefs p)))
(throw 'factor res)))))
(defun math-accum-factors (fac pow facs)
@@ -735,7 +734,6 @@
(let ((roots (car t1))
(csign (if (math-negp (nth (1- (length p)) p)) -1 1))
(expr 1)
- (unfac (nth 1 t1))
(scale (nth 2 t1)))
(while roots
(let ((coef0 (car (car roots)))
@@ -1108,7 +1106,7 @@ If no partial fraction representation can be found, return nil."
(t expr)))
(defun calcFunc-expand (expr &optional many)
- (math-normalize (math-map-tree 'math-expand-term expr many)))
+ (math-normalize (math-map-tree #'math-expand-term expr many)))
(defun math-expand-power (x n &optional var else-nil)
(or (and (natnump n)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index ba8efd43b8e..37e10e8dfac 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1097,7 +1097,7 @@ Redefine the corresponding command."
(or func (setq func (and cmd (symbolp cmd) (fboundp cmd) cmd)))
(if (get func 'math-compose-forms)
(let ((pt (point)))
- (insert "(put '" (symbol-name cmd)
+ (insert "(put '" (symbol-name func)
" 'math-compose-forms '"
(prin1-to-string (get func 'math-compose-forms))
")\n")
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 589a776c413..3987c129c23 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -405,8 +405,8 @@
sconst))))
(if var
(let ((msg (calc-store-value var value "")))
- (message (concat "Special constant \"%s\" copied to \"%s\"" msg)
- sconst (calc-var-name var)))))))))
+ (message "Special constant \"%s\" copied to \"%s\"%s"
+ sconst (calc-var-name var) msg))))))))
(defun calc-copy-variable (&optional var1 var2)
(interactive)
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 8794d1f3c67..86bebe6a9ed 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -1,4 +1,4 @@
-;;; calc-units.el --- unit conversion functions for Calc
+;;; calc-units.el --- unit conversion functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2019 Free Software Foundation, Inc.
@@ -455,7 +455,6 @@ If COMP or STD is non-nil, put that in the units table instead."
(uoldname nil)
(unitscancel nil)
(nouold nil)
- unew
units
defunits)
(if (or (not (math-units-in-expr-p expr t))
@@ -672,8 +671,8 @@ If COMP or STD is non-nil, put that in the units table instead."
(substring name (1+ pos)))))
(setq name (concat "(" name ")"))))
(or (eq (nth 1 expr) (car u))
- (setq name (concat (nth 2 (assq (aref (symbol-name
- (nth 1 expr)) 0)
+ (setq name (concat (nth 2 (assq (aref (symbol-name (nth 1 expr))
+ 0)
math-unit-prefixes))
(if (and (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name)
(not (memq (car u) '(mHg gf))))
@@ -857,7 +856,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(or math-units-table
(let* ((combined-units (append math-additional-units
math-standard-units))
- (math-cu-unit-list (mapcar 'car combined-units))
+ (math-cu-unit-list (mapcar #'car combined-units))
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
@@ -880,7 +879,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(nth 4 x))))
combined-units))
(let ((math-units-table tab))
- (mapc 'math-find-base-units tab))
+ (mapc #'math-find-base-units tab))
(message "Building units table...done")
(setq math-units-table tab))))
@@ -890,15 +889,16 @@ If COMP or STD is non-nil, put that in the units table instead."
(defvar math-fbu-base)
(defvar math-fbu-entry)
-(defun math-find-base-units (math-fbu-entry)
- (if (eq (nth 4 math-fbu-entry) 'boom)
- (error "Circular definition involving unit %s" (car math-fbu-entry)))
- (or (nth 4 math-fbu-entry)
- (let (math-fbu-base)
- (setcar (nthcdr 4 math-fbu-entry) 'boom)
- (math-find-base-units-rec (nth 1 math-fbu-entry) 1)
+(defun math-find-base-units (entry)
+ (if (eq (nth 4 entry) 'boom)
+ (error "Circular definition involving unit %s" (car entry)))
+ (or (nth 4 entry)
+ (let (math-fbu-base
+ (math-fbu-entry entry))
+ (setcar (nthcdr 4 entry) 'boom)
+ (math-find-base-units-rec (nth 1 entry) 1)
'(or math-fbu-base
- (error "Dimensionless definition for unit %s" (car math-fbu-entry)))
+ (error "Dimensionless definition for unit %s" (car entry)))
(while (eq (cdr (car math-fbu-base)) 0)
(setq math-fbu-base (cdr math-fbu-base)))
(let ((b math-fbu-base))
@@ -907,7 +907,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(setcdr b (cdr (cdr b)))
(setq b (cdr b)))))
(setq math-fbu-base (sort math-fbu-base 'math-compare-unit-names))
- (setcar (nthcdr 4 math-fbu-entry) math-fbu-base)
+ (setcar (nthcdr 4 entry) math-fbu-base)
math-fbu-base)))
(defun math-compare-unit-names (a b)
@@ -942,7 +942,8 @@ If COMP or STD is non-nil, put that in the units table instead."
(error "Unknown name %s in defining expression for unit %s"
(nth 1 expr) (car math-fbu-entry))))
((equal expr '(calcFunc-ln 10)))
- (t (error "Malformed defining expression for unit %s" (car math-fbu-entry))))))
+ (t (error "Malformed defining expression for unit %s"
+ (car math-fbu-entry))))))
(defun math-units-in-expr-p (expr sub-exprs)
@@ -1018,8 +1019,9 @@ If COMP or STD is non-nil, put that in the units table instead."
;; math-to-standard-units.
(defvar math-which-standard)
-(defun math-to-standard-units (expr math-which-standard)
- (math-to-standard-rec expr))
+(defun math-to-standard-units (expr which-standard)
+ (let ((math-which-standard which-standard))
+ (math-to-standard-rec expr)))
(defun math-to-standard-rec (expr)
(if (eq (car-safe expr) 'var)
@@ -1052,7 +1054,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(eq (car-safe (nth 1 expr)) 'var)))
expr
(cons (car expr)
- (mapcar 'math-to-standard-rec (cdr expr))))))
+ (mapcar #'math-to-standard-rec (cdr expr))))))
(defun math-apply-units (expr units ulist &optional pure)
(setq expr (math-simplify-units expr))
@@ -1085,8 +1087,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(let ((entry (list units calc-internal-prec calc-prefer-frac)))
(or (equal entry (car math-decompose-units-cache))
(let ((ulist nil)
- (utemp units)
- qty unit)
+ (utemp units))
(while (eq (car-safe utemp) '+)
(setq ulist (cons (math-decompose-unit-part (nth 2 utemp))
ulist)
@@ -1144,15 +1145,15 @@ If COMP or STD is non-nil, put that in the units table instead."
(defvar math-cu-new-units)
(defvar math-cu-pure)
-(defun math-convert-units (expr math-cu-new-units &optional math-cu-pure)
- (if (eq (car-safe math-cu-new-units) 'var)
- (let ((unew (assq (nth 1 math-cu-new-units)
+(defun math-convert-units (expr new-units &optional pure)
+ (if (eq (car-safe new-units) 'var)
+ (let ((unew (assq (nth 1 new-units)
(math-build-units-table))))
(if (eq (car-safe (nth 1 unew)) '+)
- (setq math-cu-new-units (nth 1 unew)))))
+ (setq new-units (nth 1 unew)))))
(math-with-extra-prec 2
- (let ((compat (and (not math-cu-pure)
- (math-find-compatible-unit expr math-cu-new-units)))
+ (let ((compat (and (not pure)
+ (math-find-compatible-unit expr new-units)))
(math-cu-unit-list nil)
(math-combining-units nil))
(if compat
@@ -1160,21 +1161,23 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-mul (math-mul (math-simplify-units
(math-div expr (math-pow (car compat)
(cdr compat))))
- (math-pow math-cu-new-units (cdr compat)))
+ (math-pow new-units (cdr compat)))
(math-simplify-units
(math-to-standard-units
- (math-pow (math-div (car compat) math-cu-new-units)
+ (math-pow (math-div (car compat) new-units)
(cdr compat))
nil))))
- (when (setq math-cu-unit-list (math-decompose-units math-cu-new-units))
- (setq math-cu-new-units (nth 2 (car math-cu-unit-list))))
+ (when (setq math-cu-unit-list (math-decompose-units new-units))
+ (setq new-units (nth 2 (car math-cu-unit-list))))
(when (eq (car-safe expr) '+)
(setq expr (math-simplify-units expr)))
(if (math-units-in-expr-p expr t)
- (math-convert-units-rec expr)
+ (let ((math-cu-new-units new-units)
+ (math-cu-pure pure))
+ (math-convert-units-rec expr))
(math-apply-units (math-to-standard-units
- (list '/ expr math-cu-new-units) nil)
- math-cu-new-units math-cu-unit-list math-cu-pure))))))
+ (list '/ expr new-units) nil)
+ new-units math-cu-unit-list pure))))))
(defun math-convert-units-rec (expr)
(if (math-units-in-expr-p expr nil)
@@ -1184,7 +1187,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(if (Math-primp expr)
expr
(cons (car expr)
- (mapcar 'math-convert-units-rec (cdr expr))))))
+ (mapcar #'math-convert-units-rec (cdr expr))))))
(defun math-convert-temperature (expr old new &optional pure)
(let* ((units (math-single-units-in-expr-p expr))
@@ -1228,37 +1231,34 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-simplify a)))
(defalias 'calcFunc-usimplify 'math-simplify-units)
-;; The function created by math-defsimplify uses the variable
-;; math-simplify-expr, and so is used by functions in math-defsimplify
-(defvar math-simplify-expr)
-
+;; The function created by math-defsimplify uses the variable `expr'.
(math-defsimplify (+ -)
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
- (let* ((units (math-extract-units (nth 1 math-simplify-expr)))
+ (math-units-in-expr-p (nth 1 expr) nil)
+ (let* ((units (math-extract-units (nth 1 expr)))
(ratio (math-simplify (math-to-standard-units
- (list '/ (nth 2 math-simplify-expr) units) nil))))
+ (list '/ (nth 2 expr) units) nil))))
(if (math-units-in-expr-p ratio nil)
(progn
- (calc-record-why "*Inconsistent units" math-simplify-expr)
- math-simplify-expr)
- (list '* (math-add (math-remove-units (nth 1 math-simplify-expr))
- (if (eq (car math-simplify-expr) '-)
+ (calc-record-why "*Inconsistent units" expr)
+ expr)
+ (list '* (math-add (math-remove-units (nth 1 expr))
+ (if (eq (car expr) '-)
(math-neg ratio) ratio))
units)))))
(math-defsimplify *
- (math-simplify-units-prod))
+ (math-simplify-units-prod expr))
-(defun math-simplify-units-prod ()
+(defun math-simplify-units-prod (expr)
(and math-simplifying-units
calc-autorange-units
- (Math-realp (nth 1 math-simplify-expr))
- (let* ((num (math-float (nth 1 math-simplify-expr)))
+ (Math-realp (nth 1 expr))
+ (let* ((num (math-float (nth 1 expr)))
(xpon (calcFunc-xpon num))
- (unitp (cdr (cdr math-simplify-expr)))
+ (unitp (cdr (cdr expr)))
(unit (car unitp))
- (pow (if (eq (car math-simplify-expr) '*) 1 -1))
+ (pow (if (eq (car expr) '*) 1 -1))
u)
(and (eq (car-safe unit) '*)
(setq unitp (cdr unit)
@@ -1308,46 +1308,46 @@ If COMP or STD is non-nil, put that in the units table instead."
(or (not (eq p pref))
(< xpon (+ pxpon (* (math-abs pow) 3))))
(progn
- (setcar (cdr math-simplify-expr)
+ (setcar (cdr expr)
(let ((calc-prefer-frac nil))
- (calcFunc-scf (nth 1 math-simplify-expr)
+ (calcFunc-scf (nth 1 expr)
(- uxpon pxpon))))
(setcar unitp pname)
- math-simplify-expr)))))))
+ expr)))))))
(defvar math-try-cancel-units)
(math-defsimplify /
(and math-simplifying-units
- (let ((np (cdr math-simplify-expr))
+ (let ((np (cdr expr))
(math-try-cancel-units 0)
- n nn)
- (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
- (cdr (nth 2 math-simplify-expr))
- (nthcdr 2 math-simplify-expr)))
+ n)
+ (setq n (if (eq (car-safe (nth 2 expr)) '*)
+ (cdr (nth 2 expr))
+ (nthcdr 2 expr)))
(if (math-realp (car n))
(progn
- (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr)
+ (setcar (cdr expr) (math-mul (nth 1 expr)
(let ((calc-prefer-frac nil))
(math-div 1 (car n)))))
(setcar n 1)))
(while (eq (car-safe (setq n (car np))) '*)
- (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr)))
+ (math-simplify-units-divisor (cdr n) (cdr (cdr expr)))
(setq np (cdr (cdr n))))
- (math-simplify-units-divisor np (cdr (cdr math-simplify-expr)))
+ (math-simplify-units-divisor np (cdr (cdr expr)))
(if (eq math-try-cancel-units 0)
(let* ((math-simplifying-units nil)
(base (math-simplify
- (math-to-standard-units math-simplify-expr nil))))
+ (math-to-standard-units expr nil))))
(if (Math-numberp base)
- (setq math-simplify-expr base))))
- (if (eq (car-safe math-simplify-expr) '/)
- (math-simplify-units-prod))
- math-simplify-expr)))
+ (setq expr base))))
+ (if (eq (car-safe expr) '/)
+ (math-simplify-units-prod expr))
+ expr)))
(defun math-simplify-units-divisor (np dp)
(let ((n (car np))
- d dd temp)
+ d temp)
(while (eq (car-safe (setq d (car dp))) '*)
(when (setq temp (math-simplify-units-quotient n (nth 1 d)))
(setcar np (setq n temp))
@@ -1387,23 +1387,23 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-defsimplify ^
(and math-simplifying-units
- (math-realp (nth 2 math-simplify-expr))
- (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
- (list (car (nth 1 math-simplify-expr))
- (list '^ (nth 1 (nth 1 math-simplify-expr))
- (nth 2 math-simplify-expr))
- (list '^ (nth 2 (nth 1 math-simplify-expr))
- (nth 2 math-simplify-expr)))
- (math-simplify-units-pow (nth 1 math-simplify-expr)
- (nth 2 math-simplify-expr)))))
+ (math-realp (nth 2 expr))
+ (if (memq (car-safe (nth 1 expr)) '(* /))
+ (list (car (nth 1 expr))
+ (list '^ (nth 1 (nth 1 expr))
+ (nth 2 expr))
+ (list '^ (nth 2 (nth 1 expr))
+ (nth 2 expr)))
+ (math-simplify-units-pow (nth 1 expr)
+ (nth 2 expr)))))
(math-defsimplify calcFunc-sqrt
(and math-simplifying-units
- (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
- (list (car (nth 1 math-simplify-expr))
- (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr)))
- (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))
- (math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2)))))
+ (if (memq (car-safe (nth 1 expr)) '(* /))
+ (list (car (nth 1 expr))
+ (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))
+ (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))
+ (math-simplify-units-pow (nth 1 expr) '(frac 1 2)))))
(math-defsimplify (calcFunc-floor
calcFunc-ceil
@@ -1416,21 +1416,21 @@ If COMP or STD is non-nil, put that in the units table instead."
calcFunc-abs
calcFunc-clean)
(and math-simplifying-units
- (= (length math-simplify-expr) 2)
- (if (math-only-units-in-expr-p (nth 1 math-simplify-expr))
- (nth 1 math-simplify-expr)
- (if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
+ (= (length expr) 2)
+ (if (math-only-units-in-expr-p (nth 1 expr))
+ (nth 1 expr)
+ (if (and (memq (car-safe (nth 1 expr)) '(* /))
(or (math-only-units-in-expr-p
- (nth 1 (nth 1 math-simplify-expr)))
+ (nth 1 (nth 1 expr)))
(math-only-units-in-expr-p
- (nth 2 (nth 1 math-simplify-expr)))))
- (list (car (nth 1 math-simplify-expr))
- (cons (car math-simplify-expr)
- (cons (nth 1 (nth 1 math-simplify-expr))
- (cdr (cdr math-simplify-expr))))
- (cons (car math-simplify-expr)
- (cons (nth 2 (nth 1 math-simplify-expr))
- (cdr (cdr math-simplify-expr)))))))))
+ (nth 2 (nth 1 expr)))))
+ (list (car (nth 1 expr))
+ (cons (car expr)
+ (cons (nth 1 (nth 1 expr))
+ (cdr (cdr expr))))
+ (cons (car expr)
+ (cons (nth 2 (nth 1 expr))
+ (cdr (cdr expr)))))))))
(defun math-simplify-units-pow (a pow)
(if (and (eq (car-safe a) '^)
@@ -1453,10 +1453,10 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-defsimplify calcFunc-sin
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (math-units-in-expr-p (nth 1 expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (math-to-standard-units (nth 1 expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
@@ -1466,10 +1466,10 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-defsimplify calcFunc-cos
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (math-units-in-expr-p (nth 1 expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (math-to-standard-units (nth 1 expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
@@ -1479,10 +1479,10 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-defsimplify calcFunc-tan
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (math-units-in-expr-p (nth 1 expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (math-to-standard-units (nth 1 expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
@@ -1492,10 +1492,10 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-defsimplify calcFunc-sec
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (math-units-in-expr-p (nth 1 expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (math-to-standard-units (nth 1 expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
@@ -1505,10 +1505,10 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-defsimplify calcFunc-csc
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (math-units-in-expr-p (nth 1 expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (math-to-standard-units (nth 1 expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
@@ -1518,10 +1518,10 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-defsimplify calcFunc-cot
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (math-units-in-expr-p (nth 1 expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (math-to-standard-units (nth 1 expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
@@ -1536,13 +1536,13 @@ If COMP or STD is non-nil, put that in the units table instead."
(if (Math-primp expr)
expr
(cons (car expr)
- (mapcar 'math-remove-units (cdr expr))))))
+ (mapcar #'math-remove-units (cdr expr))))))
(defun math-extract-units (expr)
(cond
((memq (car-safe expr) '(* /))
(cons (car expr)
- (mapcar 'math-extract-units (cdr expr))))
+ (mapcar #'math-extract-units (cdr expr))))
((eq (car-safe expr) 'neg)
(math-extract-units (nth 1 expr)))
((eq (car-safe expr) '^)
@@ -1669,7 +1669,7 @@ In symbolic mode, return the list (^ a b)."
(defun math-extract-logunits (expr)
(if (memq (car-safe expr) '(* /))
(cons (car expr)
- (mapcar 'math-extract-logunits (cdr expr)))
+ (mapcar #'math-extract-logunits (cdr expr)))
(if (memq (car-safe expr) '(^))
(list '^ (math-extract-logunits (nth 1 expr)) (nth 2 expr))
(if (member expr math-logunits) expr 1))))
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index a3e98c06249..364ba4d23bf 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -242,7 +242,7 @@
(cdr item)))
((> mode 0)
(let ((dims nil)
- type new row)
+ type new)
(setq item (list item))
(while (> mode 0)
(setq type (calc-unpack-type (car item))
@@ -1375,9 +1375,7 @@
(aa (if neg (math-sub -1 a) a))
(str (if (eq aa 0)
""
- (if (consp aa)
- (math-format-bignum-binary (cdr aa))
- (math-format-binary aa))))
+ (math-format-binary aa)))
(zero (if neg ?1 ?0))
(one (if neg ?0 ?1))
(len (length str))
@@ -1467,7 +1465,7 @@
a)
(defun math-clean-set (a &optional always-vec)
- (let ((p a) res)
+ (let ((p a))
(while (cdr p)
(if (and (eq (car-safe (nth 1 p)) 'intv)
(Math-equal (nth 2 (nth 1 p)) (nth 3 (nth 1 p))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 1d403b73943..8e762962735 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1,4 +1,4 @@
-;;; calc.el --- the GNU Emacs calculator
+;;; calc.el --- the GNU Emacs calculator -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2019 Free Software Foundation, Inc.
@@ -37,13 +37,12 @@
;; work for the foreseeable future.
;;
;; Bug reports and suggestions are always welcome! (Type M-x
-;; report-calc-bug to send them).
+;; report-emacs-bug to send them).
;; All functions, macros, and Lisp variables defined here begin with one
;; of the prefixes "math", "Math", or "calc", with the exceptions of
;; "full-calc", "full-calc-keypad", "another-calc", "quick-calc",
-;; "report-calc-bug", and "defmath". User-accessible variables begin
-;; with "var-".
+;; and "defmath". User-accessible variables begin with "var-".
;;; TODO:
@@ -178,7 +177,7 @@
(declare-function math-read-radix-digit "calc-misc" (dig))
(declare-function calc-digit-dots "calc-incom" ())
(declare-function math-normalize-fancy "calc-ext" (a))
-(declare-function math-normalize-nonstandard "calc-ext" ())
+(declare-function math-normalize-nonstandard "calc-ext" (a))
(declare-function math-recompile-eval-rules "calc-alg" ())
(declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset))
(declare-function calc-record-why "calc-misc" (&rest stuff))
@@ -203,7 +202,7 @@
(declare-function math-compose-expr "calccomp" (a prec &optional div))
(declare-function math-comp-width "calccomp" (c))
(declare-function math-composition-to-string "calccomp" (c &optional width))
-(declare-function math-stack-value-offset-fancy "calccomp" ())
+(declare-function math-stack-value-offset-fancy "calccomp" (c))
(declare-function math-format-flat-expr-fancy "calc-ext" (a prec))
(declare-function math-adjust-fraction "calc-ext" (a))
(declare-function math-format-binary "calc-bin" (a))
@@ -212,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))
@@ -233,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
@@ -249,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
@@ -272,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"))))
@@ -299,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")))
@@ -314,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
@@ -337,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"))))
@@ -345,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"))))
@@ -366,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
@@ -389,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"))))
@@ -403,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)
@@ -438,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
@@ -456,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")
@@ -935,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
@@ -1114,15 +1080,7 @@ Used by `calc-user-invocation'.")
(ignore-errors
(define-key calc-digit-map x 'calcDigit-backspace)
(define-key calc-mode-map x 'calc-pop)
- (define-key calc-mode-map
- (if (and (vectorp x) (featurep 'xemacs))
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- 'calc-pop-above)))
+ (define-key calc-mode-map (vconcat "\e" x) 'calc-pop-above)))
(if calc-scan-for-dels
(append (where-is-internal 'delete-backward-char global-map)
(where-is-internal 'backward-delete-char global-map)
@@ -1231,9 +1189,9 @@ Used by `calc-user-invocation'.")
(let ((glob (current-global-map))
(loc (current-local-map)))
(or (input-pending-p) (message "%s" prompt))
- (let ((key (calc-read-key t))
+ (let ((key (read-event))
(input-method-function nil))
- (calc-unread-command (cdr key))
+ (calc-unread-command key)
(unwind-protect
(progn
(use-global-map map)
@@ -1338,16 +1296,17 @@ Notations: 3.14e6 3.14 * 10^6
"
(interactive)
(mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
- (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list)
+ (lambda (v) (set-default v (symbol-value v))))
+ calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
(progn (require 'calc-ext) calc-alg-map) calc-mode-map))
(mapc #'make-local-variable calc-local-var-list)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
- (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
+ (add-hook 'change-major-mode-hook #'font-lock-defontify nil t)
(add-hook 'kill-buffer-query-functions
- 'calc-kill-stack-buffer
+ #'calc-kill-stack-buffer
t t)
(setq truncate-lines t)
(setq buffer-read-only t)
@@ -1392,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))
@@ -1418,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 ()
@@ -1704,7 +1663,7 @@ See calc-keypad for details."
(let* ((fmt (car calc-float-format))
(figs (nth 1 calc-float-format))
(new-mode-string
- (format "Calc%s%s: %d %s %-14s"
+ (format "Calc%s%s: %d %s %s"
(if (and calc-embedded-info
(eq (aref calc-embedded-info 1) (current-buffer)))
"Embed" "")
@@ -1802,7 +1761,7 @@ See calc-keypad for details."
(if calc-hyperbolic-flag "Hyp " "")
(if calc-keep-args-flag "Keep " "")
(if (/= calc-stack-top 1) "Narrow " "")
- (apply 'concat calc-other-modes)))))
+ (apply #'concat calc-other-modes)))))
(if (equal new-mode-string mode-line-buffer-identification)
nil
(setq mode-line-buffer-identification new-mode-string)
@@ -1876,7 +1835,7 @@ See calc-keypad for details."
(if (and (consp vals)
(or (integerp (car vals))
(consp (car vals))))
- (setq vals (mapcar 'calc-normalize vals))
+ (setq vals (mapcar #'calc-normalize vals))
(setq vals (calc-normalize vals)))
(or (and (consp vals)
(or (integerp (car vals))
@@ -1959,8 +1918,8 @@ See calc-keypad for details."
(mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top)))))
(defun calc-top-list-n (&optional n m sel-mode)
- (mapcar 'math-check-complete
- (mapcar 'calc-normalize (calc-top-list n m sel-mode))))
+ (mapcar #'math-check-complete
+ (mapcar #'calc-normalize (calc-top-list n m sel-mode))))
(defun calc-renumber-stack ()
@@ -2051,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))
@@ -2214,7 +2172,7 @@ the United States."
(setq calc-aborted-prefix name)
(if (null arg)
(calc-enter-result 2 name (cons (or func2 func)
- (mapcar 'math-check-complete
+ (mapcar #'math-check-complete
(calc-top-list 2))))
(require 'calc-ext)
(calc-binary-op-fancy name func arg ident unary)))
@@ -2333,21 +2291,14 @@ the United States."
(calc-prev-char nil)
(calc-prev-prev-char nil)
(calc-buffer (current-buffer))
- (buf (if (featurep 'xemacs)
- (catch 'calc-foo
- (catch 'execute-kbd-macro
- (throw 'calc-foo
- (read-from-minibuffer
- "Calc: " "" calc-digit-map)))
- (error "XEmacs requires RET after %s"
- "digit entry in kbd macro"))
- (let ((old-esc (lookup-key global-map "\e")))
- (unwind-protect
- (progn
- (define-key global-map "\e" nil)
- (read-from-minibuffer
- "Calc: " (calc-digit-start-entry) calc-digit-map))
- (define-key global-map "\e" old-esc))))))
+ (buf
+ (let ((old-esc (lookup-key global-map "\e")))
+ (unwind-protect
+ (progn
+ (define-key global-map "\e" nil)
+ (read-from-minibuffer
+ "Calc: " (calc-digit-start-entry) calc-digit-map))
+ (define-key global-map "\e" old-esc)))))
(or calc-digit-value (setq calc-digit-value (math-read-number buf)))
(if (stringp calc-digit-value)
(calc-alg-entry calc-digit-value)
@@ -2429,7 +2380,7 @@ the United States."
(beep)
(and (not (calc-minibuffer-contains "[-+]?\\(1[5-9]\\|[2-9][0-9]\\)#.*"))
(search-forward "e" nil t))
- (if (looking-at "+")
+ (if (looking-at "\\+")
(delete-char 1))
(if (looking-at "-")
(delete-char 1)
@@ -2505,51 +2456,18 @@ the United States."
(setq last-command-event 13)
(calcDigit-nondigit))))
-
-
-
-(defconst math-bignum-digit-length
- (truncate (/ (log (/ most-positive-fixnum 2) 10) 2))
- "The length of a \"digit\" in Calc bignums.
-If a big integer is of the form (bigpos N0 N1 ...), this is the
-length of the allowable Emacs integers N0, N1,...
-The value of 2*10^(2*MATH-BIGNUM-DIGIT-LENGTH) must be less than the
-largest Emacs integer.")
-
-(defconst math-bignum-digit-size
- (expt 10 math-bignum-digit-length)
- "An upper bound for the size of the \"digit\"s in Calc bignums.")
-
-(defconst math-small-integer-size
- (expt math-bignum-digit-size 2)
- "An upper bound for the size of \"small integer\"s in Calc.")
-
-
;;;; Arithmetic routines.
;;
;; An object as manipulated by one of these routines may take any of the
;; following forms:
;;
-;; integer An integer. For normalized numbers, this format
-;; is used only for
-;; negative math-small-integer-size + 1 to
-;; math-small-integer-size - 1
+;; integer An integer.
;;
-;; (bigpos N0 N1 N2 ...) A big positive integer,
-;; N0 + N1*math-bignum-digit-size
-;; + N2*(math-bignum-digit-size)^2 ...
-;; (bigneg N0 N1 N2 ...) A big negative integer,
-;; - N0 - N1*math-bignum-digit-size ...
-;; Each digit N is in the range
-;; 0 ... math-bignum-digit-size -1.
-;; Normalized, always at least three N present,
-;; and the most significant N is nonzero.
-;;
-;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers.
+;; (frac NUM DEN) A fraction. NUM and DEN are integers.
;; Normalized, DEN > 1.
;;
;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
-;; NUM is a small or big integer, EXP is a small int.
+;; NUM and EXP are integers.
;; Normalized, NUM is not a multiple of 10, and
;; abs(NUM) < 10^calc-internal-prec.
;; Normalized zero is stored as (float 0 0).
@@ -2610,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"
@@ -2626,78 +2543,41 @@ largest Emacs integer.")
(defvar math-eval-rules-cache-other)
;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
-(defvar math-normalize-a)
(defvar math-normalize-error nil
"Non-nil if the last call the `math-normalize' returned an error.")
-(defun math-normalize (math-normalize-a)
+(defun math-normalize (a)
(setq math-normalize-error nil)
(cond
- ((not (consp math-normalize-a))
- (if (integerp math-normalize-a)
- (if (or (>= math-normalize-a math-small-integer-size)
- (<= math-normalize-a (- math-small-integer-size)))
- (math-bignum math-normalize-a)
- math-normalize-a)
- math-normalize-a))
- ((eq (car math-normalize-a) 'bigpos)
- (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
- (let* ((last (setq math-normalize-a
- (copy-sequence math-normalize-a))) (digs math-normalize-a))
- (while (setq digs (cdr digs))
- (or (eq (car digs) 0) (setq last digs)))
- (setcdr last nil)))
- (if (cdr (cdr (cdr math-normalize-a)))
- math-normalize-a
- (cond
- ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a)
- math-bignum-digit-size)))
- ((cdr math-normalize-a) (nth 1 math-normalize-a))
- (t 0))))
- ((eq (car math-normalize-a) 'bigneg)
- (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
- (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a)))
- (digs math-normalize-a))
- (while (setq digs (cdr digs))
- (or (eq (car digs) 0) (setq last digs)))
- (setcdr last nil)))
- (if (cdr (cdr (cdr math-normalize-a)))
- math-normalize-a
- (cond
- ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a)
- math-bignum-digit-size))))
- ((cdr math-normalize-a) (- (nth 1 math-normalize-a)))
- (t 0))))
- ((eq (car math-normalize-a) 'float)
- (math-make-float (math-normalize (nth 1 math-normalize-a))
- (nth 2 math-normalize-a)))
- ((or (memq (car math-normalize-a)
+ ((not (consp a)) a)
+ ((eq (car a) 'float)
+ (math-make-float (math-normalize (nth 1 a))
+ (nth 2 a)))
+ ((or (memq (car a)
'(frac cplx polar hms date mod sdev intv vec var quote
special-const calcFunc-if calcFunc-lambda
calcFunc-quote calcFunc-condition
calcFunc-evalto))
- (integerp (car math-normalize-a))
- (and (consp (car math-normalize-a))
- (not (eq (car (car math-normalize-a)) 'lambda))))
+ (integerp (car a))
+ (and (consp (car a))
+ (not (eq (car (car a)) 'lambda))))
(require 'calc-ext)
- (math-normalize-fancy math-normalize-a))
+ (math-normalize-fancy a))
(t
(or (and calc-simplify-mode
(require 'calc-ext)
- (math-normalize-nonstandard))
- (let ((args (mapcar 'math-normalize (cdr math-normalize-a))))
+ (math-normalize-nonstandard a))
+ (let ((args (mapcar #'math-normalize (cdr a))))
(or (condition-case err
(let ((func
- (assq (car math-normalize-a) '( ( + . math-add )
- ( - . math-sub )
- ( * . math-mul )
- ( / . math-div )
- ( % . math-mod )
- ( ^ . math-pow )
- ( neg . math-neg )
- ( | . math-concat ) ))))
+ (assq (car a) '( ( + . math-add )
+ ( - . math-sub )
+ ( * . math-mul )
+ ( / . math-div )
+ ( % . math-mod )
+ ( ^ . math-pow )
+ ( neg . math-neg )
+ ( | . math-concat ) ))))
(or (and var-EvalRules
(progn
(or (eq var-EvalRules math-eval-rules-cache-tag)
@@ -2705,59 +2585,59 @@ largest Emacs integer.")
(require 'calc-ext)
(math-recompile-eval-rules)))
(and (or math-eval-rules-cache-other
- (assq (car math-normalize-a)
+ (assq (car a)
math-eval-rules-cache))
(math-apply-rewrites
- (cons (car math-normalize-a) args)
+ (cons (car a) args)
(cdr math-eval-rules-cache)
nil math-eval-rules-cache))))
(if func
(apply (cdr func) args)
- (and (or (consp (car math-normalize-a))
- (fboundp (car math-normalize-a))
+ (and (or (consp (car a))
+ (fboundp (car a))
(and (not (featurep 'calc-ext))
(require 'calc-ext)
- (fboundp (car math-normalize-a))))
- (apply (car math-normalize-a) args)))))
+ (fboundp (car a))))
+ (apply (car a) args)))))
(wrong-number-of-arguments
(setq math-normalize-error t)
(calc-record-why "*Wrong number of arguments"
- (cons (car math-normalize-a) args))
+ (cons (car a) args))
nil)
(wrong-type-argument
(or calc-next-why
(calc-record-why "Wrong type of argument"
- (cons (car math-normalize-a) args)))
+ (cons (car a) args)))
nil)
(args-out-of-range
(setq math-normalize-error t)
(calc-record-why "*Argument out of range"
- (cons (car math-normalize-a) args))
+ (cons (car a) args))
nil)
(inexact-result
(calc-record-why "No exact representation for result"
- (cons (car math-normalize-a) args))
+ (cons (car a) args))
nil)
(math-overflow
(setq math-normalize-error t)
(calc-record-why "*Floating-point overflow occurred"
- (cons (car math-normalize-a) args))
+ (cons (car a) args))
nil)
(math-underflow
(setq math-normalize-error t)
(calc-record-why "*Floating-point underflow occurred"
- (cons (car math-normalize-a) args))
+ (cons (car a) args))
nil)
(void-variable
(setq math-normalize-error t)
(if (eq (nth 1 err) 'var-EvalRules)
(progn
(setq var-EvalRules nil)
- (math-normalize (cons (car math-normalize-a) args)))
+ (math-normalize (cons (car a) args)))
(calc-record-why "*Variable is void" (nth 1 err)))))
- (if (consp (car math-normalize-a))
+ (if (consp (car a))
(math-dimension-error)
- (cons (car math-normalize-a) args))))))))
+ (cons (car a) args))))))))
@@ -2781,30 +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)))
- ((= a most-negative-fixnum)
- ;; Note: cannot get the negation directly because
- ;; (- most-negative-fixnum) is most-negative-fixnum.
- ;;
- ;; most-negative-fixnum := -most-positive-fixnum - 1
- (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum))
- 1))
- (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)
@@ -2813,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)
@@ -2835,49 +2680,40 @@ 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))
((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a)))
((eq (car a) 'float) a)
((memq (car a) '(cplx polar vec hms date sdev mod))
- (cons (car a) (mapcar 'math-float (cdr a))))
+ (cons (car a) (mapcar #'math-float (cdr a))))
(t (math-float-fancy a))))
(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))
- (cons (car a) (mapcar 'math-neg (cdr a))))
+ (cons (car a) (mapcar #'math-neg (cdr a))))
(t (math-neg-fancy a))))
;;; 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)
@@ -2888,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))
@@ -2970,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))
@@ -3015,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)
@@ -3110,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))))
@@ -3137,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)
@@ -3152,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))
@@ -3191,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)
@@ -3439,22 +2984,21 @@ largest Emacs integer.")
(setcar (cdr entry) (calc-count-lines s))
s))
-;; The variables math-svo-c, math-svo-wid and math-svo-off are local
+;; The variables math-svo-wid and math-svo-off are local
;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy
;; in calccomp.el.
-(defvar math-svo-c)
(defvar math-svo-wid)
(defvar math-svo-off)
-(defun math-stack-value-offset (math-svo-c)
+(defun math-stack-value-offset (c)
(let* ((num (if calc-line-numbering 4 0))
(math-svo-wid (calc-window-width))
math-svo-off)
(if calc-display-just
(progn
(require 'calc-ext)
- (math-stack-value-offset-fancy))
+ (math-stack-value-offset-fancy c))
(setq math-svo-off (or calc-display-origin 0))
(when (integerp calc-line-breaking)
(setq math-svo-wid calc-line-breaking)))
@@ -3555,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)))
@@ -3574,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)))
@@ -3594,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)
@@ -3640,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."
@@ -3680,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)
@@ -3737,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))
@@ -3759,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 )
@@ -3887,33 +3390,20 @@ The prefix `calcFunc-' is added to the specified name to get the
actual Lisp function name.
See Info node `(calc)Defining Functions'."
- (declare (doc-string 3))
+ (declare (doc-string 3)) ;; FIXME: Edebug spec?
(require 'calc-ext)
(math-do-defmath func args body))
-;;; Functions needed for Lucid Emacs support.
-
-(defun calc-read-key (&optional optkey)
- (cond ((featurep 'xemacs)
- (let ((event (next-command-event)))
- (let ((key (event-to-character event t t)))
- (or key optkey (error "Expected a plain keystroke"))
- (cons key event))))
- (t
- (let ((key (read-event)))
- (cons key key)))))
+(defun calc-read-key (&optional _optkey)
+ (declare (obsolete read-event "27.1"))
+ (let ((key (read-event)))
+ (cons key key)))
(defun calc-unread-command (&optional input)
- (if (featurep 'xemacs)
- (setq unread-command-event
- (if (integerp input) (character-to-event input)
- (or input last-command-event)))
- (push (or input last-command-event) unread-command-events)))
+ (push (or input last-command-event) unread-command-events))
(defun calc-clear-unread-commands ()
- (if (featurep 'xemacs)
- (setq unread-command-event nil)
- (setq unread-command-events nil)))
+ (setq unread-command-events nil))
(defcalcmodevar math-2-word-size
(math-read-number-simple "4294967296")
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index d81cc04fe50..91eadfbb4e8 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1,4 +1,4 @@
-;;; calccomp.el --- composition functions for Calc
+;;; calccomp.el --- composition functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2019 Free Software Foundation, Inc.
@@ -121,7 +121,8 @@
calc-lang-slash-idiv)
(math-float (nth 1 aa))
(nth 1 aa))
- (nth 2 aa)) prec))
+ (nth 2 aa))
+ prec))
(if (and (eq calc-language 'big)
(= (length (car calc-frac-format)) 1))
(let* ((aa (math-adjust-fraction a))
@@ -202,8 +203,9 @@
(math-comp-comma-spc (or calc-vector-commas " "))
(math-comp-comma (or calc-vector-commas ""))
(math-comp-vector-prec (if (or (and calc-vector-commas
- (math-vector-no-parens a))
- (memq 'P calc-matrix-brackets)) 0 1000))
+ (math-vector-no-parens a))
+ (memq 'P calc-matrix-brackets))
+ 0 1000))
(math-comp-just (cond ((eq calc-matrix-just 'right) 'vright)
((eq calc-matrix-just 'center) 'vcent)
(t 'vleft)))
@@ -803,8 +805,7 @@
( % . calcFunc-mod )
( ^ . calcFunc-pow )
( neg . calcFunc-neg )
- ( | . calcFunc-vconcat ))))
- left right args)
+ ( | . calcFunc-vconcat )))))
(if func2
(setq func (cdr func2)))
(if (setq func2 (rassq func math-expr-function-mapping))
@@ -858,7 +859,7 @@
(or (cdr (cdr a))
(not (eq (car-safe (nth 1 a)) '*))))
-(defun math-compose-matrix (a col cols base)
+(defun math-compose-matrix (a _col cols base)
(let ((col 0)
(res nil))
(while (<= (setq col (1+ col)) cols)
@@ -968,8 +969,8 @@
(and (memq (car a) '(^ calcFunc-subscr))
(math-tex-expr-is-flat (nth 1 a)))))
-(put 'calcFunc-log 'math-compose-big 'math-compose-log)
-(defun math-compose-log (a prec)
+(put 'calcFunc-log 'math-compose-big #'math-compose-log)
+(defun math-compose-log (a _prec)
(and (= (length a) 3)
(list 'horiz
(list 'subscr "log"
@@ -979,8 +980,8 @@
(math-compose-expr (nth 1 a) 1000)
")")))
-(put 'calcFunc-log10 'math-compose-big 'math-compose-log10)
-(defun math-compose-log10 (a prec)
+(put 'calcFunc-log10 'math-compose-big #'math-compose-log10)
+(defun math-compose-log10 (a _prec)
(and (= (length a) 2)
(list 'horiz
(list 'subscr "log" "10")
@@ -988,8 +989,8 @@
(math-compose-expr (nth 1 a) 1000)
")")))
-(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
-(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
+(put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv)
+(put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv)
(defun math-compose-deriv (a prec)
(when (= (length a) 3)
(math-compose-expr (list '/
@@ -1003,8 +1004,8 @@
(nth 2 a))))
prec)))
-(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
-(defun math-compose-sqrt (a prec)
+(put 'calcFunc-sqrt 'math-compose-big #'math-compose-sqrt)
+(defun math-compose-sqrt (a _prec)
(when (= (length a) 2)
(let* ((c (math-compose-expr (nth 1 a) 0))
(a (math-comp-ascent c))
@@ -1024,8 +1025,8 @@
" "
c)))))
-(put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
-(defun math-compose-choose (a prec)
+(put 'calcFunc-choose 'math-compose-big #'math-compose-choose)
+(defun math-compose-choose (a _prec)
(let ((a1 (math-compose-expr (nth 1 a) 0))
(a2 (math-compose-expr (nth 2 a) 0)))
(list 'horiz
@@ -1035,7 +1036,7 @@
a1 " " a2)
")")))
-(put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
+(put 'calcFunc-integ 'math-compose-big #'math-compose-integ)
(defun math-compose-integ (a prec)
(and (memq (length a) '(3 5))
(eq (car-safe (nth 2 a)) 'var)
@@ -1072,7 +1073,7 @@
(list 'horiz " d" var))
(if parens ")" "")))))
-(put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
+(put 'calcFunc-sum 'math-compose-big #'math-compose-sum)
(defun math-compose-sum (a prec)
(and (memq (length a) '(3 5 6))
(let* ((expr (math-compose-expr (nth 1 a) 185))
@@ -1097,7 +1098,7 @@
expr
(if (memq prec '(180 201)) ")" "")))))
-(put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
+(put 'calcFunc-prod 'math-compose-big #'math-compose-prod)
(defun math-compose-prod (a prec)
(and (memq (length a) '(3 5 6))
(let* ((expr (math-compose-expr (nth 1 a) 198))
@@ -1124,12 +1125,11 @@
;; The variables math-svo-c, math-svo-wid and math-svo-off are local
;; to math-stack-value-offset in calc.el, but are used by
;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
-(defvar math-svo-c)
(defvar math-svo-wid)
(defvar math-svo-off)
-(defun math-stack-value-offset-fancy ()
- (let ((cwid (+ (math-comp-width math-svo-c))))
+(defun math-stack-value-offset-fancy (c)
+ (let ((cwid (+ (math-comp-width c))))
(cond ((eq calc-display-just 'right)
(if calc-display-origin
(setq math-svo-wid (max calc-display-origin 5))
@@ -1215,7 +1215,7 @@
;; which are called by math-comp-to-string-flat.
(defvar math-comp-pos)
-(defun math-comp-to-string-flat (c math-comp-full-width)
+(defun math-comp-to-string-flat (c full-width)
(if math-comp-sel-hpos
(let ((math-comp-pos 0))
(math-comp-sel-flat-term c))
@@ -1224,6 +1224,7 @@
(math-comp-pos 0)
(math-comp-margin 0)
(math-comp-highlight (and math-comp-selected calc-show-selections))
+ (math-comp-full-width full-width)
(math-comp-level -1))
(math-comp-to-string-flat-term '(set -1 0))
(math-comp-to-string-flat-term c)
@@ -1387,7 +1388,7 @@
(defvar math-comp-hpos)
(defvar math-comp-vpos)
-(defun math-comp-simplify (c full-width)
+(defun math-comp-simplify (c _full-width)
(let ((math-comp-buf (list ""))
(math-comp-base 0)
(math-comp-hgt 1)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-23 16:41:24 +0000