andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Don't quote lambdas with 'function' in calc/*.el

Browse source 
* lisp/calc/calc-aent.el (calc-do-quick-calc)
(calc-do-calc-eval, math-build-parse-table):
* lisp/calc/calc-alg.el (math-polynomial-base):
* lisp/calc/calc-alg.el (math-is-poly-rec):
* lisp/calc/calc-arith.el (calcFunc-scf):
* lisp/calc/calc-arith.el (math-ceiling, math-round):
* lisp/calc/calc-arith.el (math-trunc-fancy, math-floor-fancy):
* lisp/calc/calc-ext.el (calc-init-extensions, calc-reset)
(calc-refresh-top, calc-z-prefix-help, calc-binary-op-fancy)
(calc-unary-op-fancy):
* lisp/calc/calc-forms.el (math-make-mod):
* lisp/calc/calc-frac.el (calcFunc-frac):
* lisp/calc/calc-funcs.el (calcFunc-euler):
* lisp/calc/calc-help.el (calc-full-help):
* lisp/calc/calc-lang.el (c, pascal, fortran, tex, latex, eqn)
(yacas, maxima, giac, math, maple):
* lisp/calc/calc-macs.el (calc-wrapper, calc-slow-wrapper):
* lisp/calc/calc-map.el (calc-get-operator, calcFunc-mapeqr)
(calcFunc-reducea, calcFunc-rreducea, calcFunc-reduced)
(calcFunc-rreduced, calcFunc-outer):
* lisp/calc/calc-misc.el (another-calc, calc-do-handle-whys):
* lisp/calc/calc-mode.el (calc-save-modes):
* lisp/calc/calc-mtx.el (math-col-matrix, math-mul-mat-vec):
* lisp/calc/calc-poly.el (math-sort-terms, math-poly-div-list)
(math-mul-list, math-sort-poly-base-list)
(math-partial-fractions):
* lisp/calc/calc-prog.el (calc-user-define-formula):
* lisp/calc/calc-rewr.el (math-rewrite, math-compile-patterns)
(math-compile-rewrites, math-parse-schedule)
(math-rwcomp-pattern):
* lisp/calc/calc-store.el (calc-var-name-map, calc-let)
(calc-permanent-variable, calc-insert-variables):
* lisp/calc/calc-stuff.el (calc-flush-caches, calcFunc-pclean)
(calcFunc-pfrac):
* lisp/calc/calc-units.el (math-build-units-table)
(math-decompose-units):
* lisp/calc/calc-vec.el (calcFunc-mrow, math-mat-col)
(calcFunc-mcol, math-mat-less-col, math-mimic-ident):
* lisp/calc/calc-yank.el (calc-edit):
* lisp/calc/calc.el
(calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values, calc-mode, calc-quit):
* lisp/calc/calccomp.el (math-compose-expr)
(math-compose-matrix, math-vector-to-string): Don't quote lambdas with
'function'.
This commit is contained in:
Stefan Kangas 2020-11-17 02:51:30 +01:00
parent 0a7ec10ac6
commit 030ad21afe
24 changed files with 467 additions and 507 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
lisp/calc/calc-aent.el
View file

