mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-07 08:00:48 -08:00
Fix multiple Calc defmath errors (bug#46750)
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
parent
5f319423c8
commit
08b11a02f4
2 changed files with 114 additions and 27 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -707,6 +707,82 @@ An existing calc stack is reused, otherwise a new one is created."
|
|||
(var c var-c))))))
|
||||
(calc-set-language nil)))
|
||||
|
||||
(defvar var-g)
|
||||
|
||||
;; Test `let'.
|
||||
(defmath test1 (x)
|
||||
(let ((x (+ x 1))
|
||||
(y (+ x 3)))
|
||||
(let ((z (+ y 6)))
|
||||
(* x y z g))))
|
||||
|
||||
;; Test `let*'.
|
||||
(defmath test2 (x)
|
||||
(let* ((y (+ x 1))
|
||||
(z (+ y 3)))
|
||||
(let* ((u (+ z 6)))
|
||||
(* x y z u g))))
|
||||
|
||||
;; Test `for'.
|
||||
(defmath test3 (x)
|
||||
(let ((s 0))
|
||||
(for ((ii 1 x)
|
||||
(jj 1 ii))
|
||||
(setq s (+ s (* ii jj))))
|
||||
s))
|
||||
|
||||
;; Test `for' with non-unit stride.
|
||||
(defmath test4 (x)
|
||||
(let ((l nil))
|
||||
(for ((ii 1 x 1)
|
||||
(jj 1 10 ii))
|
||||
(setq l ('cons jj l))) ; Use Lisp `cons', not `calcFunc-cons'.
|
||||
(reverse l)))
|
||||
|
||||
;; Test `foreach'.
|
||||
(defmath test5 (x)
|
||||
(let ((s 0))
|
||||
(foreach ((a x)
|
||||
(b a))
|
||||
(setq s (+ s b)))
|
||||
s))
|
||||
|
||||
;; Test `break'.
|
||||
(defmath test6 (x)
|
||||
(let ((a (for ((ii 1 10))
|
||||
(when (= ii x)
|
||||
(break (* ii 2)))))
|
||||
(b (foreach ((e '(9 3 6)))
|
||||
(when (= e x)
|
||||
(break (- e 1))))))
|
||||
(* a b)))
|
||||
|
||||
;; Test `return' from `for'.
|
||||
(defmath test7 (x)
|
||||
(for ((ii 1 10))
|
||||
(when (= ii x)
|
||||
(return (* ii 2))))
|
||||
5)
|
||||
|
||||
(ert-deftest calc-defmath ()
|
||||
(let ((var-g 17))
|
||||
(should (equal (calcFunc-test1 2) (* 3 5 11 17)))
|
||||
(should (equal (calcFunc-test2 2) (* 2 3 6 12 17))))
|
||||
(should (equal (calcFunc-test3 3)
|
||||
(+ (* 1 1)
|
||||
(* 2 1) (* 2 2)
|
||||
(* 3 1) (* 3 2) (* 3 3))))
|
||||
(should (equal (calcFunc-test4 5)
|
||||
'( 1 2 3 4 5 6 7 8 9 10
|
||||
1 3 5 7 9
|
||||
1 4 7 10
|
||||
1 5 9
|
||||
1 6)))
|
||||
(should (equal (calcFunc-test5 '((2 3) (5) (7 11 13)))
|
||||
(+ 2 3 5 7 11 13)))
|
||||
(should (equal (calcFunc-test6 3) (* (* 3 2) (- 3 1))))
|
||||
(should (equal (calcFunc-test7 3) (* 3 2))))
|
||||
|
||||
(provide 'calc-tests)
|
||||
;;; calc-tests.el ends here
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue