diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 85 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 53 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl.el | 38 |
3 files changed, 94 insertions, 82 deletions
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 10651cc29bd..3ee5e0416c0 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -385,8 +385,8 @@ Signal an error if X is not a list." (null x) (signal 'wrong-type-argument (list 'listp x 'x)))) -(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.") -(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.") +(cl--defalias 'cl-third 'caddr "Return the third element of the list X.") +(cl--defalias 'cl-fourth 'cadddr "Return the fourth element of the list X.") (defsubst cl-fifth (x) "Return the fifth element of the list X." @@ -418,126 +418,159 @@ Signal an error if X is not a list." (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) (nth 9 x)) -(defun cl-caaar (x) +(defun caaar (x) "Return the `car' of the `car' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (car (car x)))) -(defun cl-caadr (x) +(defun caadr (x) "Return the `car' of the `car' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (car (cdr x)))) -(defun cl-cadar (x) +(defun cadar (x) "Return the `car' of the `cdr' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (cdr (car x)))) -(defun cl-caddr (x) +(defun caddr (x) "Return the `car' of the `cdr' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (cdr (cdr x)))) -(defun cl-cdaar (x) +(defun cdaar (x) "Return the `cdr' of the `car' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (car (car x)))) -(defun cl-cdadr (x) +(defun cdadr (x) "Return the `cdr' of the `car' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (car (cdr x)))) -(defun cl-cddar (x) +(defun cddar (x) "Return the `cdr' of the `cdr' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (cdr (car x)))) -(defun cl-cdddr (x) +(defun cdddr (x) "Return the `cdr' of the `cdr' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (cdr (cdr x)))) -(defun cl-caaaar (x) +(defun caaaar (x) "Return the `car' of the `car' of the `car' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (car (car (car x))))) -(defun cl-caaadr (x) +(defun caaadr (x) "Return the `car' of the `car' of the `car' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (car (car (cdr x))))) -(defun cl-caadar (x) +(defun caadar (x) "Return the `car' of the `car' of the `cdr' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (car (cdr (car x))))) -(defun cl-caaddr (x) +(defun caaddr (x) "Return the `car' of the `car' of the `cdr' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (car (cdr (cdr x))))) -(defun cl-cadaar (x) +(defun cadaar (x) "Return the `car' of the `cdr' of the `car' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (cdr (car (car x))))) -(defun cl-cadadr (x) +(defun cadadr (x) "Return the `car' of the `cdr' of the `car' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (cdr (car (cdr x))))) -(defun cl-caddar (x) +(defun caddar (x) "Return the `car' of the `cdr' of the `cdr' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (cdr (cdr (car x))))) -(defun cl-cadddr (x) +(defun cadddr (x) "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (car (cdr (cdr (cdr x))))) -(defun cl-cdaaar (x) +(defun cdaaar (x) "Return the `cdr' of the `car' of the `car' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (car (car (car x))))) -(defun cl-cdaadr (x) +(defun cdaadr (x) "Return the `cdr' of the `car' of the `car' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (car (car (cdr x))))) -(defun cl-cdadar (x) +(defun cdadar (x) "Return the `cdr' of the `car' of the `cdr' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (car (cdr (car x))))) -(defun cl-cdaddr (x) +(defun cdaddr (x) "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (car (cdr (cdr x))))) -(defun cl-cddaar (x) +(defun cddaar (x) "Return the `cdr' of the `cdr' of the `car' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (cdr (car (car x))))) -(defun cl-cddadr (x) +(defun cddadr (x) "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (cdr (car (cdr x))))) -(defun cl-cdddar (x) +(defun cdddar (x) "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (cdr (cdr (car x))))) -(defun cl-cddddr (x) +(defun cddddr (x) "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." (declare (compiler-macro cl--compiler-macro-cXXr)) (cdr (cdr (cdr (cdr x))))) +;; Generate aliases cl-cXXr for all the above defuns, and mark them obsolete. +(eval-when-compile + (defun gen-cXXr--rawname (n bits) + "Generate and return a string like \"adad\" corresponding to N. +BITS is the number of a's and d's. +The \"corresponding\" means each bit of N is converted to an \"a\" (for zero) +or a \"d\" (for one)." + (let ((name (make-string bits ?a)) + (mask (lsh 1 (1- bits))) + (elt 0)) + (while (< elt bits) + (if (/= (logand n mask) 0) + (aset name elt ?d)) + (setq elt (1+ elt) + mask (lsh mask -1))) + name)) + + (defmacro gen-cXXr-all-cl-aliases (bits) + "Generate cl- aliases for all defuns `c[ad]+r' with BITS a's and d's. +Also mark the aliases as obsolete." + `(progn + ,@(mapcar + (lambda (n) + (let* ((raw (gen-cXXr--rawname n bits)) + (old (intern (concat "cl-c" raw "r"))) + (new (intern (concat "c" raw "r")))) + `(progn (defalias ',old ',new) + (make-obsolete ',old ',new "25.1")))) + (number-sequence 0 (1- (lsh 1 bits))))))) + +(gen-cXXr-all-cl-aliases 3) +(gen-cXXr-all-cl-aliases 4) + ;;(defun last* (x &optional n) ;; "Returns the last link in the list LIST. ;;With optional argument N, returns Nth-to-last link (default 1)." diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index f8ddc00c3bf..fa6a4bc3a72 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -70,6 +70,9 @@ (setq form `(cons ,(car args) ,form))) form)) +;; Note: `cl--compiler-macro-cXXr' has been copied to +;; `internal--compiler-macro-cXXr' in subr.el. If you amend either +;; one, you may want to amend the other, too. ;;;###autoload (defun cl--compiler-macro-cXXr (form x) (let* ((head (car form)) @@ -500,7 +503,7 @@ its argument list allows full Common Lisp conventions." (while (and (eq (car args) '&aux) (pop args)) (while (and args (not (memq (car args) cl--lambda-list-keywords))) (if (consp (car args)) - (if (and cl--bind-enquote (cl-cadar args)) + (if (and cl--bind-enquote (cadar args)) (cl--do-arglist (caar args) `',(cadr (pop args))) (cl--do-arglist (caar args) (cadr (pop args)))) @@ -584,7 +587,7 @@ its argument list allows full Common Lisp conventions." (if (eq ?_ (aref name 0)) (setq name (substring name 1))) (intern (format ":%s" name))))) - (varg (if (consp (car arg)) (cl-cadar arg) (car arg))) + (varg (if (consp (car arg)) (cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) ;; The ordering between those two or clauses is ;; irrelevant, since in practice only one of the two @@ -1188,10 +1191,10 @@ For more details, see Info node `(cl)Loop Facility'. (if (memq (car cl--loop-args) '(downto above)) (error "Must specify `from' value for downward cl-loop")) (let* ((down (or (eq (car cl--loop-args) 'downfrom) - (memq (cl-caddr cl--loop-args) + (memq (caddr cl--loop-args) '(downto above)))) (excl (or (memq (car cl--loop-args) '(above below)) - (memq (cl-caddr cl--loop-args) + (memq (caddr cl--loop-args) '(above below)))) (start (and (memq (car cl--loop-args) '(from upfrom downfrom)) @@ -1291,7 +1294,7 @@ For more details, see Info node `(cl)Loop Facility'. (temp-idx (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (eq (cl-caadr cl--loop-args) 'index)) + (eq (caadr cl--loop-args) 'index)) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-idx--")))) @@ -1323,8 +1326,8 @@ For more details, see Info node `(cl)Loop Facility'. (other (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) hash-types) - (not (eq (cl-caadr cl--loop-args) word))) + (memq (caadr cl--loop-args) hash-types) + (not (eq (caadr cl--loop-args) word))) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) @@ -1386,8 +1389,8 @@ For more details, see Info node `(cl)Loop Facility'. (other (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) key-types) - (not (eq (cl-caadr cl--loop-args) word))) + (memq (caadr cl--loop-args) key-types) + (not (eq (caadr cl--loop-args) word))) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) @@ -1611,7 +1614,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings." (let ((temps nil) (new nil)) (when par (let ((p specs)) - (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p)))) + (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) (setq p (cdr p))) (when p (setq par nil) @@ -1686,7 +1689,7 @@ such that COMBO is equivalent to (and . CLAUSES)." (setq clauses (cons (nconc (butlast (car clauses)) (if (eq (car-safe (cadr clauses)) 'progn) - (cl-cdadr clauses) + (cdadr clauses) (list (cadr clauses)))) (cddr clauses))) ;; A final (progn ,@A t) is moved outside of the `and'. @@ -1828,7 +1831,7 @@ from OBARRAY. (let (,(car spec)) (mapatoms #'(lambda (,(car spec)) ,@body) ,@(and (cadr spec) (list (cadr spec)))) - ,(cl-caddr spec)))) + ,(caddr spec)))) ;;;###autoload (defmacro cl-do-all-symbols (spec &rest body) @@ -2105,9 +2108,9 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). ;; FIXME: For N bindings, this will traverse `body' N times! (macroexpand-all (macroexp-progn body) (cons (list (symbol-name (caar bindings)) - (cl-cadar bindings)) + (cadar bindings)) macroexpand-all-environment)))) - (if (or (null (cdar bindings)) (cl-cddar bindings)) + (if (or (null (cdar bindings)) (cddar bindings)) (macroexp--warn-and-return (format "Malformed `cl-symbol-macrolet' binding: %S" (car bindings)) @@ -2216,7 +2219,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) (while (setq spec (cdr spec)) (if (consp (car spec)) - (if (eq (cl-cadar spec) 0) + (if (eq (cadar spec) 0) (byte-compile-disable-warning (caar spec)) (byte-compile-enable-warning (caar spec))))))) nil) @@ -2660,9 +2663,9 @@ non-nil value, that slot cannot be set via `setf'. (t `(and (consp cl-x) (memq (nth ,pos cl-x) ,tag-symbol)))))) pred-check (and pred-form (> safety 0) - (if (and (eq (cl-caadr pred-form) 'vectorp) + (if (and (eq (caadr pred-form) 'vectorp) (= safety 1)) - (cons 'and (cl-cdddr pred-form)) + (cons 'and (cdddr pred-form)) `(,predicate cl-x)))) (let ((pos 0) (descp descs)) (while descp @@ -3090,14 +3093,14 @@ macro that returns its `&whole' argument." cl-fifth cl-sixth cl-seventh cl-eighth cl-ninth cl-tenth cl-rest cl-endp cl-plusp cl-minusp - cl-caaar cl-caadr cl-cadar - cl-caddr cl-cdaar cl-cdadr - cl-cddar cl-cdddr cl-caaaar - cl-caaadr cl-caadar cl-caaddr - cl-cadaar cl-cadadr cl-caddar - cl-cadddr cl-cdaaar cl-cdaadr - cl-cdadar cl-cdaddr cl-cddaar - cl-cddadr cl-cdddar cl-cddddr)) + caaar caadr cadar + caddr cdaar cdadr + cddar cdddr caaaar + caaadr caadar caaddr + cadaar cadadr caddar + cadddr cdaaar cdaadr + cdadar cdaddr cddaar + cddadr cdddar cddddr)) (put y 'side-effect-free t)) ;;; Things that are inline. diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 5da1cea6bb3..be7b6f4022a 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -259,30 +259,6 @@ copy-list ldiff list* - cddddr - cdddar - cddadr - cddaar - cdaddr - cdadar - cdaadr - cdaaar - cadddr - caddar - cadadr - cadaar - caaddr - caadar - caaadr - caaaar - cdddr - cddar - cdadr - cdaar - caddr - cadar - caadr - caaar tenth ninth eighth @@ -397,7 +373,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 ,(caddr x)))) vars) ,@body) (cons (cons 'function #'cl--function-convert) @@ -410,20 +386,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 ,(caddr x))) vars) + (let ,(mapcar (lambda (x) (list (caddr x) (cadr x))) vars) ,(cl-sublis (mapcar (lambda (x) - (cons (cl-caddr x) - `',(cl-caddr x))) + (cons (caddr x) + `',(caddr x))) vars) ebody))) `(let ,(mapcar (lambda (x) - (list (cl-caddr x) + (list (caddr 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 ,(caddr x)) (cadr x))) vars))) ,ebody)))) |