diff options
Diffstat (limited to 'lisp/emacs-lisp/cl.el')
| -rw-r--r-- | lisp/emacs-lisp/cl.el | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index ea4d9511f9d..46472ccd257 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -1,6 +1,6 @@ ;;; cl.el --- Compatibility aliases for the old CL library. -*- lexical-binding: t -*- -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. +;; Copyright (C) 2012-2015 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: extensions @@ -29,6 +29,7 @@ (require 'cl-lib) (require 'macroexp) +(require 'gv) ;; (defun cl--rename () ;; (let ((vdefs ()) @@ -341,6 +342,8 @@ The two cases that are handled are: - renaming of F when it's a function defined via `cl-labels' or `labels'." (require 'cl-macs) (declare-function cl--expr-contains-any "cl-macs" (x y)) + (declare-function cl--labels-convert "cl-macs" (f)) + (defvar cl--labels-convert-cache) (cond ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked ;; *after* handling `function', but we want to stop macroexpansion from @@ -373,13 +376,7 @@ The two cases that are handled are: (setq cl--function-convert-cache (cons newf res)) res)))) (t - (let ((found (assq f macroexpand-all-environment))) - (if (and found (ignore-errors - (eq (cadr (cl-caddr found)) 'cl-labels-args))) - (cadr (cl-caddr (cl-cadddr found))) - (let ((res `(function ,f))) - (setq cl--function-convert-cache (cons f res)) - res)))))) + (cl--labels-convert f)))) (defmacro lexical-let (bindings &rest body) "Like `let', but lexically scoped. @@ -400,7 +397,7 @@ lexical closures as in Common Lisp. (macroexpand-all `(cl-symbol-macrolet ,(mapcar (lambda (x) - `(,(car x) (symbol-value ,(cl-caddr x)))) + `(,(car x) (symbol-value ,(nth 2 x)))) vars) ,@body) (cons (cons 'function #'cl--function-convert) @@ -413,20 +410,20 @@ lexical closures as in Common Lisp. ;; dynamic scoping, since with lexical scoping we'd need ;; (let ((foo <val>)) ...foo...). `(progn - ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars) - (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars) + ,@(mapcar (lambda (x) `(defvar ,(nth 2 x))) vars) + (let ,(mapcar (lambda (x) (list (nth 2 x) (nth 1 x))) vars) ,(cl-sublis (mapcar (lambda (x) - (cons (cl-caddr x) - `',(cl-caddr x))) + (cons (nth 2 x) + `',(nth 2 x))) vars) ebody))) `(let ,(mapcar (lambda (x) - (list (cl-caddr x) + (list (nth 2 x) `(make-symbol ,(format "--%s--" (car x))))) vars) (setf ,@(apply #'append (mapcar (lambda (x) - (list `(symbol-value ,(cl-caddr x)) (cadr x))) + (list `(symbol-value ,(nth 2 x)) (nth 1 x))) vars))) ,ebody)))) @@ -571,7 +568,7 @@ may be bound to temporary variables which are introduced automatically to preserve proper execution order of the arguments. For example: - (defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v)) + (defsetf nth (n x) (v) \\=`(setcar (nthcdr ,n ,x) ,v)) You can replace this form with `gv-define-setter'. @@ -629,6 +626,8 @@ You can replace this form with `gv-define-setter'. ;; ...the rest, and build the 5-tuple)) (make-obsolete 'get-setf-method 'gv-letplace "24.3") +(declare-function cl--arglist-args "cl-macs" (args)) + (defmacro define-modify-macro (name arglist func &optional doc) "Define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other @@ -642,6 +641,7 @@ You can replace this macro with `gv-letplace'." symbolp &optional stringp))) (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) + (require 'cl-macs) ;For cl--arglist-args. (let ((place (make-symbol "--cl-place--"))) `(cl-defmacro ,name (,place ,@arglist) ,doc |