summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog3
-rw-r--r--lisp/emacs-lisp/gv.el64
2 files changed, 51 insertions, 16 deletions
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.