[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 08b11a0 3/3: Fix multiple Calc defmath errors (bug#46750)
|
From: |
Mattias Engdegård |
|
Subject: |
master 08b11a0 3/3: Fix multiple Calc defmath errors (bug#46750) |
|
Date: |
Mon, 1 Mar 2021 15:01:04 -0500 (EST) |
branch: master
commit 08b11a02f49da5ca0e4e58a32fa853df0c5e0214
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
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.
---
lisp/calc/calc-prog.el | 65 +++++++++++++++++++++----------------
test/lisp/calc/calc-tests.el | 76 ++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 114 insertions(+), 27 deletions(-)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 3097b09..dd22145 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -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)
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index bdcf78e..c5aa5a3 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -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