[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 11c9343: calc.el, calc-(ext|poly), calccomp: Use le
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 11c9343: calc.el, calc-(ext|poly), calccomp: Use lexical-binding |
|
Date: |
Tue, 20 Nov 2018 16:09:42 -0500 (EST) |
branch: master
commit 11c9343fe63fdc8bfef3246d95f42523d73fb733
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
calc.el, calc-(ext|poly), calccomp: Use lexical-binding
* lisp/calc/calc-ext.el: Use lexical-binding, silence warnings.
(calc-init-extensions): Remove a few functions which can't be called
directly since they depend on dynamically scoped vars.
(calc-embedded-quiet): Declare.
(math-defcache): Use 'declare'.
(math-normalize-a): Remove declaration.
(math-normalize-nonstandard): Receive 'a' as arg instead.
(math-defintegral): Use 'declare'.
(math-exp-pos, math-exp-old-pos, math-exp-keep-spaces, math-rb-h2)
(math-read-big-baseline, math-read-big-h2, math-read-big-err-msg)
(math-exp-token, math-expr-data, math-exp-str): Declare.
(math-map-tree, math-read-expr): Avoid dynvars as formal arguments.
* lisp/calc/calc-poly.el: Use lexical-binding, silence warnings.
Turn some comments into docstrings.
(math-poly-div): Avoid dynvars as formal arguments.
(math-poly-base-top-expr): Move declaration before first use.
(calcFunc-factors, math-factor-expr, math-factor-expr-try)
(calcFunc-factor): Avoid dynvars as formal arguments.
* lisp/calc/calc.el: Use lexical-binding, silence warnings.
(math-normalize-a): Remove.
(math-normalize): Use lexical var 'a' instead.
(math-svo-c): Remove.
(math-stack-value-offset): Pass 'c' explicitly as arg to
math-stack-value-offset-fancy instead.
* lisp/calc/calccomp.el: Use lexical-binding, silence warnings.
(math-svo-c): Remove.
(math-stack-value-offset-fancy): Use new arg 'c' instead.
(math-comp-to-string-flat): Avoid dynvars as formal arguments.
---
lisp/calc/calc-ext.el | 85 ++++++++++++++++-----------
lisp/calc/calc-poly.el | 117 ++++++++++++++++++-------------------
lisp/calc/calc.el | 156 ++++++++++++++++++++++++-------------------------
lisp/calc/calccomp.el | 51 ++++++++--------
4 files changed, 211 insertions(+), 198 deletions(-)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 821a709..761eb97 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-2018 Free Software Foundation, Inc.
@@ -88,7 +88,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)
@@ -894,8 +894,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 +984,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 +1307,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 +1335,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 +1401,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)))
@@ -1657,7 +1660,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 +1710,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)))
@@ -1928,7 +1931,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,12 +2006,13 @@ 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
@@ -2037,7 +2041,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
@@ -2400,7 +2403,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 +2415,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 +2438,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]
@@ -2808,7 +2809,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 +2823,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 +2844,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 +2869,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 +2879,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 +2890,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)
@@ -3097,9 +3099,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 +3147,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 +3192,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)
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index 4092aee..41083b7 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-2018 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,10 +510,11 @@
;;; 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)
@@ -522,11 +522,6 @@
(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))
@@ -555,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)
@@ -590,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))
@@ -617,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)
@@ -736,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)))
@@ -1109,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.el b/lisp/calc/calc.el
index c79db82..f155b82 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-2018 Free Software Foundation, Inc.
@@ -178,7 +178,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 +203,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))
@@ -1331,16 +1331,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)
@@ -1795,7 +1796,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)
@@ -1869,7 +1870,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))
@@ -1952,8 +1953,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 ()
@@ -2207,7 +2208,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)))
@@ -2619,78 +2620,78 @@ 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))
+ ((not (consp a))
+ (if (integerp a)
+ (if (or (>= a math-small-integer-size)
+ (<= a (- math-small-integer-size)))
+ (math-bignum a)
+ a)
+ a))
+ ((eq (car a) 'bigpos)
+ (if (eq (nth (1- (length a)) a) 0)
+ (let* ((last (setq a
+ (copy-sequence a)))
+ (digs a))
(while (setq digs (cdr digs))
(or (eq (car digs) 0) (setq last digs)))
(setcdr last nil)))
- (if (cdr (cdr (cdr math-normalize-a)))
- math-normalize-a
+ (if (cdr (cdr (cdr a)))
+ a
(cond
- ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a)
+ ((cdr (cdr a)) (+ (nth 1 a)
+ (* (nth 2 a)
math-bignum-digit-size)))
- ((cdr math-normalize-a) (nth 1 math-normalize-a))
+ ((cdr a) (nth 1 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))
+ ((eq (car a) 'bigneg)
+ (if (eq (nth (1- (length a)) a) 0)
+ (let* ((last (setq a (copy-sequence a)))
+ (digs a))
(while (setq digs (cdr digs))
(or (eq (car digs) 0) (setq last digs)))
(setcdr last nil)))
- (if (cdr (cdr (cdr math-normalize-a)))
- math-normalize-a
+ (if (cdr (cdr (cdr a)))
+ a
(cond
- ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a)
+ ((cdr (cdr a)) (- (+ (nth 1 a)
+ (* (nth 2 a)
math-bignum-digit-size))))
- ((cdr math-normalize-a) (- (nth 1 math-normalize-a)))
+ ((cdr a) (- (nth 1 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)
+ ((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)
@@ -2698,59 +2699,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))))))))
@@ -2834,7 +2835,7 @@ largest Emacs integer.")
((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))))
@@ -2845,7 +2846,7 @@ largest Emacs integer.")
((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))))
@@ -3425,22 +3426,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)))
@@ -3873,7 +3873,7 @@ 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))
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 858343a..75c7adc 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-2018 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)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 11c9343: calc.el, calc-(ext|poly), calccomp: Use lexical-binding,
Stefan Monnier <=