diff options
Diffstat (limited to 'lisp/calc')
| -rw-r--r-- | lisp/calc/calc-ext.el | 4 | ||||
| -rw-r--r-- | lisp/calc/calc-prog.el | 65 |
2 files changed, 40 insertions, 29 deletions
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index f4ddb840b50..24781ed6c86 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -2565,9 +2565,9 @@ If X is not an error form, return 1." ;;; True if A is numerically equal to the integer B. [P N S] [Public] ;;; B must not be a multiple of 10. (defun math-equal-int (a b) - (or (eq a b) + (or (eql a b) (and (eq (car-safe a) 'float) - (eq (nth 1 a) b) + (eql (nth 1 a) b) (= (nth 2 a) 0)))) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 3097b09b013..dd221457f83 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) |