@ -76,8 +76,8 @@
(calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp)))) (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
(setq alg-exp (list (nth 2 (car alg-exp))))) (setq alg-exp (list (nth 2 (car alg-exp)))))
(setq calc-quick-prev-results alg-exp (setq calc-quick-prev-results alg-exp
buf (mapconcat (function (lambda (x) buf (mapconcat (lambda (x)
(math-format-value x 1000))) (math-format-value x 1000))
alg-exp alg-exp
" ") " ")
shortbuf buf) shortbuf buf)
@ -197,18 +197,17 @@
(calc-language (if (memq calc-language '(nil big)) (calc-language (if (memq calc-language '(nil big))
'flat calc-language)) 'flat calc-language))
(calc-dollar-values (mapcar (calc-dollar-values (mapcar
(function (lambda (x)
(lambda (x) (if (stringp x)
(if (stringp x) (progn
(progn (setq x (math-read-exprs x))
(setq x (math-read-exprs x)) (if (eq (car-safe x)
(if (eq (car-safe x) 'error)
'error) (throw 'calc-error
(throw 'calc-error (calc-eval-error
(calc-eval-error (cdr x)))
(cdr x))) (car x)))
(car x))) x))
x)))
args)) args))
(calc-dollar-used 0) (calc-dollar-used 0)
(res (if (stringp str) (res (if (stringp str)
@ -640,10 +639,10 @@ in Calc algebraic input.")
(math-find-user-tokens (car (car p))) (math-find-user-tokens (car (car p)))
(setq p (cdr p))) (setq p (cdr p)))
(setq calc-user-tokens (mapconcat 'identity (setq calc-user-tokens (mapconcat 'identity
(sort (mapcar 'car math-toks) (sort (mapcar #'car math-toks)
(function (lambda (x y) (lambda (x y)
(> (length x) (> (length x)
(length y))))) (length y))))
"\\|") "\\|")
calc-last-main-parse-table mtab calc-last-main-parse-table mtab
calc-last-user-lang-parse-table ltab calc-last-user-lang-parse-table ltab

7
lisp/calc/calc-alg.el
View file

@ -1785,7 +1785,7 @@ and should return the simplified expression to use (or nil)."
(cons (nth 2 expr) math-poly-neg-powers)))) (cons (nth 2 expr) math-poly-neg-powers))))
(not (Math-zerop (nth 2 expr))) (not (Math-zerop (nth 2 expr)))
(let ((p1 (math-is-poly-rec (nth 1 expr) negpow))) (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
(mapcar (function (lambda (x) (math-div x (nth 2 expr)))) (mapcar (lambda (x) (math-div x (nth 2 expr)))
p1)))) p1))))
((and (eq (car expr) 'calcFunc-exp) ((and (eq (car expr) 'calcFunc-exp)
(equal math-var '(var e var-e))) (equal math-var '(var e var-e)))
@ -1838,8 +1838,9 @@ and should return the simplified expression to use (or nil)."
(defun math-polynomial-base (top-expr &optional pred) (defun math-polynomial-base (top-expr &optional pred)
"Find the variable (or sub-expression) which is the base of polynomial expr." "Find the variable (or sub-expression) which is the base of polynomial expr."
(let ((math-poly-base-pred (let ((math-poly-base-pred
(or pred (function (lambda (base) (math-polynomial-p (or pred (lambda (base)
top-expr base)))))) (math-polynomial-p
top-expr base)))))
(or (let ((math-poly-base-const-ok nil)) (or (let ((math-poly-base-const-ok nil))
(math-polynomial-base-rec top-expr)) (math-polynomial-base-rec top-expr))
(let ((math-poly-base-const-ok t)) (let ((math-poly-base-const-ok t))

10
lisp/calc/calc-arith.el
View file

@ -2390,7 +2390,7 @@
(math-trunc (nth 3 a))))) (math-trunc (nth 3 a)))))
((math-provably-integerp a) a) ((math-provably-integerp a) a)
((Math-vectorp a) ((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a)) (math-map-vec (lambda (x) (math-trunc x math-trunc-prec)) a))
((math-infinitep a) ((math-infinitep a)
(if (or (math-posp a) (math-negp a)) (if (or (math-posp a) (math-negp a))
a a
@ -2453,7 +2453,7 @@
(math-add (math-floor (nth 3 a)) -1) (math-add (math-floor (nth 3 a)) -1)
(math-floor (nth 3 a))))) (math-floor (nth 3 a)))))
((Math-vectorp a) ((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a)) (math-map-vec (lambda (x) (math-floor x math-floor-prec)) a))
((math-infinitep a) ((math-infinitep a)
(if (or (math-posp a) (math-negp a)) (if (or (math-posp a) (math-negp a))
a a
@ -2520,7 +2520,7 @@
(math-ceiling (nth 2 a))) (math-ceiling (nth 2 a)))
(math-ceiling (nth 3 a)))) (math-ceiling (nth 3 a))))
((Math-vectorp a) ((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-ceiling x prec))) a)) (math-map-vec (lambda (x) (math-ceiling x prec)) a))
((math-infinitep a) ((math-infinitep a)
(if (or (math-posp a) (math-negp a)) (if (or (math-posp a) (math-negp a))
a a
@ -2573,7 +2573,7 @@
((eq (car a) 'intv) ((eq (car a) 'intv)
(math-floor (math-add a '(frac 1 2)))) (math-floor (math-add a '(frac 1 2))))
((Math-vectorp a) ((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-round x prec))) a)) (math-map-vec (lambda (x) (math-round x prec)) a))
((math-infinitep a) ((math-infinitep a)
(if (or (math-posp a) (math-negp a)) (if (or (math-posp a) (math-negp a))
a a
@ -2656,7 +2656,7 @@
(calcFunc-scf (nth 2 x) n) (calcFunc-scf (nth 2 x) n)
(calcFunc-scf (nth 3 x) n)))) (calcFunc-scf (nth 3 x) n))))
((eq (car x) 'vec) ((eq (car x) 'vec)
(math-map-vec (function (lambda (x) (calcFunc-scf x n))) x)) (math-map-vec (lambda (x) (calcFunc-scf x n)) x))
((math-infinitep x) ((math-infinitep x)
x) x)
(t (t

38
lisp/calc/calc-ext.el
View file

@ -678,14 +678,13 @@
(calc-init-prefixes) (calc-init-prefixes)
(mapc (function (mapc (lambda (x)
(lambda (x)
(define-key calc-mode-map (format "c%c" x) 'calc-clean-num) (define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
(define-key calc-mode-map (format "j%c" x) 'calc-select-part) (define-key calc-mode-map (format "j%c" x) 'calc-select-part)
(define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
(define-key calc-mode-map (format "s%c" x) 'calc-store-quick) (define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
(define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
(define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))
"0123456789") "0123456789")
(let ((i ?A)) (let ((i ?A))
@ -711,9 +710,9 @@
(define-key calc-alg-map "\e\177" 'calc-pop-above) (define-key calc-alg-map "\e\177" 'calc-pop-above)
;;;; (Autoloads here) ;;;; (Autoloads here)
(mapc (function (lambda (x) (mapc (lambda (x)
(mapcar (function (lambda (func) (autoload func (car x)))) (mapcar (lambda (func) (autoload func (car x)))
(cdr x)))) (cdr x)))
'( '(
("calc-alg" calc-has-rules math-defsimplify ("calc-alg" calc-has-rules math-defsimplify
@ -980,9 +979,9 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
)) ))
(mapcar (function (lambda (x) (mapcar (lambda (x)
(mapcar (function (lambda (cmd) (autoload cmd (car x) nil t))) (mapcar (lambda (cmd) (autoload cmd (car x) nil t))
(cdr x)))) (cdr x)))
'( '(
("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@ -1358,7 +1357,7 @@ calc-kill calc-kill-region calc-yank))))
calc-redo-list nil) calc-redo-list nil)
(let (calc-stack calc-user-parse-tables calc-standard-date-formats (let (calc-stack calc-user-parse-tables calc-standard-date-formats
calc-invocation-macro) calc-invocation-macro)
(mapc (function (lambda (v) (set v nil))) calc-local-var-list) (mapc (lambda (v) (set v nil)) calc-local-var-list)
(if (and arg (<= arg 0)) (if (and arg (<= arg 0))
(calc-mode-var-list-restore-default-values) (calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values))) (calc-mode-var-list-restore-saved-values)))
@ -1658,7 +1657,7 @@ calc-kill calc-kill-region calc-yank))))
(calc-pop-stack n 1 t) (calc-pop-stack n 1 t)
(calc-push-list (mapcar #'car entries) (calc-push-list (mapcar #'car entries)
1 1
(mapcar (function (lambda (x) (nth 2 x))) (mapcar (lambda (x) (nth 2 x))
entries))))))) entries)))))))
(defvar calc-refreshing-evaltos nil) (defvar calc-refreshing-evaltos nil)
@ -1924,11 +1923,10 @@ calc-kill calc-kill-region calc-yank))))
(let* ((calc-z-prefix-msgs nil) (let* ((calc-z-prefix-msgs nil)
(calc-z-prefix-buf "") (calc-z-prefix-buf "")
(kmap (sort (copy-sequence (calc-user-key-map)) (kmap (sort (copy-sequence (calc-user-key-map))
(function (lambda (x y) (< (car x) (car y)))))) (lambda (x y) (< (car x) (car y)))))
(flags (apply #'logior (flags (apply #'logior
(mapcar (function (mapcar (lambda (k)
(lambda (k) (calc-user-function-classify (car k)))
(calc-user-function-classify (car k))))
kmap)))) kmap))))
(if (= (logand flags 8) 0) (if (= (logand flags 8) 0)
(calc-user-function-list kmap 7) (calc-user-function-list kmap 7)
@ -2633,9 +2631,8 @@ If X is not an error form, return 1."
(let ((rhs (calc-top-n 1))) (let ((rhs (calc-top-n 1)))
(calc-enter-result (- 1 n) (calc-enter-result (- 1 n)
name name
(mapcar (function (mapcar (lambda (x)
(lambda (x) (list func x rhs))
(list func x rhs)))
(calc-top-list-n (- n) 2)))))))) (calc-top-list-n (- n) 2))))))))
(defun calc-unary-op-fancy (name func arg) (defun calc-unary-op-fancy (name func arg)
@ -2644,9 +2641,8 @@ If X is not an error form, return 1."
(cond ((> n 0) (cond ((> n 0)
(calc-enter-result n (calc-enter-result n
name name
(mapcar (function (mapcar (lambda (x)
(lambda (x) (list func x))
(list func x)))
(calc-top-list-n n)))) (calc-top-list-n n))))
((< n 0) ((< n 0)
(calc-enter-result 1 (calc-enter-result 1

2
lisp/calc/calc-forms.el
View file

@ -2129,7 +2129,7 @@ and ends on the last Sunday of October at 2 a.m."
((memq (car n) '(+ - / vec neg)) ((memq (car n) '(+ - / vec neg))
(math-normalize (math-normalize
(cons (car n) (cons (car n)
(mapcar (function (lambda (x) (math-make-mod x m))) (mapcar (lambda (x) (math-make-mod x m))
(cdr n))))) (cdr n)))))
((and (eq (car n) '*) (Math-anglep (nth 1 n))) ((and (eq (car n) '*) (Math-anglep (nth 1 n)))
(math-mul (math-make-mod (nth 1 n) m) (nth 2 n))) (math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))

5
lisp/calc/calc-frac.el
View file

@ -132,9 +132,8 @@
(cond ((Math-ratp a) (cond ((Math-ratp a)
a) a)
((memq (car a) '(cplx polar vec hms date sdev intv mod)) ((memq (car a) '(cplx polar vec hms date sdev intv mod))
(cons (car a) (mapcar (function (cons (car a) (mapcar (lambda (x)
(lambda (x) (calcFunc-frac x tol))
(calcFunc-frac x tol)))
(cdr a)))) (cdr a))))
((Math-messy-integerp a) ((Math-messy-integerp a)
(math-trunc a)) (math-trunc a))

11
lisp/calc/calc-funcs.el
View file

@ -797,12 +797,11 @@
(math-reduce-vec (math-reduce-vec
'math-add 'math-add
(cons 'vec (cons 'vec
(mapcar (function (mapcar (lambda (c)
(lambda (c) (setq k (1+ k))
(setq k (1+ k)) (math-mul (math-mul fac c)
(math-mul (math-mul fac c) (math-sub (math-pow x1 k)
(math-sub (math-pow x1 k) (math-pow x2 k))))
(math-pow x2 k)))))
coefs))) coefs)))
x))) x)))
(math-mul (math-pow 2 n) (math-mul (math-pow 2 n)

50
lisp/calc/calc-help.el
View file

@ -402,32 +402,32 @@ C-w Describe how there is no warranty for Calc."
"Or type `h i' to read the full Calc manual on-line.\n\n")) "Or type `h i' to read the full Calc manual on-line.\n\n"))
(princ "Basic keys:\n") (princ "Basic keys:\n")
(let* ((calc-full-help-flag t)) (let* ((calc-full-help-flag t))
(mapc (function (lambda (x) (princ (format (mapc (lambda (x)
" %s\n" (princ (format
(substitute-command-keys x))))) " %s\n"
(substitute-command-keys x))))
(nreverse (cdr (reverse (cdr (calc-help)))))) (nreverse (cdr (reverse (cdr (calc-help))))))
(mapc (function (lambda (prefix) (mapc (lambda (prefix)
(let ((msgs (ignore-errors (funcall prefix)))) (let ((msgs (ignore-errors (funcall prefix))))
(if (car msgs) (if (car msgs)
(princ (princ
(if (eq (nth 2 msgs) ?v) (if (eq (nth 2 msgs) ?v)
(format-message (format-message
"\n`v' or `V' prefix (vector/matrix) keys: \n") "\n`v' or `V' prefix (vector/matrix) keys: \n")
(if (nth 2 msgs) (if (nth 2 msgs)
(format-message (format-message
"\n`%c' prefix (%s) keys:\n" "\n`%c' prefix (%s) keys:\n"
(nth 2 msgs) (nth 2 msgs)
(or (cdr (assq (nth 2 msgs) (or (cdr (assq (nth 2 msgs)
calc-help-long-names)) calc-help-long-names))
(nth 1 msgs))) (nth 1 msgs)))
(format "\n%s-modified keys:\n" (format "\n%s-modified keys:\n"
(capitalize (nth 1 msgs))))))) (capitalize (nth 1 msgs)))))))
(mapcar (function (mapcar (lambda (x)
(lambda (x) (princ (format
(princ (format " %s\n"
" %s\n" (substitute-command-keys x))))
(substitute-command-keys x))))) (car msgs))))
(car msgs)))))
'(calc-inverse-prefix-help '(calc-inverse-prefix-help
calc-hyperbolic-prefix-help calc-hyperbolic-prefix-help
calc-inv-hyp-prefix-help calc-inv-hyp-prefix-help

362
lisp/calc/calc-lang.el
View file

@ -175,20 +175,19 @@
(put 'c 'math-vector-brackets "{}") (put 'c 'math-vector-brackets "{}")
(put 'c 'math-radix-formatter (put 'c 'math-radix-formatter
(function (lambda (r s) (lambda (r s)
(if (= r 16) (format "0x%s" s) (if (= r 16) (format "0x%s" s)
(if (= r 8) (format "0%s" s) (if (= r 8) (format "0%s" s)
(format "%d#%s" r s)))))) (format "%d#%s" r s)))))
(put 'c 'math-compose-subscr (put 'c 'math-compose-subscr
(function (lambda (a)
(lambda (a) (let ((args (cdr (cdr a))))
(let ((args (cdr (cdr a)))) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "["
"[" (math-compose-vector args ", " 0)
(math-compose-vector args ", " 0) "]"))))
"]")))))
(add-to-list 'calc-lang-slash-idiv 'c) (add-to-list 'calc-lang-slash-idiv 'c)
(add-to-list 'calc-lang-allow-underscores 'c) (add-to-list 'calc-lang-allow-underscores 'c)
@ -238,9 +237,9 @@
(put 'pascal 'math-output-filter 'calc-output-case-filter) (put 'pascal 'math-output-filter 'calc-output-case-filter)
(put 'pascal 'math-radix-formatter (put 'pascal 'math-radix-formatter
(function (lambda (r s) (lambda (r s)
(if (= r 16) (format "$%s" s) (if (= r 16) (format "$%s" s)
(format "%d#%s" r s))))) (format "%d#%s" r s))))
(put 'pascal 'math-lang-read-symbol (put 'pascal 'math-lang-read-symbol
'((?\$ '((?\$
@ -253,17 +252,16 @@
math-exp-pos (match-end 1))))) math-exp-pos (match-end 1)))))
(put 'pascal 'math-compose-subscr (put 'pascal 'math-compose-subscr
(function (lambda (a)
(lambda (a) (let ((args (cdr (cdr a))))
(let ((args (cdr (cdr a)))) (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) (setq args (append (cdr (cdr (nth 1 a))) args)
(setq args (append (cdr (cdr (nth 1 a))) args) a (nth 1 a)))
a (nth 1 a))) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "["
"[" (math-compose-vector args ", " 0)
(math-compose-vector args ", " 0) "]"))))
"]")))))
(add-to-list 'calc-lang-allow-underscores 'pascal) (add-to-list 'calc-lang-allow-underscores 'pascal)
(add-to-list 'calc-lang-brackets-are-subscripts 'pascal) (add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
@ -350,17 +348,16 @@
math-exp-pos (match-end 0))))) math-exp-pos (match-end 0)))))
(put 'fortran 'math-compose-subscr (put 'fortran 'math-compose-subscr
(function (lambda (a)
(lambda (a) (let ((args (cdr (cdr a))))
(let ((args (cdr (cdr a)))) (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) (setq args (append (cdr (cdr (nth 1 a))) args)
(setq args (append (cdr (cdr (nth 1 a))) args) a (nth 1 a)))
a (nth 1 a))) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "("
"(" (math-compose-vector args ", " 0)
(math-compose-vector args ", " 0) ")"))))
")")))))
(add-to-list 'calc-lang-slash-idiv 'fortran) (add-to-list 'calc-lang-slash-idiv 'fortran)
(add-to-list 'calc-lang-allow-underscores 'fortran) (add-to-list 'calc-lang-allow-underscores 'fortran)
@ -598,18 +595,17 @@
(put 'tex 'math-input-filter 'math-tex-input-filter) (put 'tex 'math-input-filter 'math-tex-input-filter)
(put 'tex 'math-matrix-formatter (put 'tex 'math-matrix-formatter
(function (lambda (a)
(lambda (a) (if (and (integerp calc-language-option)
(if (and (integerp calc-language-option) (or (= calc-language-option 0)
(or (= calc-language-option 0) (> calc-language-option 1)
(> calc-language-option 1) (< calc-language-option -1)))
(< calc-language-option -1))) (append '(vleft 0 "\\matrix{")
(append '(vleft 0 "\\matrix{") (math-compose-tex-matrix (cdr a))
(math-compose-tex-matrix (cdr a)) '("}"))
'("}")) (append '(horiz "\\matrix{ ")
(append '(horiz "\\matrix{ ") (math-compose-tex-matrix (cdr a))
(math-compose-tex-matrix (cdr a)) '(" }")))))
'(" }"))))))
(put 'tex 'math-var-formatter 'math-compose-tex-var) (put 'tex 'math-var-formatter 'math-compose-tex-var)
@ -839,18 +835,17 @@
(put 'latex 'math-complex-format 'i) (put 'latex 'math-complex-format 'i)
(put 'latex 'math-matrix-formatter (put 'latex 'math-matrix-formatter
(function (lambda (a)
(lambda (a) (if (and (integerp calc-language-option)
(if (and (integerp calc-language-option) (or (= calc-language-option 0)
(or (= calc-language-option 0) (> calc-language-option 1)
(> calc-language-option 1) (< calc-language-option -1)))
(< calc-language-option -1))) (append '(vleft 0 "\\begin{pmatrix}")
(append '(vleft 0 "\\begin{pmatrix}") (math-compose-tex-matrix (cdr a) t)
(math-compose-tex-matrix (cdr a) t) '("\\end{pmatrix}"))
'("\\end{pmatrix}")) (append '(horiz "\\begin{pmatrix} ")
(append '(horiz "\\begin{pmatrix} ") (math-compose-tex-matrix (cdr a) t)
(math-compose-tex-matrix (cdr a) t) '(" \\end{pmatrix}")))))
'(" \\end{pmatrix}"))))))
(put 'latex 'math-var-formatter 'math-compose-tex-var) (put 'latex 'math-var-formatter 'math-compose-tex-var)
@ -1023,36 +1018,34 @@
(put 'eqn 'math-evalto '("evalto " . " -> ")) (put 'eqn 'math-evalto '("evalto " . " -> "))
(put 'eqn 'math-matrix-formatter (put 'eqn 'math-matrix-formatter
(function (lambda (a)
(lambda (a) (append '(horiz "matrix { ")
(append '(horiz "matrix { ") (math-compose-eqn-matrix
(math-compose-eqn-matrix (cdr (math-transpose a)))
(cdr (math-transpose a))) '("}"))))
'("}")))))
(put 'eqn 'math-var-formatter (put 'eqn 'math-var-formatter
(function (lambda (a prec)
(lambda (a prec) (let (v)
(let (v) (if (and math-compose-hash-args
(if (and math-compose-hash-args (let ((p calc-arg-values))
(let ((p calc-arg-values)) (setq v 1)
(setq v 1) (while (and p (not (equal (car p) a)))
(while (and p (not (equal (car p) a))) (setq p (and (eq math-compose-hash-args t) (cdr p))
(setq p (and (eq math-compose-hash-args t) (cdr p)) v (1+ v)))
v (1+ v))) p))
p)) (if (eq math-compose-hash-args 1)
(if (eq math-compose-hash-args 1) "#"
"#" (format "#%d" v))
(format "#%d" v)) (if (string-match ".'\\'" (symbol-name (nth 2 a)))
(if (string-match ".'\\'" (symbol-name (nth 2 a))) (math-compose-expr
(math-compose-expr (list 'calcFunc-Prime
(list 'calcFunc-Prime (list
(list 'var
'var (intern (substring (symbol-name (nth 1 a)) 0 -1))
(intern (substring (symbol-name (nth 1 a)) 0 -1)) (intern (substring (symbol-name (nth 2 a)) 0 -1))))
(intern (substring (symbol-name (nth 2 a)) 0 -1)))) prec)
prec) (symbol-name (nth 1 a)))))))
(symbol-name (nth 1 a))))))))
(defconst math-eqn-special-funcs (defconst math-eqn-special-funcs
'( calcFunc-log '( calcFunc-log
@ -1065,31 +1058,30 @@
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
(put 'eqn 'math-func-formatter (put 'eqn 'math-func-formatter
(function (lambda (func a)
(lambda (func a) (let (left right)
(let (left right) (if (string-match "[^']'+\\'" func)
(if (string-match "[^']'+\\'" func) (let ((n (- (length func) (match-beginning 0) 1)))
(let ((n (- (length func) (match-beginning 0) 1))) (setq func (substring func 0 (- n)))
(setq func (substring func 0 (- n))) (while (>= (setq n (1- n)) 0)
(while (>= (setq n (1- n)) 0) (setq func (concat func " prime")))))
(setq func (concat func " prime"))))) (cond ((or (> (length a) 2)
(cond ((or (> (length a) 2) (not (math-tex-expr-is-flat (nth 1 a))))
(not (math-tex-expr-is-flat (nth 1 a)))) (setq left "{left ( "
(setq left "{left ( " right " right )}"))
right " right )}"))
((and ((and
(memq (car a) math-eqn-special-funcs) (memq (car a) math-eqn-special-funcs)
(= (length a) 2) (= (length a) 2)
(or (Math-realp (nth 1 a)) (or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *)))) (memq (car (nth 1 a)) '(var *))))
(setq left "~{" right "}")) (setq left "~{" right "}"))
(t (t
(setq left " ( " (setq left " ( "
right " )"))) right " )")))
(list 'horiz func left (list 'horiz func left
(math-compose-vector (cdr a) " , " 0) (math-compose-vector (cdr a) " , " 0)
right))))) right))))
(put 'eqn 'math-lang-read-symbol (put 'eqn 'math-lang-read-symbol
'((?\" '((?\"
@ -1111,23 +1103,22 @@
("above" punc ","))) ("above" punc ",")))
(put 'eqn 'math-lang-adjust-words (put 'eqn 'math-lang-adjust-words
(function (lambda ()
(lambda () (let ((code (assoc math-expr-data math-eqn-ignore-words)))
(let ((code (assoc math-expr-data math-eqn-ignore-words))) (cond ((null code))
(cond ((null code)) ((null (cdr code))
((null (cdr code)) (math-read-token))
(math-read-token)) ((consp (nth 1 code))
((consp (nth 1 code)) (math-read-token)
(math-read-token) (if (assoc math-expr-data (cdr code))
(if (assoc math-expr-data (cdr code)) (setq math-expr-data (format "%s %s"
(setq math-expr-data (format "%s %s" (car code) math-expr-data))))
(car code) math-expr-data)))) ((eq (nth 1 code) 'punc)
((eq (nth 1 code) 'punc) (setq math-exp-token 'punc
(setq math-exp-token 'punc math-expr-data (nth 2 code)))
math-expr-data (nth 2 code))) (t
(t (math-read-token)
(math-read-token) (math-read-token))))))
(math-read-token)))))))
(put 'eqn 'math-lang-read (put 'eqn 'math-lang-read
'((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^" '((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^"
@ -1357,14 +1348,13 @@
( calcFunc-in . (math-lang-compose-switch-args "Contains")))) ( calcFunc-in . (math-lang-compose-switch-args "Contains"))))
(put 'yacas 'math-compose-subscr (put 'yacas 'math-compose-subscr
(function (lambda (a)
(lambda (a) (let ((args (cdr (cdr a))))
(let ((args (cdr (cdr a)))) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "["
"[" (math-compose-vector args ", " 0)
(math-compose-vector args ", " 0) "]"))))
"]")))))
(defun math-yacas-parse-Sum (f _val) (defun math-yacas-parse-Sum (f _val)
"Read in the arguments to \"Sum\" in Calc's Yacas mode." "Read in the arguments to \"Sum\" in Calc's Yacas mode."
@ -1600,24 +1590,22 @@
(add-to-list 'calc-lang-brackets-are-subscripts 'maxima) (add-to-list 'calc-lang-brackets-are-subscripts 'maxima)
(put 'maxima 'math-compose-subscr (put 'maxima 'math-compose-subscr
(function (lambda (a)
(lambda (a) (let ((args (cdr (cdr a))))
(let ((args (cdr (cdr a)))) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "["
"[" (math-compose-vector args ", " 0)
(math-compose-vector args ", " 0) "]"))))
"]")))))
(put 'maxima 'math-matrix-formatter (put 'maxima 'math-matrix-formatter
(function (lambda (a)
(lambda (a) (list 'horiz
(list 'horiz "matrix("
"matrix(" (math-compose-vector (cdr a)
(math-compose-vector (cdr a) (concat math-comp-comma " ")
(concat math-comp-comma " ") math-comp-vector-prec)
math-comp-vector-prec) ")")))
")"))))
;;; Giac ;;; Giac
@ -1806,15 +1794,14 @@ order to Calc's."
(add-to-list 'calc-lang-allow-underscores 'giac) (add-to-list 'calc-lang-allow-underscores 'giac)
(put 'giac 'math-compose-subscr (put 'giac 'math-compose-subscr
(function (lambda (a)
(lambda (a) ;; (let ((args (cdr (cdr a))))
;; (let ((args (cdr (cdr a)))) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "["
"[" (math-compose-expr
(math-compose-expr (calc-normalize (list '- (nth 2 a) 1)) 0)
(calc-normalize (list '- (nth 2 a) 1)) 0) "]"))) ;;)
"]")))) ;;)
(defun math-read-giac-subscr (x _op) (defun math-read-giac-subscr (x _op)
(let ((idx (math-read-expr-level 0))) (let ((idx (math-read-expr-level 0)))
@ -1932,7 +1919,7 @@ order to Calc's."
(put 'math 'math-function-close "]") (put 'math 'math-function-close "]")
(put 'math 'math-radix-formatter (put 'math 'math-radix-formatter
(function (lambda (r s) (format "%d^^%s" r s)))) (lambda (r s) (format "%d^^%s" r s)))
(put 'math 'math-lang-read (put 'math 'math-lang-read
'((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
@ -1942,13 +1929,12 @@ order to Calc's."
math-exp-pos (match-end 0)))) math-exp-pos (match-end 0))))
(put 'math 'math-compose-subscr (put 'math 'math-compose-subscr
(function (lambda (a)
(lambda (a) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "[["
"[[" (math-compose-expr (nth 2 a) 0)
(math-compose-expr (nth 2 a) 0) "]]")))
"]]"))))
(defun math-read-math-subscr (x _op) (defun math-read-math-subscr (x _op)
(let ((idx (math-read-expr-level 0))) (let ((idx (math-read-expr-level 0)))
@ -2038,26 +2024,24 @@ order to Calc's."
(put 'maple 'math-complex-format 'I) (put 'maple 'math-complex-format 'I)
(put 'maple 'math-matrix-formatter (put 'maple 'math-matrix-formatter
(function (lambda (a)
(lambda (a) (list 'horiz
(list 'horiz "matrix("
"matrix(" math-comp-left-bracket
math-comp-left-bracket (math-compose-vector (cdr a)
(math-compose-vector (cdr a) (concat math-comp-comma " ")
(concat math-comp-comma " ") math-comp-vector-prec)
math-comp-vector-prec) math-comp-right-bracket
math-comp-right-bracket ")")))
")"))))
(put 'maple 'math-compose-subscr (put 'maple 'math-compose-subscr
(function (lambda (a)
(lambda (a) (let ((args (cdr (cdr a))))
(let ((args (cdr (cdr a)))) (list 'horiz
(list 'horiz (math-compose-expr (nth 1 a) 1000)
(math-compose-expr (nth 1 a) 1000) "["
"[" (math-compose-vector args ", " 0)
(math-compose-vector args ", " 0) "]"))))
"]")))))
(add-to-list 'calc-lang-allow-underscores 'maple) (add-to-list 'calc-lang-allow-underscores 'maple)
(add-to-list 'calc-lang-brackets-are-subscripts 'maple) (add-to-list 'calc-lang-brackets-are-subscripts 'maple)

6
lisp/calc/calc-macs.el
View file

@ -33,12 +33,12 @@
(defmacro calc-wrapper (&rest body) (defmacro calc-wrapper (&rest body)
`(calc-do (function (lambda () `(calc-do (lambda ()
,@body)))) ,@body)))
(defmacro calc-slow-wrapper (&rest body) (defmacro calc-slow-wrapper (&rest body)
`(calc-do `(calc-do
(function (lambda () ,@body)) (point))) (lambda () ,@body) (point)))
(defmacro math-showing-full-precision (form) (defmacro math-showing-full-precision (form)
`(let ((calc-float-format calc-full-float-format)) `(let ((calc-float-format calc-full-float-format))

43
lisp/calc/calc-map.el
View file

@ -612,14 +612,13 @@
"()") "()")
minibuffer-local-map minibuffer-local-map
t))) t)))
(setq math-arglist (mapcar (function (setq math-arglist (mapcar (lambda (x)
(lambda (x) (list 'var
(list 'var x
x (intern
(intern (concat
(concat "var-"
"var-" (symbol-name x)))))
(symbol-name x))))))
math-arglist)))) math-arglist))))
(setq oper (list "$" (setq oper (list "$"
(length math-arglist) (length math-arglist)
@ -962,12 +961,12 @@
(apply 'calcFunc-mapeqp func args))) (apply 'calcFunc-mapeqp func args)))
(defun calcFunc-mapeqr (func &rest args) (defun calcFunc-mapeqr (func &rest args)
(setq args (mapcar (function (lambda (x) (setq args (mapcar (lambda (x)
(let ((func (assq (car-safe x) (let ((func (assq (car-safe x)
calc-tweak-eqn-table))) calc-tweak-eqn-table)))
(if func (if func
(cons (nth 1 func) (cdr x)) (cons (nth 1 func) (cdr x))
x)))) x)))
args)) args))
(apply 'calcFunc-mapeqp func args)) (apply 'calcFunc-mapeqp func args))
@ -1092,28 +1091,28 @@
(defun calcFunc-reducea (func vec) (defun calcFunc-reducea (func vec)
(if (math-matrixp vec) (if (math-matrixp vec)
(cons 'vec (cons 'vec
(mapcar (function (lambda (x) (calcFunc-reducer func x))) (mapcar (lambda (x) (calcFunc-reducer func x))
(cdr vec))) (cdr vec)))
(calcFunc-reducer func vec))) (calcFunc-reducer func vec)))
(defun calcFunc-rreducea (func vec) (defun calcFunc-rreducea (func vec)
(if (math-matrixp vec) (if (math-matrixp vec)
(cons 'vec (cons 'vec
(mapcar (function (lambda (x) (calcFunc-rreducer func x))) (mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr vec))) (cdr vec)))
(calcFunc-rreducer func vec))) (calcFunc-rreducer func vec)))
(defun calcFunc-reduced (func vec) (defun calcFunc-reduced (func vec)
(if (math-matrixp vec) (if (math-matrixp vec)
(cons 'vec (cons 'vec
(mapcar (function (lambda (x) (calcFunc-reducer func x))) (mapcar (lambda (x) (calcFunc-reducer func x))
(cdr (math-transpose vec)))) (cdr (math-transpose vec))))
(calcFunc-reducer func vec))) (calcFunc-reducer func vec)))
(defun calcFunc-rreduced (func vec) (defun calcFunc-rreduced (func vec)
(if (math-matrixp vec) (if (math-matrixp vec)
(cons 'vec (cons 'vec
(mapcar (function (lambda (x) (calcFunc-rreducer func x))) (mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr (math-transpose vec)))) (cdr (math-transpose vec))))
(calcFunc-rreducer func vec))) (calcFunc-rreducer func vec)))
@ -1216,10 +1215,10 @@
(let ((mat nil)) (let ((mat nil))
(while (setq a (cdr a)) (while (setq a (cdr a))
(setq mat (cons (cons 'vec (setq mat (cons (cons 'vec
(mapcar (function (lambda (x) (mapcar (lambda (x)
(math-build-call func (math-build-call func
(list (car a) (list (car a)
x)))) x)))
(cdr b))) (cdr b)))
mat))) mat)))
(math-normalize (cons 'vec (nreverse mat))))) (math-normalize (cons 'vec (nreverse mat)))))

11
lisp/calc/calc-misc.el
View file

@ -176,9 +176,9 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
"Create another, independent Calculator buffer." "Create another, independent Calculator buffer."
(interactive) (interactive)
(if (eq major-mode 'calc-mode) (if (eq major-mode 'calc-mode)
(mapc (function (mapc (lambda (v)
(lambda (v) (set-default v (symbol-value v)))
(set-default v (symbol-value v)))) calc-local-var-list)) calc-local-var-list))
(set-buffer (generate-new-buffer "*Calculator*")) (set-buffer (generate-new-buffer "*Calculator*"))
(pop-to-buffer (current-buffer)) (pop-to-buffer (current-buffer))
(calc-mode)) (calc-mode))
@ -274,9 +274,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
;;;###autoload ;;;###autoload
(defun calc-do-handle-whys () (defun calc-do-handle-whys ()
(setq calc-why (sort calc-next-why (setq calc-why (sort calc-next-why
(function (lambda (x y)
(lambda (x y) (and (eq (car x) '*) (not (eq (car y) '*)))))
(and (eq (car x) '*) (not (eq (car y) '*))))))
calc-next-why nil) calc-next-why nil)
(if (and calc-why (or (eq calc-auto-why t) (if (and calc-why (or (eq calc-auto-why t)
(and (eq (car (car calc-why)) '*) (and (eq (car (car calc-why)) '*)

2
lisp/calc/calc-mode.el
View file

@ -268,7 +268,7 @@
(interactive) (interactive)
(calc-wrapper (calc-wrapper
(let (pos (let (pos
(vals (mapcar (function (lambda (v) (symbol-value (car v)))) (vals (mapcar (lambda (v) (symbol-value (car v)))
calc-mode-var-list))) calc-mode-var-list)))
(unless calc-settings-file (unless calc-settings-file
(error "No `calc-settings-file' specified")) (error "No `calc-settings-file' specified"))

6
lisp/calc/calc-mtx.el
View file

@ -55,7 +55,7 @@
(defun math-col-matrix (a) (defun math-col-matrix (a)
(if (and (Math-vectorp a) (if (and (Math-vectorp a)
(not (math-matrixp a))) (not (math-matrixp a)))
(cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a))) (cons 'vec (mapcar (lambda (x) (list 'vec x)) (cdr a)))
a)) a))
@ -79,8 +79,8 @@
(cons 'vec (nreverse mat)))) (cons 'vec (nreverse mat))))
(defun math-mul-mat-vec (a b) (defun math-mul-mat-vec (a b)
(cons 'vec (mapcar (function (lambda (row) (cons 'vec (mapcar (lambda (row)
(math-dot-product row b))) (math-dot-product row b))
(cdr a)))) (cdr a))))

21
lisp/calc/calc-poly.el
View file

@ -202,7 +202,7 @@
(if (memq (car-safe expr) '(+ -)) (if (memq (car-safe expr) '(+ -))
(math-list-to-sum (math-list-to-sum
(sort (math-sum-to-list expr) (sort (math-sum-to-list expr)
(function (lambda (a b) (math-beforep (car a) (car b)))))) (lambda (a b) (math-beforep (car a) (car b)))))
expr)) expr))
(defun math-list-to-sum (lst) (defun math-list-to-sum (lst)
@ -387,7 +387,7 @@ This returns only the remainder from the pseudo-division."
lst lst
(if (eq a -1) (if (eq a -1)
(math-mul-list lst a) (math-mul-list lst a)
(mapcar (function (lambda (x) (math-poly-div-exact x a))) lst)))) (mapcar (lambda (x) (math-poly-div-exact x a)) lst))))
(defun math-mul-list (lst a) (defun math-mul-list (lst a)
(if (eq a 1) (if (eq a 1)
@ -395,7 +395,7 @@ This returns only the remainder from the pseudo-division."
(if (eq a -1) (if (eq a -1)
(mapcar 'math-neg lst) (mapcar 'math-neg lst)
(and (not (eq a 0)) (and (not (eq a 0))
(mapcar (function (lambda (x) (math-mul x a))) lst))))) (mapcar (lambda (x) (math-mul x a)) lst)))))
;;; Run GCD on all elements in a list. ;;; Run GCD on all elements in a list.
(defun math-poly-gcd-list (lst) (defun math-poly-gcd-list (lst)
@ -502,10 +502,10 @@ Take the base that has the highest degree considering both a and b.
(defun math-sort-poly-base-list (lst) (defun math-sort-poly-base-list (lst)
"Sort a list of polynomial bases." "Sort a list of polynomial bases."
(sort lst (function (lambda (a b) (sort lst (lambda (a b)
(or (> (nth 1 a) (nth 1 b)) (or (> (nth 1 a) (nth 1 b))
(and (= (nth 1 a) (nth 1 b)) (and (= (nth 1 a) (nth 1 b))
(math-beforep (car a) (car b)))))))) (math-beforep (car a) (car b)))))))
;;; Given an expression find all variables that are polynomial bases. ;;; Given an expression find all variables that are polynomial bases.
;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
@ -1033,10 +1033,9 @@ If no partial fraction representation can be found, return nil."
(math-transpose (math-transpose
(cons 'vec (cons 'vec
(mapcar (mapcar
(function (lambda (x)
(lambda (x) (cons 'vec (math-padded-polynomial
(cons 'vec (math-padded-polynomial x var tdeg)))
x var tdeg))))
(cdr eqns)))))) (cdr eqns))))))
(and (math-vectorp eqns) (and (math-vectorp eqns)
(let ((res 0) (let ((res 0)

14
lisp/calc/calc-prog.el
View file

@ -182,7 +182,7 @@
odef key keyname cmd cmd-base cmd-base-default odef key keyname cmd cmd-base cmd-base-default
func calc-user-formula-alist is-symb) func calc-user-formula-alist is-symb)
(if is-lambda (if is-lambda
(setq math-arglist (mapcar (function (lambda (x) (nth 1 x))) (setq math-arglist (mapcar (lambda (x) (nth 1 x))
(nreverse (cdr (reverse (cdr form))))) (nreverse (cdr (reverse (cdr form)))))
form (nth (1- (length form)) form)) form (nth (1- (length form)) form))
(calc-default-formula-arglist form) (calc-default-formula-arglist form)
@ -290,10 +290,10 @@
(y-or-n-p (y-or-n-p
"Leave it symbolic for non-constant arguments? "))) "Leave it symbolic for non-constant arguments? ")))
(setq calc-user-formula-alist (setq calc-user-formula-alist
(mapcar (function (lambda (x) (mapcar (lambda (x)
(or (cdr (assq x '((nil . arg-nil) (or (cdr (assq x '((nil . arg-nil)
(t . arg-t)))) (t . arg-t))))
x))) calc-user-formula-alist)) x)) calc-user-formula-alist))
(if cmd (if cmd
(progn (progn
(require 'calc-macs) (require 'calc-macs)
@ -319,8 +319,8 @@
(append (append
(list 'lambda calc-user-formula-alist) (list 'lambda calc-user-formula-alist)
(and is-symb (and is-symb
(mapcar (function (lambda (v) (mapcar (lambda (v)
(list 'math-check-const v t))) (list 'math-check-const v t))
calc-user-formula-alist)) calc-user-formula-alist))
(list body)))) (list body))))
(put func 'calc-user-defn form) (put func 'calc-user-defn form)

77
lisp/calc/calc-rewr.el
View file

@ -181,19 +181,18 @@
(calc-line-numbering nil) (calc-line-numbering nil)
(calc-show-selections t) (calc-show-selections t)
(calc-why nil) (calc-why nil)
(math-mt-func (function (math-mt-func (lambda (x)
(lambda (x) (let ((result (math-apply-rewrites x (cdr crules)
(let ((result (math-apply-rewrites x (cdr crules) heads crules)))
heads crules))) (if result
(if result (progn
(progn (if trace-buffer
(if trace-buffer (let ((fmt (math-format-stack-value
(let ((fmt (math-format-stack-value (list result nil nil))))
(list result nil nil)))) (with-current-buffer trace-buffer
(with-current-buffer trace-buffer (insert "\nrewrite to\n" fmt "\n"))))
(insert "\nrewrite to\n" fmt "\n")))) (setq heads (math-rewrite-heads result heads t))))
(setq heads (math-rewrite-heads result heads t)))) result))))
result)))))
(if trace-buffer (if trace-buffer
(let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil)))) (let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
(with-current-buffer trace-buffer (with-current-buffer trace-buffer
@ -485,8 +484,8 @@
(let ((math-rewrite-whole t)) (let ((math-rewrite-whole t))
(cdr (math-compile-rewrites (cons (cdr (math-compile-rewrites (cons
'vec 'vec
(mapcar (function (lambda (x) (mapcar (lambda (x)
(list 'vec x t))) (list 'vec x t))
(if (eq (car-safe pats) 'vec) (if (eq (car-safe pats) 'vec)
(cdr pats) (cdr pats)
(list pats))))))))) (list pats)))))))))
@ -656,15 +655,14 @@
nil nil
(nreverse (nreverse
(mapcar (mapcar
(function (lambda (v)
(lambda (v) (and (car v)
(and (car v) (list
(list 'calcFunc-assign
'calcFunc-assign (math-build-var-name
(math-build-var-name (car v))
(car v)) (math-rwcomp-register-expr
(math-rwcomp-register-expr (nth 1 v)))))
(nth 1 v))))))
math-regs)))) math-regs))))
(math-rwcomp-match-vars math-rhs)) (math-rwcomp-match-vars math-rhs))
math-remembering) math-remembering)
@ -672,7 +670,7 @@
(let* ((heads (math-rewrite-heads math-pattern)) (let* ((heads (math-rewrite-heads math-pattern))
(rule (list (vconcat (rule (list (vconcat
(nreverse (nreverse
(mapcar (function (lambda (x) (nth 3 x))) (mapcar (lambda (x) (nth 3 x))
math-regs))) math-regs)))
math-prog math-prog
heads heads
@ -724,10 +722,9 @@
(setq rules (cdr rules))) (setq rules (cdr rules)))
(if nil-rules (if nil-rules
(setq rule-set (cons (cons nil nil-rules) rule-set))) (setq rule-set (cons (cons nil nil-rules) rule-set)))
(setq all-heads (mapcar 'car (setq all-heads (mapcar #'car
(sort all-heads (function (sort all-heads (lambda (x y)
(lambda (x y) (< (cdr x) (cdr y))))))
(< (cdr x) (cdr y)))))))
(let ((set rule-set) (let ((set rule-set)
rule heads ptr) rule heads ptr)
(while set (while set
@ -790,15 +787,14 @@
(math-rewrite-heads-rec (car expr))))))) (math-rewrite-heads-rec (car expr)))))))
(defun math-parse-schedule (sched) (defun math-parse-schedule (sched)
(mapcar (function (mapcar (lambda (s)
(lambda (s) (if (integerp s)
(if (integerp s) s
s (if (math-vectorp s)
(if (math-vectorp s) (math-parse-schedule (cdr s))
(math-parse-schedule (cdr s)) (if (eq (car-safe s) 'var)
(if (eq (car-safe s) 'var) (math-var-to-calcFunc s)
(math-var-to-calcFunc s) (error "Improper component in rewrite schedule")))))
(error "Improper component in rewrite schedule"))))))
sched)) sched))
(defun math-rwcomp-match-vars (expr) (defun math-rwcomp-match-vars (expr)
@ -1180,9 +1176,8 @@
(list 'calcFunc-register (list 'calcFunc-register
reg2)))) reg2))))
(math-rwcomp-pattern (car arg2) (cdr arg2)))) (math-rwcomp-pattern (car arg2) (cdr arg2))))
(let* ((args (mapcar (function (let* ((args (mapcar (lambda (x)
(lambda (x) (cons x (math-rwcomp-best-reg x)))
(cons x (math-rwcomp-best-reg x))))
(cdr expr))) (cdr expr)))
(args2 (copy-sequence args)) (args2 (copy-sequence args))
(argp (reverse args2)) (argp (reverse args2))

71
lisp/calc/calc-store.el
View file

@ -168,15 +168,13 @@
() ()
(setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
(define-key calc-var-name-map " " 'self-insert-command) (define-key calc-var-name-map " " 'self-insert-command)
(mapc (function (mapc (lambda (x)
(lambda (x)
(define-key calc-var-name-map (char-to-string x) (define-key calc-var-name-map (char-to-string x)
'calcVar-digit))) 'calcVar-digit))
"0123456789") "0123456789")
(mapc (function (mapc (lambda (x)
(lambda (x)
(define-key calc-var-name-map (char-to-string x) (define-key calc-var-name-map (char-to-string x)
'calcVar-oper))) 'calcVar-oper))
"+-*/^|")) "+-*/^|"))
(defvar calc-store-opers) (defvar calc-store-opers)
@ -324,10 +322,9 @@
(calc-pop-push-record (calc-pop-push-record
(1+ calc-given-value-flag) (1+ calc-given-value-flag)
(concat "=" (calc-var-name (car (car var)))) (concat "=" (calc-var-name (car (car var))))
(let ((saved-val (mapcar (function (let ((saved-val (mapcar (lambda (v)
(lambda (v) (and (boundp (car v))
(and (boundp (car v)) (symbol-value (car v))))
(symbol-value (car v)))))
var))) var)))
(unwind-protect (unwind-protect
(let ((vv var)) (let ((vv var))
@ -597,13 +594,12 @@
calc-settings-file))) calc-settings-file)))
(if var (if var
(calc-insert-permanent-variable var) (calc-insert-permanent-variable var)
(mapatoms (function (mapatoms (lambda (x)
(lambda (x) (and (string-match "\\`var-" (symbol-name x))
(and (string-match "\\`var-" (symbol-name x)) (not (memq x calc-dont-insert-variables))
(not (memq x calc-dont-insert-variables)) (calc-var-value x)
(calc-var-value x) (not (eq (car-safe (symbol-value x)) 'special-const))
(not (eq (car-safe (symbol-value x)) 'special-const)) (calc-insert-permanent-variable x)))))
(calc-insert-permanent-variable x))))))
(save-buffer)))) (save-buffer))))
@ -638,27 +634,26 @@
(defun calc-insert-variables (buf) (defun calc-insert-variables (buf)
(interactive "bBuffer in which to save variable values: ") (interactive "bBuffer in which to save variable values: ")
(with-current-buffer buf (with-current-buffer buf
(mapatoms (function (mapatoms (lambda (x)
(lambda (x) (and (string-match "\\`var-" (symbol-name x))
(and (string-match "\\`var-" (symbol-name x)) (not (memq x calc-dont-insert-variables))
(not (memq x calc-dont-insert-variables)) (calc-var-value x)
(calc-var-value x) (not (eq (car-safe (symbol-value x)) 'special-const))
(not (eq (car-safe (symbol-value x)) 'special-const)) (or (not (eq x 'var-Decls))
(or (not (eq x 'var-Decls)) (not (equal var-Decls '(vec))))
(not (equal var-Decls '(vec)))) (or (not (eq x 'var-Holidays))
(or (not (eq x 'var-Holidays)) (not (equal var-Holidays '(vec (var sat var-sat)
(not (equal var-Holidays '(vec (var sat var-sat) (var sun var-sun)))))
(var sun var-sun))))) (insert "(setq "
(insert "(setq " (symbol-name x)
(symbol-name x) " "
" " (prin1-to-string
(prin1-to-string (let ((calc-language
(let ((calc-language (if (memq calc-language '(nil big))
(if (memq calc-language '(nil big)) 'flat
'flat calc-language)))
calc-language))) (math-format-value (symbol-value x) 100000)))
(math-format-value (symbol-value x) 100000))) ")\n"))))))
")\n")))))))
(defun calc-assign (arg) (defun calc-assign (arg)
(interactive "P") (interactive "P")

6
lisp/calc/calc-stuff.el
View file

@ -182,7 +182,7 @@ With a prefix, push that prefix as a number onto the stack."
math-eval-rules-cache-tag t math-eval-rules-cache-tag t
math-format-date-cache nil math-format-date-cache nil
math-holidays-cache-tag t) math-holidays-cache-tag t)
(mapc (function (lambda (x) (set x -100))) math-cache-list) (mapc (lambda (x) (set x -100)) math-cache-list)
(unless inhibit-msg (unless inhibit-msg
(message "All internal calculator caches have been reset")))) (message "All internal calculator caches have been reset"))))
@ -258,14 +258,14 @@ With a prefix, push that prefix as a number onto the stack."
(t (list 'calcFunc-clean a))))) (t (list 'calcFunc-clean a)))))
(defun calcFunc-pclean (a &optional prec) (defun calcFunc-pclean (a &optional prec)
(math-map-over-constants (function (lambda (x) (calcFunc-clean x prec))) (math-map-over-constants (lambda (x) (calcFunc-clean x prec))
a)) a))
(defun calcFunc-pfloat (a) (defun calcFunc-pfloat (a)
(math-map-over-constants 'math-float a)) (math-map-over-constants 'math-float a))
(defun calcFunc-pfrac (a &optional tol) (defun calcFunc-pfrac (a &optional tol)
(math-map-over-constants (function (lambda (x) (calcFunc-frac x tol))) (math-map-over-constants (lambda (x) (calcFunc-frac x tol))
a)) a))
;; The variable math-moc-func is local to math-map-over-constants, ;; The variable math-moc-func is local to math-map-over-constants,

40
lisp/calc/calc-units.el
View file

@ -860,23 +860,22 @@ If COMP or STD is non-nil, put that in the units table instead."
tab) tab)
(message "Building units table...") (message "Building units table...")
(setq math-units-table-buffer-valid nil) (setq math-units-table-buffer-valid nil)
(setq tab (mapcar (function (setq tab (mapcar (lambda (x)
(lambda (x) (list (car x)
(list (car x) (and (nth 1 x)
(and (nth 1 x) (if (stringp (nth 1 x))
(if (stringp (nth 1 x)) (let ((exp (math-read-plain-expr
(let ((exp (math-read-plain-expr (nth 1 x))))
(nth 1 x)))) (if (eq (car-safe exp) 'error)
(if (eq (car-safe exp) 'error) (error "Format error in definition of %s in units table: %s"
(error "Format error in definition of %s in units table: %s" (car x) (nth 2 exp))
(car x) (nth 2 exp)) exp))
exp)) (nth 1 x)))
(nth 1 x))) (nth 2 x)
(nth 2 x) (nth 3 x)
(nth 3 x) (and (not (nth 1 x))
(and (not (nth 1 x)) (list (cons (car x) 1)))
(list (cons (car x) 1))) (nth 4 x)))
(nth 4 x))))
combined-units)) combined-units))
(let ((math-units-table tab)) (let ((math-units-table tab))
(mapc #'math-find-base-units tab)) (mapc #'math-find-base-units tab))
@ -1100,10 +1099,9 @@ If COMP or STD is non-nil, put that in the units table instead."
(setq math-decompose-units-cache (setq math-decompose-units-cache
(cons entry (cons entry
(sort ulist (sort ulist
(function (lambda (x y)
(lambda (x y) (not (Math-lessp (nth 1 x)
(not (Math-lessp (nth 1 x) (nth 1 y)))))))))
(nth 1 y))))))))))
(cdr math-decompose-units-cache)))) (cdr math-decompose-units-cache))))
(defun math-decompose-unit-part (unit) (defun math-decompose-unit-part (unit)

18
lisp/calc/calc-vec.el
View file

@ -744,7 +744,7 @@
;;; Get the Nth row of a matrix. ;;; Get the Nth row of a matrix.
(defun calcFunc-mrow (mat n) ; [Public] (defun calcFunc-mrow (mat n) ; [Public]
(if (Math-vectorp n) (if (Math-vectorp n)
(math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n) (math-map-vec (lambda (x) (calcFunc-mrow mat x)) n)
(if (and (eq (car-safe n) 'intv) (math-constp n)) (if (and (eq (car-safe n) 'intv) (math-constp n))
(calcFunc-subvec mat (calcFunc-subvec mat
(math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1)) (math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
@ -768,15 +768,15 @@
;;; Get the Nth column of a matrix. ;;; Get the Nth column of a matrix.
(defun math-mat-col (mat n) (defun math-mat-col (mat n)
(cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat)))) (cons 'vec (mapcar (lambda (x) (elt x n)) (cdr mat))))
(defun calcFunc-mcol (mat n) ; [Public] (defun calcFunc-mcol (mat n) ; [Public]
(if (Math-vectorp n) (if (Math-vectorp n)
(calcFunc-trn (calcFunc-trn
(math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n)) (math-map-vec (lambda (x) (calcFunc-mcol mat x)) n))
(if (and (eq (car-safe n) 'intv) (math-constp n)) (if (and (eq (car-safe n) 'intv) (math-constp n))
(if (math-matrixp mat) (if (math-matrixp mat)
(math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat) (math-map-vec (lambda (x) (calcFunc-mrow x n)) mat)
(calcFunc-mrow mat n)) (calcFunc-mrow mat n))
(or (and (integerp (setq n (math-check-integer n))) (or (and (integerp (setq n (math-check-integer n)))
(> n 0)) (> n 0))
@ -804,7 +804,7 @@
;;; Remove the Nth column from a matrix. ;;; Remove the Nth column from a matrix.
(defun math-mat-less-col (mat n) (defun math-mat-less-col (mat n)
(cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n))) (cons 'vec (mapcar (lambda (x) (math-mat-less-row x n))
(cdr mat)))) (cdr mat))))
(defun calcFunc-mrcol (mat n) ; [Public] (defun calcFunc-mrcol (mat n) ; [Public]
@ -939,10 +939,10 @@
(calcFunc-idn a (1- (length m))) (calcFunc-idn a (1- (length m)))
(if (math-vectorp m) (if (math-vectorp m)
(if (math-zerop a) (if (math-zerop a)
(cons 'vec (mapcar (function (lambda (x) (cons 'vec (mapcar (lambda (x)
(if (math-vectorp x) (if (math-vectorp x)
(math-mimic-ident a x) (math-mimic-ident a x)
a))) a))
(cdr m))) (cdr m)))
(math-dimension-error)) (math-dimension-error))
(calcFunc-idn a)))) (calcFunc-idn a))))

11
lisp/calc/calc-yank.el
View file

@ -643,12 +643,11 @@ Interactively, reads the register using `register-read-with-preview'."
(allow-ret (> n 1)) (allow-ret (> n 1))
(list (math-showing-full-precision (list (math-showing-full-precision
(mapcar (if (> n 1) (mapcar (if (> n 1)
(function (lambda (x) (lambda (x)
(math-format-flat-expr x 0))) (math-format-flat-expr x 0))
(function (lambda (x)
(lambda (x) (if (math-vectorp x) (setq allow-ret t))
(if (math-vectorp x) (setq allow-ret t)) (math-format-nice-expr x (frame-width))))
(math-format-nice-expr x (frame-width)))))
(if (> n 0) (if (> n 0)
(calc-top-list n) (calc-top-list n)
(calc-top-list 1 (- n))))))) (calc-top-list 1 (- n)))))))

11
lisp/calc/calc.el
View file

@ -506,7 +506,7 @@ The variable VAR will be added to `calc-mode-var-list'."
(defun calc-mode-var-list-restore-default-values () (defun calc-mode-var-list-restore-default-values ()
"Restore the default values of the variables in `calc-mode-var-list'." "Restore the default values of the variables in `calc-mode-var-list'."
(mapcar (function (lambda (v) (set (car v) (nth 1 v)))) (mapcar (lambda (v) (set (car v) (nth 1 v)))
calc-mode-var-list)) calc-mode-var-list))
(defun calc-mode-var-list-restore-saved-values () (defun calc-mode-var-list-restore-saved-values ()
@ -535,7 +535,7 @@ The variable VAR will be added to `calc-mode-var-list'."
newvarlist))) newvarlist)))
(setq varlist (cdr varlist))))))) (setq varlist (cdr varlist)))))))
(if newvarlist (if newvarlist
(mapcar (function (lambda (v) (set (car v) (nth 1 v)))) (mapcar (lambda (v) (set (car v) (nth 1 v)))
newvarlist) newvarlist)
(calc-mode-var-list-restore-default-values)))) (calc-mode-var-list-restore-default-values))))
@ -1315,8 +1315,9 @@ Notations: 3.14e6 3.14 * 10^6
\\{calc-mode-map} \\{calc-mode-map}
" "
(interactive) (interactive)
(mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? (mapc (lambda (v)
(lambda (v) (set-default v (symbol-value v)))) ;; FIXME: Why (set-default v (symbol-value v)) ?!?!?
(set-default v (symbol-value v)))
calc-local-var-list) calc-local-var-list)
(kill-all-local-variables) (kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total) (use-local-map (if (eq calc-algebraic-mode 'total)
@ -1537,7 +1538,7 @@ See `window-dedicated-p' for what that means."
(let ((tail (nthcdr (1- calc-undo-length) calc-undo-list))) (let ((tail (nthcdr (1- calc-undo-length) calc-undo-list)))
(if tail (setcdr tail nil))) (if tail (setcdr tail nil)))
(setq calc-redo-list nil)))) (setq calc-redo-list nil))))
(mapc (function (lambda (v) (set-default v (symbol-value v)))) (mapc (lambda (v) (set-default v (symbol-value v)))
calc-local-var-list) calc-local-var-list)
(let ((buf (current-buffer)) (let ((buf (current-buffer))
(win (get-buffer-window (current-buffer))) (win (get-buffer-window (current-buffer)))

117
lisp/calc/calccomp.el
View file

@ -464,14 +464,13 @@
(math-compose-vector (cdr (nth 1 a)) (math-compose-vector (cdr (nth 1 a))
(math-vector-to-string sep nil) (math-vector-to-string sep nil)
(or cprec prec)) (or cprec prec))
(cons 'horiz (mapcar (function (cons 'horiz (mapcar (lambda (x)
(lambda (x) (if (eq (car-safe x) 'calcFunc-bstring)
(if (eq (car-safe x) 'calcFunc-bstring) (prog1
(prog1 (math-compose-expr
(math-compose-expr x (or bprec cprec prec))
x (or bprec cprec prec)) (setq bprec -123))
(setq bprec -123)) (math-compose-expr x (or cprec prec))))
(math-compose-expr x (or cprec prec)))))
(cdr (nth 1 a))))))) (cdr (nth 1 a)))))))
((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert)) ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
(not (eq calc-language 'unform)) (not (eq calc-language 'unform))
@ -482,47 +481,46 @@
(let* ((base 0) (let* ((base 0)
(v 0) (v 0)
(prec (or (nth 2 a) prec)) (prec (or (nth 2 a) prec))
(c (mapcar (function (c (mapcar (lambda (x)
(lambda (x) (let ((b nil) (cc nil) a d)
(let ((b nil) (cc nil) a d) (if (and (memq (car-safe x) '(calcFunc-cbase
(if (and (memq (car-safe x) '(calcFunc-cbase calcFunc-ctbase
calcFunc-ctbase calcFunc-cbbase))
calcFunc-cbbase)) (memq (length x) '(1 2)))
(memq (length x) '(1 2))) (setq b (car x)
(setq b (car x) x (nth 1 x)))
x (nth 1 x))) (if (and (eq (car-safe x) 'calcFunc-crule)
(if (and (eq (car-safe x) 'calcFunc-crule) (memq (length x) '(1 2))
(memq (length x) '(1 2)) (or (null (nth 1 x))
(or (null (nth 1 x)) (and (math-vectorp (nth 1 x))
(and (math-vectorp (nth 1 x)) (= (length (nth 1 x)) 2)
(= (length (nth 1 x)) 2) (math-vector-is-string
(math-vector-is-string (nth 1 x)))
(nth 1 x))) (and (natnump (nth 1 x))
(and (natnump (nth 1 x)) (<= (nth 1 x) 255))))
(<= (nth 1 x) 255)))) (setq cc (list
(setq cc (list 'rule
'rule (if (math-vectorp (nth 1 x))
(if (math-vectorp (nth 1 x)) (aref (math-vector-to-string
(aref (math-vector-to-string (nth 1 x) nil) 0)
(nth 1 x) nil) 0) (or (nth 1 x) ?-))))
(or (nth 1 x) ?-)))) (or (and (memq (car-safe x) '(calcFunc-cvspace
(or (and (memq (car-safe x) '(calcFunc-cvspace calcFunc-ctspace
calcFunc-ctspace calcFunc-cbspace))
calcFunc-cbspace)) (memq (length x) '(2 3))
(memq (length x) '(2 3)) (eq (nth 1 x) 0))
(eq (nth 1 x) 0)) (null x)
(null x) (setq cc (math-compose-expr x prec))))
(setq cc (math-compose-expr x prec)))) (setq a (if cc (math-comp-ascent cc) 0)
(setq a (if cc (math-comp-ascent cc) 0) d (if cc (math-comp-descent cc) 0))
d (if cc (math-comp-descent cc) 0)) (if (eq b 'calcFunc-cbase)
(if (eq b 'calcFunc-cbase) (setq base (+ v a -1))
(setq base (+ v a -1)) (if (eq b 'calcFunc-ctbase)
(if (eq b 'calcFunc-ctbase) (setq base v)
(setq base v) (if (eq b 'calcFunc-cbbase)
(if (eq b 'calcFunc-cbbase) (setq base (+ v a d -1)))))
(setq base (+ v a d -1))))) (setq v (+ v a d))
(setq v (+ v a d)) cc))
cc)))
(cdr (nth 1 a))))) (cdr (nth 1 a)))))
(setq c (delq nil c)) (setq c (delq nil c))
(if c (if c
@ -865,16 +863,15 @@
(while (<= (setq col (1+ col)) cols) (while (<= (setq col (1+ col)) cols)
(setq res (cons (cons math-comp-just (setq res (cons (cons math-comp-just
(cons base (cons base
(mapcar (function (mapcar (lambda (r)
(lambda (r) (list 'horiz
(list 'horiz (math-compose-expr
(math-compose-expr (nth col r)
(nth col r) math-comp-vector-prec)
math-comp-vector-prec) (if (= col cols)
(if (= col cols) ""
"" (concat
(concat math-comp-comma-spc " "))))
math-comp-comma-spc " ")))))
a))) a)))
res))) res)))
(nreverse res))) (nreverse res)))
@ -923,7 +920,7 @@
( ?\^? . "\\^?" ))) ( ?\^? . "\\^?" )))
(defun math-vector-to-string (a &optional quoted) (defun math-vector-to-string (a &optional quoted)
(setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x))) (setq a (concat (mapcar (lambda (x) (if (consp x) (nth 1 x) x))
(cdr a)))) (cdr a))))
(if (string-match "[\000-\037\177\\\"]" a) (if (string-match "[\000-\037\177\\\"]" a)
(let ((p 0) (let ((p 0)