From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Tue, 10 Jul 2012 11:27:27 +0000 (-0400)
Subject: * lisp/emacs-lisp/gv.el (cond): Make it a valid place.
X-Git-Tag: emacs-24.2.90~1199^2~91
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2519d43af2534242f5b9cb393dc0d41eff95c9ac;p=emacs.git

* lisp/emacs-lisp/gv.el (cond): Make it a valid place.
(if): Simplify slightly.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dbe46c66d50..a441bd0456f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 2012-07-10  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* emacs-lisp/gv.el (cond): Make it a valid place.
+	(if): Simplify slightly.
+
 	* emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns".
 	(pcase--self-quoting-p): New function.
 	(pcase--u1): Use it.
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.