Commit 11c9343f authored by Stefan Monnier's avatar Stefan Monnier

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.
parent 336681f3
Pipeline #103 failed with stage
in 20 minutes and 59 seconds
;;; 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)
......
;;; 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)
......
;;; 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))