[Emacs-diffs] /srv/bzr/emacs/trunk r108996: * lisp/emacs-lisp/gv.el (cond): Make it a valid place.

[Stefan Monnier]

------------------------------------------------------------
revno: 108996
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2012-07-10 07:27:27 -0400
message:
  * lisp/emacs-lisp/gv.el (cond): Make it a valid place.
  (if): Simplify slightly.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/gv.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-10 09:26:04 +0000
+++ b/lisp/ChangeLog    2012-07-10 11:27:27 +0000
@@ -1,5 +1,8 @@
 2012-07-10  Stefan Monnier  <address@hidden>
 
+       * 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.

=== modified file 'lisp/emacs-lisp/gv.el'
--- a/lisp/emacs-lisp/gv.el     2012-06-22 21:24:54 +0000
+++ b/lisp/emacs-lisp/gv.el     2012-07-10 11:27:27 +0000
@@ -361,22 +361,54 @@
 
 (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.