summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2012-07-10 07:27:27 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2012-07-10 07:27:27 -0400
commit2519d43af2534242f5b9cb393dc0d41eff95c9ac (patch)
treeb54f1fabf307d40edcae14d0040e1d4ee22facd8 /lisp/emacs-lisp
parent02bd72573bef39cf345c0b0a945b6bb739dda67d (diff)
downloademacs-2519d43af2534242f5b9cb393dc0d41eff95c9ac.tar.gz
emacs-2519d43af2534242f5b9cb393dc0d41eff95c9ac.tar.bz2
emacs-2519d43af2534242f5b9cb393dc0d41eff95c9ac.zip
* lisp/emacs-lisp/gv.el (cond): Make it a valid place.
(if): Simplify slightly.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/gv.el64
1 files changed, 48 insertions, 16 deletions
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 147ae5d4870..eb0e64e22b8 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -361,22 +361,54 @@ The return value is the last VAL in the list.
(put 'if 'gv-expander
(lambda (do test then &rest else)
- (let ((v (make-symbol "v")))
- (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy)))
- ;; This duplicates the `do' code, which is a problem if that
- ;; code is large, but otherwise results in more efficient code.
- `(if ,test ,(gv-get then do)
- ,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
- (macroexp-let2 nil b test
- (macroexp-let2 nil
- gv `(if ,b ,(gv-letplace (getter setter) then
- `(cons (lambda () ,getter)
- (lambda (,v) ,(funcall setter v))))
- ,(gv-letplace (getter setter) (macroexp-progn else)
- `(cons (lambda () ,getter)
- (lambda (,v) ,(funcall setter v)))))
- (funcall do `(funcall (car ,gv))
- (lambda (v) `(funcall (cdr ,gv) ,v)))))))))
+ (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy)))
+ ;; This duplicates the `do' code, which is a problem if that
+ ;; code is large, but otherwise results in more efficient code.
+ `(if ,test ,(gv-get then do)
+ ,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
+ (let ((v (make-symbol "v")))
+ (macroexp-let2 nil
+ gv `(if ,test ,(gv-letplace (getter setter) then
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))
+ ,(gv-letplace (getter setter) (macroexp-progn else)
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v)))))
+ (funcall do `(funcall (car ,gv))
+ (lambda (v) `(funcall (cdr ,gv) ,v))))))))
+
+(put 'cond 'gv-expander
+ (lambda (do &rest branches)
+ (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy)))
+ ;; This duplicates the `do' code, which is a problem if that
+ ;; code is large, but otherwise results in more efficient code.
+ `(cond
+ ,@(mapcar (lambda (branch)
+ (if (cdr branch)
+ (cons (car branch)
+ (macroexp-unprogn
+ (gv-get (macroexp-progn (cdr branch)) do)))
+ (gv-get (car branch) do)))
+ branches))
+ (let ((v (make-symbol "v")))
+ (macroexp-let2 nil
+ gv `(cond
+ ,@(mapcar
+ (lambda (branch)
+ (if (cdr branch)
+ `(,(car branch)
+ ,@(macroexp-unprogn
+ (gv-letplace (getter setter)
+ (macroexp-progn (cdr branch))
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))))
+ (gv-letplace (getter setter)
+ (car branch)
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))))
+ branches))
+ (funcall do `(funcall (car ,gv))
+ (lambda (v) `(funcall (cdr ,gv) ,v))))))))
;;; Even more debatable extensions.