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

(if): Simplify slightly.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dbe46c66d50bd4f4c1a625b232c738f2cb44b44b..a441bd0456f5931bafcfa7932de1e75b7a912e74 100644 (file)
--- 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 147ae5d4870432b3ef6da41a49526a7c1abecb10..eb0e64e22b8762cae75ce60d759a367e40b1db08 100644 (file)
--- 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.