aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2018-11-20 16:09:35 -0500
committerStefan Monnier2018-11-20 16:09:35 -0500
commit11c9343fe63fdc8bfef3246d95f42523d73fb733 (patch)
tree5f129a2598a0555e8a0fc06ca49e57cdf8f8e841
parent336681f35bf23f442a7159eb86d1c5d8a6269c7f (diff)
downloademacs-11c9343fe63fdc8bfef3246d95f42523d73fb733.tar.gz
emacs-11c9343fe63fdc8bfef3246d95f42523d73fb733.zip
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.
-rw-r--r--lisp/calc/calc-ext.el85
-rw-r--r--lisp/calc/calc-poly.el117
-rw-r--r--lisp/calc/calc.el156
-rw-r--r--lisp/calc/calccomp.el51
4 files changed, 211 insertions, 198 deletions
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 821a7094349..761eb97a816 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1,4 +1,4 @@
1;;; calc-ext.el --- various extension functions for Calc 1;;; calc-ext.el --- various extension functions for Calc -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. 3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
4 4
@@ -88,7 +88,7 @@
88(defvar calc-alg-map) 88(defvar calc-alg-map)
89(defvar calc-alg-esc-map) 89(defvar calc-alg-esc-map)
90 90
91;;; The following was made a function so that it could be byte-compiled. 91;; The following was made a function so that it could be byte-compiled.
92(defun calc-init-extensions () 92(defun calc-init-extensions ()
93 93
94 (define-key calc-mode-map ":" 'calc-fdiv) 94 (define-key calc-mode-map ":" 'calc-fdiv)
@@ -894,8 +894,8 @@ calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide
894calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim 894calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim
895calcFunc-prem math-accum-factors math-atomic-factorp 895calcFunc-prem math-accum-factors math-atomic-factorp
896math-div-poly-const math-div-thru math-expand-power math-expand-term 896math-div-poly-const math-div-thru math-expand-power math-expand-term
897math-factor-contains math-factor-expr math-factor-expr-part 897math-factor-contains math-factor-expr
898math-factor-expr-try math-factor-finish math-factor-poly-coefs 898math-factor-finish
899math-factor-protect math-mul-thru math-padded-polynomial 899math-factor-protect math-mul-thru math-padded-polynomial
900math-partial-fractions math-poly-degree math-poly-deriv-coefs 900math-partial-fractions math-poly-degree math-poly-deriv-coefs
901math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p 901math-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)
984)) 984))
985 985
986 (mapcar (function (lambda (x) 986 (mapcar (function (lambda (x)
987 (mapcar (function (lambda (cmd) 987 (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t)))
988 (autoload cmd (car x) nil t))) (cdr x)))) 988 (cdr x))))
989 '( 989 '(
990 990
991 ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand 991 ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@@ -1307,8 +1307,9 @@ calc-kill calc-kill-region calc-yank))))
1307 (message "%s" (if msg 1307 (message "%s" (if msg
1308 (concat group ": " msg ":" 1308 (concat group ": " msg ":"
1309 (make-string 1309 (make-string
1310 (- (apply 'max (mapcar 'length msgs)) 1310 (- (apply #'max (mapcar #'length msgs))
1311 (length msg)) 32) 1311 (length msg))
1312 ?\s)
1312 " [MORE]" 1313 " [MORE]"
1313 (if key 1314 (if key
1314 (concat " " (char-to-string key) 1315 (concat " " (char-to-string key)
@@ -1334,6 +1335,8 @@ calc-kill calc-kill-region calc-yank))))
1334 1335
1335;;; General. 1336;;; General.
1336 1337
1338(defvar calc-embedded-quiet)
1339
1337(defun calc-reset (arg) 1340(defun calc-reset (arg)
1338 (interactive "P") 1341 (interactive "P")
1339 (setq arg (if arg (prefix-numeric-value arg) nil)) 1342 (setq arg (if arg (prefix-numeric-value arg) nil))
@@ -1398,7 +1401,7 @@ calc-kill calc-kill-region calc-yank))))
1398 1401
1399(defun calc-scroll-up (n) 1402(defun calc-scroll-up (n)
1400 (interactive "P") 1403 (interactive "P")
1401 (condition-case err 1404 (condition-case nil
1402 (scroll-up (or n (/ (window-height) 2))) 1405 (scroll-up (or n (/ (window-height) 2)))
1403 (error nil)) 1406 (error nil))
1404 (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) 1407 (if (pos-visible-in-window-p (max 1 (- (point-max) 2)))
@@ -1657,7 +1660,7 @@ calc-kill calc-kill-region calc-yank))))
1657 (let ((entries (calc-top-list n 1 'entry)) 1660 (let ((entries (calc-top-list n 1 'entry))
1658 (calc-undo-list nil) (calc-redo-list nil)) 1661 (calc-undo-list nil) (calc-redo-list nil))
1659 (calc-pop-stack n 1 t) 1662 (calc-pop-stack n 1 t)
1660 (calc-push-list (mapcar 'car entries) 1663 (calc-push-list (mapcar #'car entries)
1661 1 1664 1
1662 (mapcar (function (lambda (x) (nth 2 x))) 1665 (mapcar (function (lambda (x) (nth 2 x)))
1663 entries))))))) 1666 entries)))))))
@@ -1707,7 +1710,7 @@ calc-kill calc-kill-region calc-yank))))
1707 (calc-pop-push-record-list 1 "eval" 1710 (calc-pop-push-record-list 1 "eval"
1708 (math-evaluate-expr (calc-top (- n))) 1711 (math-evaluate-expr (calc-top (- n)))
1709 (- n)) 1712 (- n))
1710 (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr 1713 (calc-pop-push-record-list n "eval" (mapcar #'math-evaluate-expr
1711 (calc-top-list n))))) 1714 (calc-top-list n)))))
1712 (calc-handle-whys))) 1715 (calc-handle-whys)))
1713 1716
@@ -1928,7 +1931,7 @@ calc-kill calc-kill-region calc-yank))))
1928 (calc-z-prefix-buf "") 1931 (calc-z-prefix-buf "")
1929 (kmap (sort (copy-sequence (calc-user-key-map)) 1932 (kmap (sort (copy-sequence (calc-user-key-map))
1930 (function (lambda (x y) (< (car x) (car y)))))) 1933 (function (lambda (x y) (< (car x) (car y))))))
1931 (flags (apply 'logior 1934 (flags (apply #'logior
1932 (mapcar (function 1935 (mapcar (function
1933 (lambda (k) 1936 (lambda (k)
1934 (calc-user-function-classify (car k)))) 1937 (calc-user-function-classify (car k))))
@@ -2003,12 +2006,13 @@ calc-kill calc-kill-region calc-yank))))
2003;;;; Caches. 2006;;;; Caches.
2004 2007
2005(defmacro math-defcache (name init form) 2008(defmacro math-defcache (name init form)
2009 (declare (indent 2) (debug (symbolp sexp form)))
2006 (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec"))) 2010 (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec")))
2007 (cache-val (intern (concat (symbol-name name) "-cache"))) 2011 (cache-val (intern (concat (symbol-name name) "-cache")))
2008 (last-prec (intern (concat (symbol-name name) "-last-prec"))) 2012 (last-prec (intern (concat (symbol-name name) "-last-prec")))
2009 (last-val (intern (concat (symbol-name name) "-last")))) 2013 (last-val (intern (concat (symbol-name name) "-last"))))
2010 `(progn 2014 `(progn
2011; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) 2015 ;; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
2012 (defvar ,cache-prec (cond 2016 (defvar ,cache-prec (cond
2013 ((consp ,init) (math-numdigs (nth 1 ,init))) 2017 ((consp ,init) (math-numdigs (nth 1 ,init)))
2014 (,init 2018 (,init
@@ -2037,7 +2041,6 @@ calc-kill calc-kill-region calc-yank))))
2037 ,cache-val)) 2041 ,cache-val))
2038 ,last-prec calc-internal-prec)) 2042 ,last-prec calc-internal-prec))
2039 ,last-val)))) 2043 ,last-val))))
2040(put 'math-defcache 'lisp-indent-hook 2)
2041 2044
2042;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] 2045;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
2043(defconst math-approx-pi 2046(defconst math-approx-pi
@@ -2400,7 +2403,7 @@ If X is not an error form, return 1."
2400 (list 'calcFunc-intv mask lo hi) 2403 (list 'calcFunc-intv mask lo hi)
2401 (math-make-intv mask lo hi)))) 2404 (math-make-intv mask lo hi))))
2402 ((eq (car a) 'vec) 2405 ((eq (car a) 'vec)
2403 (cons 'vec (mapcar 'math-normalize (cdr a)))) 2406 (cons 'vec (mapcar #'math-normalize (cdr a))))
2404 ((eq (car a) 'quote) 2407 ((eq (car a) 'quote)
2405 (math-normalize (nth 1 a))) 2408 (math-normalize (nth 1 a)))
2406 ((eq (car a) 'special-const) 2409 ((eq (car a) 'special-const)
@@ -2412,7 +2415,7 @@ If X is not an error form, return 1."
2412 (math-normalize-logical-op a)) 2415 (math-normalize-logical-op a))
2413 ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition)) 2416 ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition))
2414 (let ((calc-simplify-mode 'none)) 2417 (let ((calc-simplify-mode 'none))
2415 (cons (car a) (mapcar 'math-normalize (cdr a))))) 2418 (cons (car a) (mapcar #'math-normalize (cdr a)))))
2416 ((eq (car a) 'calcFunc-evalto) 2419 ((eq (car a) 'calcFunc-evalto)
2417 (setq a (or (nth 1 a) 0)) 2420 (setq a (or (nth 1 a) 0))
2418 (or calc-refreshing-evaltos 2421 (or calc-refreshing-evaltos
@@ -2435,27 +2438,25 @@ If X is not an error form, return 1."
2435;; The variable math-normalize-a is local to math-normalize in calc.el, 2438;; The variable math-normalize-a is local to math-normalize in calc.el,
2436;; but is used by math-normalize-nonstandard, which is called by 2439;; but is used by math-normalize-nonstandard, which is called by
2437;; math-normalize. 2440;; math-normalize.
2438(defvar math-normalize-a) 2441(defun math-normalize-nonstandard (a)
2439
2440(defun math-normalize-nonstandard ()
2441 (if (consp calc-simplify-mode) 2442 (if (consp calc-simplify-mode)
2442 (progn 2443 (progn
2443 (setq calc-simplify-mode 'none 2444 (setq calc-simplify-mode 'none
2444 math-simplify-only (car-safe (cdr-safe math-normalize-a))) 2445 math-simplify-only (car-safe (cdr-safe a)))
2445 nil) 2446 nil)
2446 (and (symbolp (car math-normalize-a)) 2447 (and (symbolp (car a))
2447 (or (eq calc-simplify-mode 'none) 2448 (or (eq calc-simplify-mode 'none)
2448 (and (eq calc-simplify-mode 'num) 2449 (and (eq calc-simplify-mode 'num)
2449 (let ((aptr (setq math-normalize-a 2450 (let ((aptr (setq a
2450 (cons 2451 (cons
2451 (car math-normalize-a) 2452 (car a)
2452 (mapcar 'math-normalize 2453 (mapcar #'math-normalize
2453 (cdr math-normalize-a)))))) 2454 (cdr a))))))
2454 (while (and aptr (math-constp (car aptr))) 2455 (while (and aptr (math-constp (car aptr)))
2455 (setq aptr (cdr aptr))) 2456 (setq aptr (cdr aptr)))
2456 aptr))) 2457 aptr)))
2457 (cons (car math-normalize-a) 2458 (cons (car a)
2458 (mapcar 'math-normalize (cdr math-normalize-a)))))) 2459 (mapcar #'math-normalize (cdr a))))))
2459 2460
2460 2461
2461;;; Normalize a bignum digit list by trimming high-end zeros. [L l] 2462;;; 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."
2808 x) 2809 x)
2809 (if (Math-primp x) 2810 (if (Math-primp x)
2810 x 2811 x
2811 (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x)))))) 2812 (cons (car x) (mapcar #'math-evaluate-expr-rec (cdr x))))))
2812 x)) 2813 x))
2813 2814
2814(defun math-any-floats (expr) 2815(defun math-any-floats (expr)
@@ -2822,9 +2823,10 @@ If X is not an error form, return 1."
2822(defvar math-mt-many nil) 2823(defvar math-mt-many nil)
2823(defvar math-mt-func nil) 2824(defvar math-mt-func nil)
2824 2825
2825(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) 2826(defun math-map-tree (func mmt-expr &optional many)
2826 (or math-mt-many (setq math-mt-many 1000000)) 2827 (let ((math-mt-func func)
2827 (math-map-tree-rec mmt-expr)) 2828 (math-mt-many (or many 1000000)))
2829 (math-map-tree-rec mmt-expr)))
2828 2830
2829(defun math-map-tree-rec (mmt-expr) 2831(defun math-map-tree-rec (mmt-expr)
2830 (or (= math-mt-many 0) 2832 (or (= math-mt-many 0)
@@ -2842,7 +2844,7 @@ If X is not an error form, return 1."
2842 (<= math-mt-many 0)) 2844 (<= math-mt-many 0))
2843 (setq mmt-done t) 2845 (setq mmt-done t)
2844 (setq mmt-nextval (cons (car mmt-expr) 2846 (setq mmt-nextval (cons (car mmt-expr)
2845 (mapcar 'math-map-tree-rec 2847 (mapcar #'math-map-tree-rec
2846 (cdr mmt-expr)))) 2848 (cdr mmt-expr))))
2847 (if (equal mmt-nextval mmt-expr) 2849 (if (equal mmt-nextval mmt-expr)
2848 (setq mmt-done t) 2850 (setq mmt-done t)
@@ -2867,6 +2869,7 @@ If X is not an error form, return 1."
2867(defvar math-integral-cache) 2869(defvar math-integral-cache)
2868 2870
2869(defmacro math-defintegral (funcs &rest code) 2871(defmacro math-defintegral (funcs &rest code)
2872 (declare (indent 1) (debug (sexp body)))
2870 (setq math-integral-cache nil) 2873 (setq math-integral-cache nil)
2871 (cons 'progn 2874 (cons 'progn
2872 (mapcar #'(lambda (func) 2875 (mapcar #'(lambda (func)
@@ -2876,9 +2879,9 @@ If X is not an error form, return 1."
2876 (list 2879 (list
2877 #'(lambda (u) ,@code))))) 2880 #'(lambda (u) ,@code)))))
2878 (if (symbolp funcs) (list funcs) funcs)))) 2881 (if (symbolp funcs) (list funcs) funcs))))
2879(put 'math-defintegral 'lisp-indent-hook 1)
2880 2882
2881(defmacro math-defintegral-2 (funcs &rest code) 2883(defmacro math-defintegral-2 (funcs &rest code)
2884 (declare (indent 1) (debug (sexp body)))
2882 (setq math-integral-cache nil) 2885 (setq math-integral-cache nil)
2883 (cons 'progn 2886 (cons 'progn
2884 (mapcar #'(lambda (func) 2887 (mapcar #'(lambda (func)
@@ -2887,7 +2890,6 @@ If X is not an error form, return 1."
2887 (get ',func 'math-integral-2) 2890 (get ',func 'math-integral-2)
2888 (list #'(lambda (u v) ,@code))))) 2891 (list #'(lambda (u v) ,@code)))))
2889 (if (symbolp funcs) (list funcs) funcs)))) 2892 (if (symbolp funcs) (list funcs) funcs))))
2890(put 'math-defintegral-2 'lisp-indent-hook 1)
2891 2893
2892(defvar var-IntegAfterRules 'calc-IntegAfterRules) 2894(defvar var-IntegAfterRules 'calc-IntegAfterRules)
2893 2895
@@ -3097,9 +3099,16 @@ If X is not an error form, return 1."
3097;;; Expression parsing. 3099;;; Expression parsing.
3098 3100
3099(defvar math-expr-data) 3101(defvar math-expr-data)
3102(defvar math-exp-pos)
3103(defvar math-exp-old-pos)
3104(defvar math-exp-keep-spaces)
3105(defvar math-exp-token)
3106(defvar math-expr-data)
3107(defvar math-exp-str)
3100 3108
3101(defun math-read-expr (math-exp-str) 3109(defun math-read-expr (str)
3102 (let ((math-exp-pos 0) 3110 (let ((math-exp-pos 0)
3111 (math-exp-str str)
3103 (math-exp-old-pos 0) 3112 (math-exp-old-pos 0)
3104 (math-exp-keep-spaces nil) 3113 (math-exp-keep-spaces nil)
3105 math-exp-token math-expr-data) 3114 math-exp-token math-expr-data)
@@ -3138,6 +3147,10 @@ If X is not an error form, return 1."
3138 3147
3139;;; They said it couldn't be done... 3148;;; They said it couldn't be done...
3140 3149
3150(defvar math-read-big-baseline)
3151(defvar math-read-big-h2)
3152(defvar math-read-big-err-msg)
3153
3141(defun math-read-big-expr (str) 3154(defun math-read-big-expr (str)
3142 (and (> (length calc-left-label) 0) 3155 (and (> (length calc-left-label) 0)
3143 (string-match (concat "^" (regexp-quote calc-left-label)) str) 3156 (string-match (concat "^" (regexp-quote calc-left-label)) str)
@@ -3179,6 +3192,8 @@ If X is not an error form, return 1."
3179 '(error 0 "Syntax error")) 3192 '(error 0 "Syntax error"))
3180 (math-read-expr str))))) 3193 (math-read-expr str)))))
3181 3194
3195(defvar math-rb-h2)
3196
3182(defun math-read-big-bigp (math-read-big-lines) 3197(defun math-read-big-bigp (math-read-big-lines)
3183 (and (cdr math-read-big-lines) 3198 (and (cdr math-read-big-lines)
3184 (let ((matrix nil) 3199 (let ((matrix nil)
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index 4092aeec529..41083b77480 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -1,4 +1,4 @@
1;;; calc-poly.el --- polynomial functions for Calc 1;;; calc-poly.el --- polynomial functions for Calc -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. 3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
4 4
@@ -177,8 +177,8 @@
177 (math-add (car res) (math-div (cdr res) pd)))) 177 (math-add (car res) (math-div (cdr res) pd))))
178 178
179 179
180;;; Multiply two terms, expanding out products of sums.
181(defun math-mul-thru (lhs rhs) 180(defun math-mul-thru (lhs rhs)
181 "Multiply two terms, expanding out products of sums."
182 (if (memq (car-safe lhs) '(+ -)) 182 (if (memq (car-safe lhs) '(+ -))
183 (list (car lhs) 183 (list (car lhs)
184 (math-mul-thru (nth 1 lhs) rhs) 184 (math-mul-thru (nth 1 lhs) rhs)
@@ -197,8 +197,8 @@
197 (math-div num den))) 197 (math-div num den)))
198 198
199 199
200;;; Sort the terms of a sum into canonical order.
201(defun math-sort-terms (expr) 200(defun math-sort-terms (expr)
201 "Sort the terms of a sum into canonical order."
202 (if (memq (car-safe expr) '(+ -)) 202 (if (memq (car-safe expr) '(+ -))
203 (math-list-to-sum 203 (math-list-to-sum
204 (sort (math-sum-to-list expr) 204 (sort (math-sum-to-list expr)
@@ -223,8 +223,8 @@
223 (math-sum-to-list (nth 2 tree) (not neg)))) 223 (math-sum-to-list (nth 2 tree) (not neg))))
224 (t (list (cons tree neg))))) 224 (t (list (cons tree neg)))))
225 225
226;;; Check if the polynomial coefficients are modulo forms.
227(defun math-poly-modulus (expr &optional expr2) 226(defun math-poly-modulus (expr &optional expr2)
227 "Check if the polynomial coefficients are modulo forms."
228 (or (math-poly-modulus-rec expr) 228 (or (math-poly-modulus-rec expr)
229 (and expr2 (math-poly-modulus-rec expr2)) 229 (and expr2 (math-poly-modulus-rec expr2))
230 1)) 230 1))
@@ -237,12 +237,13 @@
237 (math-poly-modulus-rec (nth 2 expr)))))) 237 (math-poly-modulus-rec (nth 2 expr))))))
238 238
239 239
240;;; Divide two polynomials. Return (quotient . remainder).
241(defvar math-poly-div-base nil) 240(defvar math-poly-div-base nil)
242(defun math-poly-div (u v &optional math-poly-div-base) 241(defun math-poly-div (u v &optional div-base)
243 (if math-poly-div-base 242 "Divide two polynomials. Return (quotient . remainder)."
244 (math-do-poly-div u v) 243 (let ((math-poly-div-base div-base))
245 (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))) 244 (if div-base
245 (math-do-poly-div u v)
246 (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))))
246 247
247(defun math-poly-div-exact (u v &optional base) 248(defun math-poly-div-exact (u v &optional base)
248 (let ((res (math-poly-div u v base))) 249 (let ((res (math-poly-div u v base)))
@@ -308,8 +309,8 @@
308 (math-div (math-build-polynomial-expr (cdr res) base) 309 (math-div (math-build-polynomial-expr (cdr res) base)
309 v))))))) 310 v)))))))
310 311
311;;; Divide two polynomials in coefficient-list form. Return (quot . rem).
312(defun math-poly-div-coefs (u v) 312(defun math-poly-div-coefs (u v)
313 "Divide two polynomials in coefficient-list form. Return (quot . rem)."
313 (cond ((null v) (math-reject-arg nil "Division by zero")) 314 (cond ((null v) (math-reject-arg nil "Division by zero"))
314 ((< (length u) (length v)) (cons nil u)) 315 ((< (length u) (length v)) (cons nil u))
315 ((cdr u) 316 ((cdr u)
@@ -334,9 +335,9 @@
334 (cons (list (math-poly-div-rec (car u) (car v))) 335 (cons (list (math-poly-div-rec (car u) (car v)))
335 nil)))) 336 nil))))
336 337
337;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.)
338;;; This returns only the remainder from the pseudo-division.
339(defun math-poly-pseudo-div (u v) 338(defun math-poly-pseudo-div (u v)
339 "Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.)
340This returns only the remainder from the pseudo-division."
340 (cond ((null v) nil) 341 (cond ((null v) nil)
341 ((< (length u) (length v)) u) 342 ((< (length u) (length v)) u)
342 ((or (cdr u) (cdr v)) 343 ((or (cdr u) (cdr v))
@@ -359,8 +360,8 @@
359 (nreverse (mapcar 'math-simplify urev)))) 360 (nreverse (mapcar 'math-simplify urev))))
360 (t nil))) 361 (t nil)))
361 362
362;;; Compute the GCD of two multivariate polynomials.
363(defun math-poly-gcd (u v) 363(defun math-poly-gcd (u v)
364 "Compute the GCD of two multivariate polynomials."
364 (cond ((Math-equal u v) u) 365 (cond ((Math-equal u v) u)
365 ((math-constp u) 366 ((math-constp u)
366 (if (Math-zerop u) 367 (if (Math-zerop u)
@@ -423,7 +424,7 @@
423(defun math-poly-gcd-coefs (u v) 424(defun math-poly-gcd-coefs (u v)
424 (let ((d (math-poly-gcd (math-poly-gcd-list u) 425 (let ((d (math-poly-gcd (math-poly-gcd-list u)
425 (math-poly-gcd-list v))) 426 (math-poly-gcd-list v)))
426 (g 1) (h 1) (z 0) hh r delta ghd) 427 (g 1) (h 1) (z 0) r delta)
427 (while (and u v (Math-zerop (car u)) (Math-zerop (car v))) 428 (while (and u v (Math-zerop (car u)) (Math-zerop (car v)))
428 (setq u (cdr u) v (cdr v) z (1+ z))) 429 (setq u (cdr u) v (cdr v) z (1+ z)))
429 (or (eq d 1) 430 (or (eq d 1)
@@ -452,8 +453,8 @@
452 v)) 453 v))
453 454
454 455
455;;; Return true if is a factor containing no sums or quotients.
456(defun math-atomic-factorp (expr) 456(defun math-atomic-factorp (expr)
457 "Return true if is a factor containing no sums or quotients."
457 (cond ((eq (car-safe expr) '*) 458 (cond ((eq (car-safe expr) '*)
458 (and (math-atomic-factorp (nth 1 expr)) 459 (and (math-atomic-factorp (nth 1 expr))
459 (math-atomic-factorp (nth 2 expr)))) 460 (math-atomic-factorp (nth 2 expr))))
@@ -463,14 +464,13 @@
463 (math-atomic-factorp (nth 1 expr))) 464 (math-atomic-factorp (nth 1 expr)))
464 (t t))) 465 (t t)))
465 466
466;;; Find a suitable base for dividing a by b.
467;;; The base must exist in both expressions.
468;;; The degree in the numerator must be higher or equal than the
469;;; degree in the denominator.
470;;; If the above conditions are not met the quotient is just a remainder.
471;;; Return nil if this is the case.
472
473(defun math-poly-div-base (a b) 467(defun math-poly-div-base (a b)
468 "Find a suitable base for dividing a by b.
469The base must exist in both expressions.
470The degree in the numerator must be higher or equal than the
471degree in the denominator.
472If the above conditions are not met the quotient is just a remainder.
473Return nil if this is the case."
474 (let (a-base b-base) 474 (let (a-base b-base)
475 (and (setq a-base (math-total-polynomial-base a)) 475 (and (setq a-base (math-total-polynomial-base a))
476 (setq b-base (math-total-polynomial-base b)) 476 (setq b-base (math-total-polynomial-base b))
@@ -482,12 +482,11 @@
482 (throw 'return (car (car a-base)))))) 482 (throw 'return (car (car a-base))))))
483 (setq a-base (cdr a-base))))))) 483 (setq a-base (cdr a-base)))))))
484 484
485;;; Same as above but for gcd algorithm.
486;;; Here there is no requirement that degree(a) > degree(b).
487;;; Take the base that has the highest degree considering both a and b.
488;;; ("a^20+b^21+x^3+a+b", "a+b^2+x^5+a^22+b^10") --> (a 22)
489
490(defun math-poly-gcd-base (a b) 485(defun math-poly-gcd-base (a b)
486 "Same as `math-poly-div-base' but for gcd algorithm.
487Here there is no requirement that degree(a) > degree(b).
488Take the base that has the highest degree considering both a and b.
489 (\"a^20+b^21+x^3+a+b\", \"a+b^2+x^5+a^22+b^10\") --> (a 22)"
491 (let (a-base b-base) 490 (let (a-base b-base)
492 (and (setq a-base (math-total-polynomial-base a)) 491 (and (setq a-base (math-total-polynomial-base a))
493 (setq b-base (math-total-polynomial-base b)) 492 (setq b-base (math-total-polynomial-base b))
@@ -501,8 +500,8 @@
501 (throw 'return (car (car b-base))) 500 (throw 'return (car (car b-base)))
502 (setq b-base (cdr b-base))))))))) 501 (setq b-base (cdr b-base)))))))))
503 502
504;;; Sort a list of polynomial bases.
505(defun math-sort-poly-base-list (lst) 503(defun math-sort-poly-base-list (lst)
504 "Sort a list of polynomial bases."
506 (sort lst (function (lambda (a b) 505 (sort lst (function (lambda (a b)
507 (or (> (nth 1 a) (nth 1 b)) 506 (or (> (nth 1 a) (nth 1 b))
508 (and (= (nth 1 a) (nth 1 b)) 507 (and (= (nth 1 a) (nth 1 b))
@@ -511,10 +510,11 @@
511;;; Given an expression find all variables that are polynomial bases. 510;;; Given an expression find all variables that are polynomial bases.
512;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). 511;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
513 512
514;; The variable math-poly-base-total-base is local to 513;; The variable math-poly-base-total-base and math-poly-base-top-expr are local
515;; math-total-polynomial-base, but is used by math-polynomial-p1, 514;; to math-total-polynomial-base, but used by math-polynomial-p1, which is
516;; which is called by math-total-polynomial-base. 515;; called by math-total-polynomial-base.
517(defvar math-poly-base-total-base) 516(defvar math-poly-base-total-base)
517(defvar math-poly-base-top-expr)
518 518
519(defun math-total-polynomial-base (expr) 519(defun math-total-polynomial-base (expr)
520 (let ((math-poly-base-total-base nil) 520 (let ((math-poly-base-total-base nil)
@@ -522,11 +522,6 @@
522 (math-polynomial-base expr #'math-polynomial-p1) 522 (math-polynomial-base expr #'math-polynomial-p1)
523 (math-sort-poly-base-list math-poly-base-total-base))) 523 (math-sort-poly-base-list math-poly-base-total-base)))
524 524
525;; The variable math-poly-base-top-expr is local to math-polynomial-base
526;; in calc-alg.el, but is used by math-polynomial-p1 which is called
527;; by math-polynomial-base.
528(defvar math-poly-base-top-expr)
529
530(defun math-polynomial-p1 (subexpr) 525(defun math-polynomial-p1 (subexpr)
531 (or (assoc subexpr math-poly-base-total-base) 526 (or (assoc subexpr math-poly-base-total-base)
532 (memq (car subexpr) '(+ - * / neg)) 527 (memq (car subexpr) '(+ - * / neg))
@@ -555,28 +550,30 @@
555;; called (indirectly) by calcFunc-factors and calcFunc-factor. 550;; called (indirectly) by calcFunc-factors and calcFunc-factor.
556(defvar math-to-list) 551(defvar math-to-list)
557 552
558(defun calcFunc-factors (math-fact-expr &optional var) 553(defun calcFunc-factors (expr &optional var)
559 (let ((math-factored-vars (if var t nil)) 554 (let ((math-factored-vars (if var t nil))
560 (math-to-list t) 555 (math-to-list t)
561 (calc-prefer-frac t)) 556 (calc-prefer-frac t))
562 (or var 557 (or var
563 (setq var (math-polynomial-base math-fact-expr))) 558 (setq var (math-polynomial-base expr)))
564 (let ((res (math-factor-finish 559 (let ((res (math-factor-finish
565 (or (catch 'factor (math-factor-expr-try var)) 560 (or (catch 'factor
566 math-fact-expr)))) 561 (let ((math-fact-expr expr)) (math-factor-expr-try var)))
562 expr))))
567 (math-simplify (if (math-vectorp res) 563 (math-simplify (if (math-vectorp res)
568 res 564 res
569 (list 'vec (list 'vec res 1))))))) 565 (list 'vec (list 'vec res 1)))))))
570 566
571(defun calcFunc-factor (math-fact-expr &optional var) 567(defun calcFunc-factor (expr &optional var)
572 (let ((math-factored-vars nil) 568 (let ((math-factored-vars nil)
573 (math-to-list nil) 569 (math-to-list nil)
574 (calc-prefer-frac t)) 570 (calc-prefer-frac t))
575 (math-simplify (math-factor-finish 571 (math-simplify (math-factor-finish
576 (if var 572 (if var
577 (let ((math-factored-vars t)) 573 (let ((math-factored-vars t)
578 (or (catch 'factor (math-factor-expr-try var)) math-fact-expr)) 574 (math-fact-expr expr))
579 (math-factor-expr math-fact-expr)))))) 575 (or (catch 'factor (math-factor-expr-try var)) expr))
576 (math-factor-expr expr))))))
580 577
581(defun math-factor-finish (x) 578(defun math-factor-finish (x)
582 (if (Math-primp x) 579 (if (Math-primp x)
@@ -590,18 +587,19 @@
590 (list 'calcFunc-Fac-Prot x) 587 (list 'calcFunc-Fac-Prot x)
591 x)) 588 x))
592 589
593(defun math-factor-expr (math-fact-expr) 590(defun math-factor-expr (expr)
594 (cond ((eq math-factored-vars t) math-fact-expr) 591 (cond ((eq math-factored-vars t) expr)
595 ((or (memq (car-safe math-fact-expr) '(* / ^ neg)) 592 ((or (memq (car-safe expr) '(* / ^ neg))
596 (assq (car-safe math-fact-expr) calc-tweak-eqn-table)) 593 (assq (car-safe expr) calc-tweak-eqn-table))
597 (cons (car math-fact-expr) (mapcar 'math-factor-expr (cdr math-fact-expr)))) 594 (cons (car expr) (mapcar 'math-factor-expr (cdr expr))))
598 ((memq (car-safe math-fact-expr) '(+ -)) 595 ((memq (car-safe expr) '(+ -))
599 (let* ((math-factored-vars math-factored-vars) 596 (let* ((math-factored-vars math-factored-vars)
600 (y (catch 'factor (math-factor-expr-part math-fact-expr)))) 597 (y (catch 'factor (let ((math-fact-expr expr))
598 (math-factor-expr-part expr)))))
601 (if y 599 (if y
602 (math-factor-expr y) 600 (math-factor-expr y)
603 math-fact-expr))) 601 expr)))
604 (t math-fact-expr))) 602 (t expr)))
605 603
606(defun math-factor-expr-part (x) ; uses "expr" 604(defun math-factor-expr-part (x) ; uses "expr"
607 (if (memq (car-safe x) '(+ - * / ^ neg)) 605 (if (memq (car-safe x) '(+ - * / ^ neg))
@@ -617,20 +615,20 @@
617;; used by math-factor-poly-coefs, which is called by math-factor-expr-try. 615;; used by math-factor-poly-coefs, which is called by math-factor-expr-try.
618(defvar math-fet-x) 616(defvar math-fet-x)
619 617
620(defun math-factor-expr-try (math-fet-x) 618(defun math-factor-expr-try (x)
621 (if (eq (car-safe math-fact-expr) '*) 619 (if (eq (car-safe math-fact-expr) '*)
622 (let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr))) 620 (let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr)))
623 (math-factor-expr-try math-fet-x)))) 621 (math-factor-expr-try x))))
624 (res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr))) 622 (res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr)))
625 (math-factor-expr-try math-fet-x))))) 623 (math-factor-expr-try x)))))
626 (and (or res1 res2) 624 (and (or res1 res2)
627 (throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1 625 (throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1
628 (or res2 (nth 2 math-fact-expr)))))) 626 (or res2 (nth 2 math-fact-expr))))))
629 (let* ((p (math-is-polynomial math-fact-expr math-fet-x 30 'gen)) 627 (let* ((p (math-is-polynomial math-fact-expr x 30 'gen))
630 (math-poly-modulus (math-poly-modulus math-fact-expr)) 628 (math-poly-modulus (math-poly-modulus math-fact-expr))
631 res) 629 res)
632 (and (cdr p) 630 (and (cdr p)
633 (setq res (math-factor-poly-coefs p)) 631 (setq res (let ((math-fet-x x)) (math-factor-poly-coefs p)))
634 (throw 'factor res))))) 632 (throw 'factor res)))))
635 633
636(defun math-accum-factors (fac pow facs) 634(defun math-accum-factors (fac pow facs)
@@ -736,7 +734,6 @@
736 (let ((roots (car t1)) 734 (let ((roots (car t1))
737 (csign (if (math-negp (nth (1- (length p)) p)) -1 1)) 735 (csign (if (math-negp (nth (1- (length p)) p)) -1 1))
738 (expr 1) 736 (expr 1)
739 (unfac (nth 1 t1))
740 (scale (nth 2 t1))) 737 (scale (nth 2 t1)))
741 (while roots 738 (while roots
742 (let ((coef0 (car (car roots))) 739 (let ((coef0 (car (car roots)))
@@ -1109,7 +1106,7 @@ If no partial fraction representation can be found, return nil."
1109 (t expr))) 1106 (t expr)))
1110 1107
1111(defun calcFunc-expand (expr &optional many) 1108(defun calcFunc-expand (expr &optional many)
1112 (math-normalize (math-map-tree 'math-expand-term expr many))) 1109 (math-normalize (math-map-tree #'math-expand-term expr many)))
1113 1110
1114(defun math-expand-power (x n &optional var else-nil) 1111(defun math-expand-power (x n &optional var else-nil)
1115 (or (and (natnump n) 1112 (or (and (natnump n)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index c79db821eb6..f155b8283b7 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1,4 +1,4 @@
1;;; calc.el --- the GNU Emacs calculator 1;;; calc.el --- the GNU Emacs calculator -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. 3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
4 4
@@ -178,7 +178,7 @@
178(declare-function math-read-radix-digit "calc-misc" (dig)) 178(declare-function math-read-radix-digit "calc-misc" (dig))
179(declare-function calc-digit-dots "calc-incom" ()) 179(declare-function calc-digit-dots "calc-incom" ())
180(declare-function math-normalize-fancy "calc-ext" (a)) 180(declare-function math-normalize-fancy "calc-ext" (a))
181(declare-function math-normalize-nonstandard "calc-ext" ()) 181(declare-function math-normalize-nonstandard "calc-ext" (a))
182(declare-function math-recompile-eval-rules "calc-alg" ()) 182(declare-function math-recompile-eval-rules "calc-alg" ())
183(declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset)) 183(declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset))
184(declare-function calc-record-why "calc-misc" (&rest stuff)) 184(declare-function calc-record-why "calc-misc" (&rest stuff))
@@ -203,7 +203,7 @@
203(declare-function math-compose-expr "calccomp" (a prec &optional div)) 203(declare-function math-compose-expr "calccomp" (a prec &optional div))
204(declare-function math-comp-width "calccomp" (c)) 204(declare-function math-comp-width "calccomp" (c))
205(declare-function math-composition-to-string "calccomp" (c &optional width)) 205(declare-function math-composition-to-string "calccomp" (c &optional width))
206(declare-function math-stack-value-offset-fancy "calccomp" ()) 206(declare-function math-stack-value-offset-fancy "calccomp" (c))
207(declare-function math-format-flat-expr-fancy "calc-ext" (a prec)) 207(declare-function math-format-flat-expr-fancy "calc-ext" (a prec))
208(declare-function math-adjust-fraction "calc-ext" (a)) 208(declare-function math-adjust-fraction "calc-ext" (a))
209(declare-function math-format-binary "calc-bin" (a)) 209(declare-function math-format-binary "calc-bin" (a))
@@ -1331,16 +1331,17 @@ Notations: 3.14e6 3.14 * 10^6
1331" 1331"
1332 (interactive) 1332 (interactive)
1333 (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? 1333 (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
1334 (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) 1334 (lambda (v) (set-default v (symbol-value v))))
1335 calc-local-var-list)
1335 (kill-all-local-variables) 1336 (kill-all-local-variables)
1336 (use-local-map (if (eq calc-algebraic-mode 'total) 1337 (use-local-map (if (eq calc-algebraic-mode 'total)
1337 (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) 1338 (progn (require 'calc-ext) calc-alg-map) calc-mode-map))
1338 (mapc #'make-local-variable calc-local-var-list) 1339 (mapc #'make-local-variable calc-local-var-list)
1339 (make-local-variable 'overlay-arrow-position) 1340 (make-local-variable 'overlay-arrow-position)
1340 (make-local-variable 'overlay-arrow-string) 1341 (make-local-variable 'overlay-arrow-string)
1341 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) 1342 (add-hook 'change-major-mode-hook #'font-lock-defontify nil t)
1342 (add-hook 'kill-buffer-query-functions 1343 (add-hook 'kill-buffer-query-functions
1343 'calc-kill-stack-buffer 1344 #'calc-kill-stack-buffer
1344 t t) 1345 t t)
1345 (setq truncate-lines t) 1346 (setq truncate-lines t)
1346 (setq buffer-read-only t) 1347 (setq buffer-read-only t)
@@ -1795,7 +1796,7 @@ See calc-keypad for details."
1795 (if calc-hyperbolic-flag "Hyp " "") 1796 (if calc-hyperbolic-flag "Hyp " "")
1796 (if calc-keep-args-flag "Keep " "") 1797 (if calc-keep-args-flag "Keep " "")
1797 (if (/= calc-stack-top 1) "Narrow " "") 1798 (if (/= calc-stack-top 1) "Narrow " "")
1798 (apply 'concat calc-other-modes))))) 1799 (apply #'concat calc-other-modes)))))
1799 (if (equal new-mode-string mode-line-buffer-identification) 1800 (if (equal new-mode-string mode-line-buffer-identification)
1800 nil 1801 nil
1801 (setq mode-line-buffer-identification new-mode-string) 1802 (setq mode-line-buffer-identification new-mode-string)
@@ -1869,7 +1870,7 @@ See calc-keypad for details."
1869 (if (and (consp vals) 1870 (if (and (consp vals)
1870 (or (integerp (car vals)) 1871 (or (integerp (car vals))
1871 (consp (car vals)))) 1872 (consp (car vals))))
1872 (setq vals (mapcar 'calc-normalize vals)) 1873 (setq vals (mapcar #'calc-normalize vals))
1873 (setq vals (calc-normalize vals))) 1874 (setq vals (calc-normalize vals)))
1874 (or (and (consp vals) 1875 (or (and (consp vals)
1875 (or (integerp (car vals)) 1876 (or (integerp (car vals))
@@ -1952,8 +1953,8 @@ See calc-keypad for details."
1952 (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top))))) 1953 (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top)))))
1953 1954
1954(defun calc-top-list-n (&optional n m sel-mode) 1955(defun calc-top-list-n (&optional n m sel-mode)
1955 (mapcar 'math-check-complete 1956 (mapcar #'math-check-complete
1956 (mapcar 'calc-normalize (calc-top-list n m sel-mode)))) 1957 (mapcar #'calc-normalize (calc-top-list n m sel-mode))))
1957 1958
1958 1959
1959(defun calc-renumber-stack () 1960(defun calc-renumber-stack ()
@@ -2207,7 +2208,7 @@ the United States."
2207 (setq calc-aborted-prefix name) 2208 (setq calc-aborted-prefix name)
2208 (if (null arg) 2209 (if (null arg)
2209 (calc-enter-result 2 name (cons (or func2 func) 2210 (calc-enter-result 2 name (cons (or func2 func)
2210 (mapcar 'math-check-complete 2211 (mapcar #'math-check-complete
2211 (calc-top-list 2)))) 2212 (calc-top-list 2))))
2212 (require 'calc-ext) 2213 (require 'calc-ext)
2213 (calc-binary-op-fancy name func arg ident unary))) 2214 (calc-binary-op-fancy name func arg ident unary)))
@@ -2619,78 +2620,78 @@ largest Emacs integer.")
2619(defvar math-eval-rules-cache-other) 2620(defvar math-eval-rules-cache-other)
2620;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] 2621;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
2621 2622
2622(defvar math-normalize-a)
2623(defvar math-normalize-error nil 2623(defvar math-normalize-error nil
2624 "Non-nil if the last call the `math-normalize' returned an error.") 2624 "Non-nil if the last call the `math-normalize' returned an error.")
2625 2625
2626(defun math-normalize (math-normalize-a) 2626(defun math-normalize (a)
2627 (setq math-normalize-error nil) 2627 (setq math-normalize-error nil)
2628 (cond 2628 (cond
2629 ((not (consp math-normalize-a)) 2629 ((not (consp a))
2630 (if (integerp math-normalize-a) 2630 (if (integerp a)
2631 (if (or (>= math-normalize-a math-small-integer-size) 2631 (if (or (>= a math-small-integer-size)
2632 (<= math-normalize-a (- math-small-integer-size))) 2632 (<= a (- math-small-integer-size)))
2633 (math-bignum math-normalize-a) 2633 (math-bignum a)
2634 math-normalize-a) 2634 a)
2635 math-normalize-a)) 2635 a))
2636 ((eq (car math-normalize-a) 'bigpos) 2636 ((eq (car a) 'bigpos)
2637 (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) 2637 (if (eq (nth (1- (length a)) a) 0)
2638 (let* ((last (setq math-normalize-a 2638 (let* ((last (setq a
2639 (copy-sequence math-normalize-a))) (digs math-normalize-a)) 2639 (copy-sequence a)))
2640 (digs a))
2640 (while (setq digs (cdr digs)) 2641 (while (setq digs (cdr digs))
2641 (or (eq (car digs) 0) (setq last digs))) 2642 (or (eq (car digs) 0) (setq last digs)))
2642 (setcdr last nil))) 2643 (setcdr last nil)))
2643 (if (cdr (cdr (cdr math-normalize-a))) 2644 (if (cdr (cdr (cdr a)))
2644 math-normalize-a 2645 a
2645 (cond 2646 (cond
2646 ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) 2647 ((cdr (cdr a)) (+ (nth 1 a)
2647 (* (nth 2 math-normalize-a) 2648 (* (nth 2 a)
2648 math-bignum-digit-size))) 2649 math-bignum-digit-size)))
2649 ((cdr math-normalize-a) (nth 1 math-normalize-a)) 2650 ((cdr a) (nth 1 a))
2650 (t 0)))) 2651 (t 0))))
2651 ((eq (car math-normalize-a) 'bigneg) 2652 ((eq (car a) 'bigneg)
2652 (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) 2653 (if (eq (nth (1- (length a)) a) 0)
2653 (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) 2654 (let* ((last (setq a (copy-sequence a)))
2654 (digs math-normalize-a)) 2655 (digs a))
2655 (while (setq digs (cdr digs)) 2656 (while (setq digs (cdr digs))
2656 (or (eq (car digs) 0) (setq last digs))) 2657 (or (eq (car digs) 0) (setq last digs)))
2657 (setcdr last nil))) 2658 (setcdr last nil)))
2658 (if (cdr (cdr (cdr math-normalize-a))) 2659 (if (cdr (cdr (cdr a)))
2659 math-normalize-a 2660 a
2660 (cond 2661 (cond
2661 ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) 2662 ((cdr (cdr a)) (- (+ (nth 1 a)
2662 (* (nth 2 math-normalize-a) 2663 (* (nth 2 a)
2663 math-bignum-digit-size)))) 2664 math-bignum-digit-size))))
2664 ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) 2665 ((cdr a) (- (nth 1 a)))
2665 (t 0)))) 2666 (t 0))))
2666 ((eq (car math-normalize-a) 'float) 2667 ((eq (car a) 'float)
2667 (math-make-float (math-normalize (nth 1 math-normalize-a)) 2668 (math-make-float (math-normalize (nth 1 a))
2668 (nth 2 math-normalize-a))) 2669 (nth 2 a)))
2669 ((or (memq (car math-normalize-a) 2670 ((or (memq (car a)
2670 '(frac cplx polar hms date mod sdev intv vec var quote 2671 '(frac cplx polar hms date mod sdev intv vec var quote
2671 special-const calcFunc-if calcFunc-lambda 2672 special-const calcFunc-if calcFunc-lambda
2672 calcFunc-quote calcFunc-condition 2673 calcFunc-quote calcFunc-condition
2673 calcFunc-evalto)) 2674 calcFunc-evalto))
2674 (integerp (car math-normalize-a)) 2675 (integerp (car a))
2675 (and (consp (car math-normalize-a)) 2676 (and (consp (car a))
2676 (not (eq (car (car math-normalize-a)) 'lambda)))) 2677 (not (eq (car (car a)) 'lambda))))
2677 (require 'calc-ext) 2678 (require 'calc-ext)
2678 (math-normalize-fancy math-normalize-a)) 2679 (math-normalize-fancy a))
2679 (t 2680 (t
2680 (or (and calc-simplify-mode 2681 (or (and calc-simplify-mode
2681 (require 'calc-ext) 2682 (require 'calc-ext)
2682 (math-normalize-nonstandard)) 2683 (math-normalize-nonstandard a))
2683 (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) 2684 (let ((args (mapcar #'math-normalize (cdr a))))
2684 (or (condition-case err 2685 (or (condition-case err
2685 (let ((func 2686 (let ((func
2686 (assq (car math-normalize-a) '( ( + . math-add ) 2687 (assq (car a) '( ( + . math-add )
2687 ( - . math-sub ) 2688 ( - . math-sub )
2688 ( * . math-mul ) 2689 ( * . math-mul )
2689 ( / . math-div ) 2690 ( / . math-div )
2690 ( % . math-mod ) 2691 ( % . math-mod )
2691 ( ^ . math-pow ) 2692 ( ^ . math-pow )
2692 ( neg . math-neg ) 2693 ( neg . math-neg )
2693 ( | . math-concat ) )))) 2694 ( | . math-concat ) ))))
2694 (or (and var-EvalRules 2695 (or (and var-EvalRules
2695 (progn 2696 (progn
2696 (or (eq var-EvalRules math-eval-rules-cache-tag) 2697 (or (eq var-EvalRules math-eval-rules-cache-tag)
@@ -2698,59 +2699,59 @@ largest Emacs integer.")
2698 (require 'calc-ext) 2699 (require 'calc-ext)
2699 (math-recompile-eval-rules))) 2700 (math-recompile-eval-rules)))
2700 (and (or math-eval-rules-cache-other 2701 (and (or math-eval-rules-cache-other
2701 (assq (car math-normalize-a) 2702 (assq (car a)
2702 math-eval-rules-cache)) 2703 math-eval-rules-cache))
2703 (math-apply-rewrites 2704 (math-apply-rewrites
2704 (cons (car math-normalize-a) args) 2705 (cons (car a) args)
2705 (cdr math-eval-rules-cache) 2706 (cdr math-eval-rules-cache)
2706 nil math-eval-rules-cache)))) 2707 nil math-eval-rules-cache))))
2707 (if func 2708 (if func
2708 (apply (cdr func) args) 2709 (apply (cdr func) args)
2709 (and (or (consp (car math-normalize-a)) 2710 (and (or (consp (car a))
2710 (fboundp (car math-normalize-a)) 2711 (fboundp (car a))
2711 (and (not (featurep 'calc-ext)) 2712 (and (not (featurep 'calc-ext))
2712 (require 'calc-ext) 2713 (require 'calc-ext)
2713 (fboundp (car math-normalize-a)))) 2714 (fboundp (car a))))
2714 (apply (car math-normalize-a) args))))) 2715 (apply (car a) args)))))
2715 (wrong-number-of-arguments 2716 (wrong-number-of-arguments
2716 (setq math-normalize-error t) 2717 (setq math-normalize-error t)
2717 (calc-record-why "*Wrong number of arguments" 2718 (calc-record-why "*Wrong number of arguments"
2718 (cons (car math-normalize-a) args)) 2719 (cons (car a) args))
2719 nil) 2720 nil)
2720 (wrong-type-argument 2721 (wrong-type-argument
2721 (or calc-next-why 2722 (or calc-next-why
2722 (calc-record-why "Wrong type of argument" 2723 (calc-record-why "Wrong type of argument"
2723 (cons (car math-normalize-a) args))) 2724 (cons (car a) args)))
2724 nil) 2725 nil)
2725 (args-out-of-range 2726 (args-out-of-range
2726 (setq math-normalize-error t) 2727 (setq math-normalize-error t)
2727 (calc-record-why "*Argument out of range" 2728 (calc-record-why "*Argument out of range"
2728 (cons (car math-normalize-a) args)) 2729 (cons (car a) args))
2729 nil) 2730 nil)
2730 (inexact-result 2731 (inexact-result
2731 (calc-record-why "No exact representation for result" 2732 (calc-record-why "No exact representation for result"
2732 (cons (car math-normalize-a) args)) 2733 (cons (car a) args))
2733 nil) 2734 nil)
2734 (math-overflow 2735 (math-overflow
2735 (setq math-normalize-error t) 2736 (setq math-normalize-error t)
2736 (calc-record-why "*Floating-point overflow occurred" 2737 (calc-record-why "*Floating-point overflow occurred"
2737 (cons (car math-normalize-a) args)) 2738 (cons (car a) args))
2738 nil) 2739 nil)
2739 (math-underflow 2740 (math-underflow
2740 (setq math-normalize-error t) 2741 (setq math-normalize-error t)
2741 (calc-record-why "*Floating-point underflow occurred" 2742 (calc-record-why "*Floating-point underflow occurred"
2742 (cons (car math-normalize-a) args)) 2743 (cons (car a) args))
2743 nil) 2744 nil)
2744 (void-variable 2745 (void-variable
2745 (setq math-normalize-error t) 2746 (setq math-normalize-error t)
2746 (if (eq (nth 1 err) 'var-EvalRules) 2747 (if (eq (nth 1 err) 'var-EvalRules)
2747 (progn 2748 (progn
2748 (setq var-EvalRules nil) 2749 (setq var-EvalRules nil)
2749 (math-normalize (cons (car math-normalize-a) args))) 2750 (math-normalize (cons (car a) args)))
2750 (calc-record-why "*Variable is void" (nth 1 err))))) 2751 (calc-record-why "*Variable is void" (nth 1 err)))))
2751 (if (consp (car math-normalize-a)) 2752 (if (consp (car a))
2752 (math-dimension-error) 2753 (math-dimension-error)
2753 (cons (car math-normalize-a) args)))))))) 2754 (cons (car a) args))))))))
2754 2755
2755 2756
2756 2757
@@ -2834,7 +2835,7 @@ largest Emacs integer.")
2834 ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a))) 2835 ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a)))
2835 ((eq (car a) 'float) a) 2836 ((eq (car a) 'float) a)
2836 ((memq (car a) '(cplx polar vec hms date sdev mod)) 2837 ((memq (car a) '(cplx polar vec hms date sdev mod))
2837 (cons (car a) (mapcar 'math-float (cdr a)))) 2838 (cons (car a) (mapcar #'math-float (cdr a))))
2838 (t (math-float-fancy a)))) 2839 (t (math-float-fancy a))))
2839 2840
2840 2841
@@ -2845,7 +2846,7 @@ largest Emacs integer.")
2845 ((memq (car a) '(frac float)) 2846 ((memq (car a) '(frac float))
2846 (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) 2847 (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
2847 ((memq (car a) '(cplx vec hms date calcFunc-idn)) 2848 ((memq (car a) '(cplx vec hms date calcFunc-idn))
2848 (cons (car a) (mapcar 'math-neg (cdr a)))) 2849 (cons (car a) (mapcar #'math-neg (cdr a))))
2849 (t (math-neg-fancy a)))) 2850 (t (math-neg-fancy a))))
2850 2851
2851 2852
@@ -3425,22 +3426,21 @@ largest Emacs integer.")
3425 (setcar (cdr entry) (calc-count-lines s)) 3426 (setcar (cdr entry) (calc-count-lines s))
3426 s)) 3427 s))
3427 3428
3428;; The variables math-svo-c, math-svo-wid and math-svo-off are local 3429;; The variables math-svo-wid and math-svo-off are local
3429;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy 3430;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy
3430;; in calccomp.el. 3431;; in calccomp.el.
3431 3432
3432(defvar math-svo-c)
3433(defvar math-svo-wid) 3433(defvar math-svo-wid)
3434(defvar math-svo-off) 3434(defvar math-svo-off)
3435 3435
3436(defun math-stack-value-offset (math-svo-c) 3436(defun math-stack-value-offset (c)
3437 (let* ((num (if calc-line-numbering 4 0)) 3437 (let* ((num (if calc-line-numbering 4 0))
3438 (math-svo-wid (calc-window-width)) 3438 (math-svo-wid (calc-window-width))
3439 math-svo-off) 3439 math-svo-off)
3440 (if calc-display-just 3440 (if calc-display-just
3441 (progn 3441 (progn
3442 (require 'calc-ext) 3442 (require 'calc-ext)
3443 (math-stack-value-offset-fancy)) 3443 (math-stack-value-offset-fancy c))
3444 (setq math-svo-off (or calc-display-origin 0)) 3444 (setq math-svo-off (or calc-display-origin 0))
3445 (when (integerp calc-line-breaking) 3445 (when (integerp calc-line-breaking)
3446 (setq math-svo-wid calc-line-breaking))) 3446 (setq math-svo-wid calc-line-breaking)))
@@ -3873,7 +3873,7 @@ The prefix `calcFunc-' is added to the specified name to get the
3873actual Lisp function name. 3873actual Lisp function name.
3874 3874
3875See Info node `(calc)Defining Functions'." 3875See Info node `(calc)Defining Functions'."
3876 (declare (doc-string 3)) 3876 (declare (doc-string 3)) ;; FIXME: Edebug spec?
3877 (require 'calc-ext) 3877 (require 'calc-ext)
3878 (math-do-defmath func args body)) 3878 (math-do-defmath func args body))
3879 3879
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 858343aae93..75c7adc59ec 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1,4 +1,4 @@
1;;; calccomp.el --- composition functions for Calc 1;;; calccomp.el --- composition functions for Calc -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. 3;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc.
4 4
@@ -121,7 +121,8 @@
121 calc-lang-slash-idiv) 121 calc-lang-slash-idiv)
122 (math-float (nth 1 aa)) 122 (math-float (nth 1 aa))
123 (nth 1 aa)) 123 (nth 1 aa))
124 (nth 2 aa)) prec)) 124 (nth 2 aa))
125 prec))
125 (if (and (eq calc-language 'big) 126 (if (and (eq calc-language 'big)
126 (= (length (car calc-frac-format)) 1)) 127 (= (length (car calc-frac-format)) 1))
127 (let* ((aa (math-adjust-fraction a)) 128 (let* ((aa (math-adjust-fraction a))
@@ -202,8 +203,9 @@
202 (math-comp-comma-spc (or calc-vector-commas " ")) 203 (math-comp-comma-spc (or calc-vector-commas " "))
203 (math-comp-comma (or calc-vector-commas "")) 204 (math-comp-comma (or calc-vector-commas ""))
204 (math-comp-vector-prec (if (or (and calc-vector-commas 205 (math-comp-vector-prec (if (or (and calc-vector-commas
205 (math-vector-no-parens a)) 206 (math-vector-no-parens a))
206 (memq 'P calc-matrix-brackets)) 0 1000)) 207 (memq 'P calc-matrix-brackets))
208 0 1000))
207 (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright) 209 (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright)
208 ((eq calc-matrix-just 'center) 'vcent) 210 ((eq calc-matrix-just 'center) 'vcent)
209 (t 'vleft))) 211 (t 'vleft)))
@@ -803,8 +805,7 @@
803 ( % . calcFunc-mod ) 805 ( % . calcFunc-mod )
804 ( ^ . calcFunc-pow ) 806 ( ^ . calcFunc-pow )
805 ( neg . calcFunc-neg ) 807 ( neg . calcFunc-neg )
806 ( | . calcFunc-vconcat )))) 808 ( | . calcFunc-vconcat )))))
807 left right args)
808 (if func2 809 (if func2
809 (setq func (cdr func2))) 810 (setq func (cdr func2)))
810 (if (setq func2 (rassq func math-expr-function-mapping)) 811 (if (setq func2 (rassq func math-expr-function-mapping))
@@ -858,7 +859,7 @@
858 (or (cdr (cdr a)) 859 (or (cdr (cdr a))
859 (not (eq (car-safe (nth 1 a)) '*)))) 860 (not (eq (car-safe (nth 1 a)) '*))))
860 861
861(defun math-compose-matrix (a col cols base) 862(defun math-compose-matrix (a _col cols base)
862 (let ((col 0) 863 (let ((col 0)
863 (res nil)) 864 (res nil))
864 (while (<= (setq col (1+ col)) cols) 865 (while (<= (setq col (1+ col)) cols)
@@ -968,8 +969,8 @@
968 (and (memq (car a) '(^ calcFunc-subscr)) 969 (and (memq (car a) '(^ calcFunc-subscr))
969 (math-tex-expr-is-flat (nth 1 a))))) 970 (math-tex-expr-is-flat (nth 1 a)))))
970 971
971(put 'calcFunc-log 'math-compose-big 'math-compose-log) 972(put 'calcFunc-log 'math-compose-big #'math-compose-log)
972(defun math-compose-log (a prec) 973(defun math-compose-log (a _prec)
973 (and (= (length a) 3) 974 (and (= (length a) 3)
974 (list 'horiz 975 (list 'horiz
975 (list 'subscr "log" 976 (list 'subscr "log"
@@ -979,8 +980,8 @@
979 (math-compose-expr (nth 1 a) 1000) 980 (math-compose-expr (nth 1 a) 1000)
980 ")"))) 981 ")")))
981 982
982(put 'calcFunc-log10 'math-compose-big 'math-compose-log10) 983(put 'calcFunc-log10 'math-compose-big #'math-compose-log10)
983(defun math-compose-log10 (a prec) 984(defun math-compose-log10 (a _prec)
984 (and (= (length a) 2) 985 (and (= (length a) 2)
985 (list 'horiz 986 (list 'horiz
986 (list 'subscr "log" "10") 987 (list 'subscr "log" "10")
@@ -988,8 +989,8 @@
988 (math-compose-expr (nth 1 a) 1000) 989 (math-compose-expr (nth 1 a) 1000)
989 ")"))) 990 ")")))
990 991
991(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv) 992(put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv)
992(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv) 993(put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv)
993(defun math-compose-deriv (a prec) 994(defun math-compose-deriv (a prec)
994 (when (= (length a) 3) 995 (when (= (length a) 3)
995 (math-compose-expr (list '/ 996 (math-compose-expr (list '/
@@ -1003,8 +1004,8 @@
1003 (nth 2 a)))) 1004 (nth 2 a))))
1004 prec))) 1005 prec)))
1005 1006
1006(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt) 1007(put 'calcFunc-sqrt 'math-compose-big #'math-compose-sqrt)
1007(defun math-compose-sqrt (a prec) 1008(defun math-compose-sqrt (a _prec)
1008 (when (= (length a) 2) 1009 (when (= (length a) 2)
1009 (let* ((c (math-compose-expr (nth 1 a) 0)) 1010 (let* ((c (math-compose-expr (nth 1 a) 0))
1010 (a (math-comp-ascent c)) 1011 (a (math-comp-ascent c))
@@ -1024,8 +1025,8 @@
1024 " " 1025 " "
1025 c))))) 1026 c)))))
1026 1027
1027(put 'calcFunc-choose 'math-compose-big 'math-compose-choose) 1028(put 'calcFunc-choose 'math-compose-big #'math-compose-choose)
1028(defun math-compose-choose (a prec) 1029(defun math-compose-choose (a _prec)
1029 (let ((a1 (math-compose-expr (nth 1 a) 0)) 1030 (let ((a1 (math-compose-expr (nth 1 a) 0))
1030 (a2 (math-compose-expr (nth 2 a) 0))) 1031 (a2 (math-compose-expr (nth 2 a) 0)))
1031 (list 'horiz 1032 (list 'horiz
@@ -1035,7 +1036,7 @@
1035 a1 " " a2) 1036 a1 " " a2)
1036 ")"))) 1037 ")")))
1037 1038
1038(put 'calcFunc-integ 'math-compose-big 'math-compose-integ) 1039(put 'calcFunc-integ 'math-compose-big #'math-compose-integ)
1039(defun math-compose-integ (a prec) 1040(defun math-compose-integ (a prec)
1040 (and (memq (length a) '(3 5)) 1041 (and (memq (length a) '(3 5))
1041 (eq (car-safe (nth 2 a)) 'var) 1042 (eq (car-safe (nth 2 a)) 'var)
@@ -1072,7 +1073,7 @@
1072 (list 'horiz " d" var)) 1073 (list 'horiz " d" var))
1073 (if parens ")" ""))))) 1074 (if parens ")" "")))))
1074 1075
1075(put 'calcFunc-sum 'math-compose-big 'math-compose-sum) 1076(put 'calcFunc-sum 'math-compose-big #'math-compose-sum)
1076(defun math-compose-sum (a prec) 1077(defun math-compose-sum (a prec)
1077 (and (memq (length a) '(3 5 6)) 1078 (and (memq (length a) '(3 5 6))
1078 (let* ((expr (math-compose-expr (nth 1 a) 185)) 1079 (let* ((expr (math-compose-expr (nth 1 a) 185))
@@ -1097,7 +1098,7 @@
1097 expr 1098 expr
1098 (if (memq prec '(180 201)) ")" ""))))) 1099 (if (memq prec '(180 201)) ")" "")))))
1099 1100
1100(put 'calcFunc-prod 'math-compose-big 'math-compose-prod) 1101(put 'calcFunc-prod 'math-compose-big #'math-compose-prod)
1101(defun math-compose-prod (a prec) 1102(defun math-compose-prod (a prec)
1102 (and (memq (length a) '(3 5 6)) 1103 (and (memq (length a) '(3 5 6))
1103 (let* ((expr (math-compose-expr (nth 1 a) 198)) 1104 (let* ((expr (math-compose-expr (nth 1 a) 198))
@@ -1124,12 +1125,11 @@
1124;; The variables math-svo-c, math-svo-wid and math-svo-off are local 1125;; The variables math-svo-c, math-svo-wid and math-svo-off are local
1125;; to math-stack-value-offset in calc.el, but are used by 1126;; to math-stack-value-offset in calc.el, but are used by
1126;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. 1127;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
1127(defvar math-svo-c)
1128(defvar math-svo-wid) 1128(defvar math-svo-wid)
1129(defvar math-svo-off) 1129(defvar math-svo-off)
1130 1130
1131(defun math-stack-value-offset-fancy () 1131(defun math-stack-value-offset-fancy (c)
1132 (let ((cwid (+ (math-comp-width math-svo-c)))) 1132 (let ((cwid (+ (math-comp-width c))))
1133 (cond ((eq calc-display-just 'right) 1133 (cond ((eq calc-display-just 'right)
1134 (if calc-display-origin 1134 (if calc-display-origin
1135 (setq math-svo-wid (max calc-display-origin 5)) 1135 (setq math-svo-wid (max calc-display-origin 5))
@@ -1215,7 +1215,7 @@
1215;; which are called by math-comp-to-string-flat. 1215;; which are called by math-comp-to-string-flat.
1216(defvar math-comp-pos) 1216(defvar math-comp-pos)
1217 1217
1218(defun math-comp-to-string-flat (c math-comp-full-width) 1218(defun math-comp-to-string-flat (c full-width)
1219 (if math-comp-sel-hpos 1219 (if math-comp-sel-hpos
1220 (let ((math-comp-pos 0)) 1220 (let ((math-comp-pos 0))
1221 (math-comp-sel-flat-term c)) 1221 (math-comp-sel-flat-term c))
@@ -1224,6 +1224,7 @@
1224 (math-comp-pos 0) 1224 (math-comp-pos 0)
1225 (math-comp-margin 0) 1225 (math-comp-margin 0)
1226 (math-comp-highlight (and math-comp-selected calc-show-selections)) 1226 (math-comp-highlight (and math-comp-selected calc-show-selections))
1227 (math-comp-full-width full-width)
1227 (math-comp-level -1)) 1228 (math-comp-level -1))
1228 (math-comp-to-string-flat-term '(set -1 0)) 1229 (math-comp-to-string-flat-term '(set -1 0))
1229 (math-comp-to-string-flat-term c) 1230 (math-comp-to-string-flat-term c)
@@ -1387,7 +1388,7 @@
1387(defvar math-comp-hpos) 1388(defvar math-comp-hpos)
1388(defvar math-comp-vpos) 1389(defvar math-comp-vpos)
1389 1390
1390(defun math-comp-simplify (c full-width) 1391(defun math-comp-simplify (c _full-width)
1391 (let ((math-comp-buf (list "")) 1392 (let ((math-comp-buf (list ""))
1392 (math-comp-base 0) 1393 (math-comp-base 0)
1393 (math-comp-hgt 1) 1394 (math-comp-hgt 1)