mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 06:20:43 -08:00
Code Issues Projects Releases Wiki Activity

Fix multiple Calc defmath errors (bug#46750)

Browse source 
Fix incorrect variable scoping in `let*`, `for` and `foreach`.
Fix loop variable value in `foreach` (should be element, not tail).
Fix function quoting, as in ('cons x y) -- didn't work at all.

Reported by Stephan Neuhaus.

* lisp/calc/calc-prog.el (math-define-exp, math-handle-foreach):
* test/lisp/calc/calc-tests.el: (var-g, test1, test2, test3, test4)
(test5, test6, test7, calc-defmath): Test various defmath forms.
This commit is contained in:
Mattias Engdegård 2021-03-01 20:52:39 +01:00
parent 5f319423c8
commit 08b11a02f4
2 changed files with 114 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1985,22 +1985,37 @@ Redefine the corresponding command."
(cons 'quote
(math-define-lambda (nth 1 exp) math-exp-env))
exp))
((memq func '(let let* for foreach))
(let ((head (nth 1 exp))
(body (cdr (cdr exp))))
(if (memq func '(let let*))
()
(setq func (cdr (assq func '((for . math-for)
(foreach . math-foreach)))))
(if (not (listp (car head)))
(setq head (list head))))
(macroexpand
(cons func
(cons (math-define-let head)
(math-define-body body
(nconc
(math-define-let-env head)
math-exp-env)))))))
((eq func 'let)
(let ((bindings (nth 1 exp))
(body (cddr exp)))
`(let ,(math-define-let bindings)
,@(math-define-body
body (append (math-define-let-env bindings)
math-exp-env)))))
((eq func 'let*)
;; Rewrite in terms of `let'.
(let ((bindings (nth 1 exp))
(body (cddr exp)))
(math-define-exp
(if (> (length bindings) 1)
`(let ,(list (car bindings))
(let* ,(cdr bindings) ,@body))
`(let ,bindings ,@body)))))
((memq func '(for foreach))
(let ((bindings (nth 1 exp))
(body (cddr exp)))
(if (> (length bindings) 1)
;; Rewrite as nested loops.
(math-define-exp
`(,func ,(list (car bindings))
(,func ,(cdr bindings) ,@body)))
(let ((mac (cdr (assq func '((for . math-for)
(foreach . math-foreach))))))
(macroexpand
`(,mac ,(math-define-let bindings)
,@(math-define-body
body (append (math-define-let-env bindings)
math-exp-env))))))))
((and (memq func '(setq setf))
(math-complicated-lhs (cdr exp)))
(if (> (length exp) 3)
@ -2017,7 +2032,7 @@ Redefine the corresponding command."
(math-define-cond (cdr exp))))
((and (consp func) ; ('spam a b) == force use of plain spam
(eq (car func) 'quote))
(cons func (math-define-list (cdr exp))))
(cons (cadr func) (math-define-list (cdr exp))))
((symbolp func)
(let ((args (math-define-list (cdr exp)))
(prim (assq func math-prim-funcs)))
@ -2276,20 +2291,16 @@ Redefine the corresponding command."
(defun math-handle-foreach (head body)
(let ((var (nth 0 (car head)))
(loop-var (gensym "foreach"))
(data (nth 1 (car head)))
(body (if (cdr head)
(list (math-handle-foreach (cdr head) body))
body)))
(cons 'let
(cons (list (list var data))
(list
(cons 'while
(cons var
(append body
(list (list 'setq
var
(list 'cdr var)))))))))))
`(let ((,loop-var ,data))
(while ,loop-var
(let ((,var (car ,loop-var)))
,@(append body
`((setq ,loop-var (cdr ,loop-var)))))))))
(defun math-body-refers-to (body thing)
(or (equal body thing)