Commit 2056db3f authored by Alan Mackenzie's avatar Alan Mackenzie

Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.

Also expunge eudc-c[ad]+r.

* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.

* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.

* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.

* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc.  Invoke them.

* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
parent 5842e489
2015-04-05 Alan Mackenzie <acm@muc.de>
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Changed from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr,
etc.
2015-04-05 Richard Stallman <rms@gnu.org> 2015-04-05 Richard Stallman <rms@gnu.org>
* mail/rmail.el (rmail-show-message-1): When displaying a mime message, * mail/rmail.el (rmail-show-message-1): When displaying a mime message,
......
...@@ -1468,7 +1468,7 @@ after that many seconds of idle time." ...@@ -1468,7 +1468,7 @@ after that many seconds of idle time."
(dolist (record compacted-vars) (dolist (record compacted-vars)
(let* (let*
((var (car record)) ((var (car record))
(deser-fun (cl-caddr (assq var desktop-var-serdes-funs)))) (deser-fun (caddr (assq var desktop-var-serdes-funs))))
(if deser-fun (set var (funcall deser-fun (cadr record)))))))) (if deser-fun (set var (funcall deser-fun (cadr record))))))))
result)))) result))))
......
...@@ -612,7 +612,7 @@ This function assumes that the events can be stored in a string." ...@@ -612,7 +612,7 @@ This function assumes that the events can be stored in a string."
((eq (car ev) 'switch-frame)) ((eq (car ev) 'switch-frame))
((equal ev '(menu-bar)) ((equal ev '(menu-bar))
(push 'menu-bar result)) (push 'menu-bar result))
((equal (cl-cadadr ev) '(menu-bar)) ((equal (cadadr ev) '(menu-bar))
(push (vector 'menu-bar (car ev)) result)) (push (vector 'menu-bar (car ev)) result))
;; It would be nice to do pop-up menus, too, but not enough ;; It would be nice to do pop-up menus, too, but not enough
;; info is recorded in macros to make this possible. ;; info is recorded in macros to make this possible.
......
...@@ -385,8 +385,8 @@ Signal an error if X is not a list." ...@@ -385,8 +385,8 @@ Signal an error if X is not a list."
(null x) (null x)
(signal 'wrong-type-argument (list 'listp x '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-third '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-fourth 'cadddr "Return the fourth element of the list X.")
(defsubst cl-fifth (x) (defsubst cl-fifth (x)
"Return the fifth element of the list X." "Return the fifth element of the list X."
...@@ -418,126 +418,159 @@ Signal an error if X is not a list." ...@@ -418,126 +418,159 @@ Signal an error if X is not a list."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
(nth 9 x)) (nth 9 x))
(defun cl-caaar (x) (defun caaar (x)
"Return the `car' of the `car' of the `car' of X." "Return the `car' of the `car' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (car (car x)))) (car (car (car x))))
(defun cl-caadr (x) (defun caadr (x)
"Return the `car' of the `car' of the `cdr' of X." "Return the `car' of the `car' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (car (cdr x)))) (car (car (cdr x))))
(defun cl-cadar (x) (defun cadar (x)
"Return the `car' of the `cdr' of the `car' of X." "Return the `car' of the `cdr' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (cdr (car x)))) (car (cdr (car x))))
(defun cl-caddr (x) (defun caddr (x)
"Return the `car' of the `cdr' of the `cdr' of X." "Return the `car' of the `cdr' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (cdr (cdr x)))) (car (cdr (cdr x))))
(defun cl-cdaar (x) (defun cdaar (x)
"Return the `cdr' of the `car' of the `car' of X." "Return the `cdr' of the `car' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (car (car x)))) (cdr (car (car x))))
(defun cl-cdadr (x) (defun cdadr (x)
"Return the `cdr' of the `car' of the `cdr' of X." "Return the `cdr' of the `car' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (car (cdr x)))) (cdr (car (cdr x))))
(defun cl-cddar (x) (defun cddar (x)
"Return the `cdr' of the `cdr' of the `car' of X." "Return the `cdr' of the `cdr' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (cdr (car x)))) (cdr (cdr (car x))))
(defun cl-cdddr (x) (defun cdddr (x)
"Return the `cdr' of the `cdr' of the `cdr' of X." "Return the `cdr' of the `cdr' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (cdr (cdr x)))) (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." "Return the `car' of the `car' of the `car' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (car (car (car x))))) (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." "Return the `car' of the `car' of the `car' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (car (car (cdr x))))) (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." "Return the `car' of the `car' of the `cdr' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (car (cdr (car x))))) (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." "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (car (cdr (cdr x))))) (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." "Return the `car' of the `cdr' of the `car' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (cdr (car (car x))))) (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." "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (cdr (car (cdr x))))) (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." "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (cdr (cdr (car x))))) (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." "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(car (cdr (cdr (cdr x))))) (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." "Return the `cdr' of the `car' of the `car' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (car (car (car x))))) (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." "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (car (car (cdr x))))) (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." "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (car (cdr (car x))))) (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." "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (car (cdr (cdr x))))) (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." "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (cdr (car (car x))))) (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." "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (cdr (car (cdr x))))) (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." "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (cdr (cdr (car x))))) (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." "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
(declare (compiler-macro cl--compiler-macro-cXXr)) (declare (compiler-macro cl--compiler-macro-cXXr))
(cdr (cdr (cdr (cdr x))))) (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) ;;(defun last* (x &optional n)
;; "Returns the last link in the list LIST. ;; "Returns the last link in the list LIST.
;;With optional argument N, returns Nth-to-last link (default 1)." ;;With optional argument N, returns Nth-to-last link (default 1)."
......
...@@ -70,6 +70,9 @@ ...@@ -70,6 +70,9 @@
(setq form `(cons ,(car args) ,form))) (setq form `(cons ,(car args) ,form)))
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 ;;;###autoload
(defun cl--compiler-macro-cXXr (form x) (defun cl--compiler-macro-cXXr (form x)
(let* ((head (car form)) (let* ((head (car form))
...@@ -500,7 +503,7 @@ its argument list allows full Common Lisp conventions." ...@@ -500,7 +503,7 @@ its argument list allows full Common Lisp conventions."
(while (and (eq (car args) '&aux) (pop args)) (while (and (eq (car args) '&aux) (pop args))
(while (and args (not (memq (car args) cl--lambda-list-keywords))) (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(if (consp (car args)) (if (consp (car args))
(if (and cl--bind-enquote (cl-cadar args)) (if (and cl--bind-enquote (cadar args))
(cl--do-arglist (caar args) (cl--do-arglist (caar args)
`',(cadr (pop args))) `',(cadr (pop 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." ...@@ -584,7 +587,7 @@ its argument list allows full Common Lisp conventions."
(if (eq ?_ (aref name 0)) (if (eq ?_ (aref name 0))
(setq name (substring name 1))) (setq name (substring name 1)))
(intern (format ":%s" name))))) (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) (def (if (cdr arg) (cadr arg)
;; The ordering between those two or clauses is ;; The ordering between those two or clauses is
;; irrelevant, since in practice only one of the two ;; irrelevant, since in practice only one of the two
...@@ -1188,10 +1191,10 @@ For more details, see Info node `(cl)Loop Facility'. ...@@ -1188,10 +1191,10 @@ For more details, see Info node `(cl)Loop Facility'.
(if (memq (car cl--loop-args) '(downto above)) (if (memq (car cl--loop-args) '(downto above))
(error "Must specify `from' value for downward cl-loop")) (error "Must specify `from' value for downward cl-loop"))
(let* ((down (or (eq (car cl--loop-args) 'downfrom) (let* ((down (or (eq (car cl--loop-args) 'downfrom)
(memq (cl-caddr cl--loop-args) (memq (caddr cl--loop-args)
'(downto above)))) '(downto above))))
(excl (or (memq (car cl--loop-args) '(above below)) (excl (or (memq (car cl--loop-args) '(above below))
(memq (cl-caddr cl--loop-args) (memq (caddr cl--loop-args)
'(above below)))) '(above below))))
(start (and (memq (car cl--loop-args) (start (and (memq (car cl--loop-args)
'(from upfrom downfrom)) '(from upfrom downfrom))
...@@ -1291,7 +1294,7 @@ For more details, see Info node `(cl)Loop Facility'. ...@@ -1291,7 +1294,7 @@ For more details, see Info node `(cl)Loop Facility'.
(temp-idx (temp-idx
(if (eq (car cl--loop-args) 'using) (if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2) (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)) (cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause")) (error "Bad `using' clause"))
(make-symbol "--cl-idx--")))) (make-symbol "--cl-idx--"))))
...@@ -1323,8 +1326,8 @@ For more details, see Info node `(cl)Loop Facility'. ...@@ -1323,8 +1326,8 @@ For more details, see Info node `(cl)Loop Facility'.
(other (other
(if (eq (car cl--loop-args) 'using) (if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2) (if (and (= (length (cadr cl--loop-args)) 2)
(memq (cl-caadr cl--loop-args) hash-types) (memq (caadr cl--loop-args) hash-types)
(not (eq (cl-caadr cl--loop-args) word))) (not (eq (caadr cl--loop-args) word)))
(cadr (cl--pop2 cl--loop-args)) (cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause")) (error "Bad `using' clause"))
(make-symbol "--cl-var--")))) (make-symbol "--cl-var--"))))
...@@ -1386,8 +1389,8 @@ For more details, see Info node `(cl)Loop Facility'. ...@@ -1386,8 +1389,8 @@ For more details, see Info node `(cl)Loop Facility'.
(other (other
(if (eq (car cl--loop-args) 'using) (if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2) (if (and (= (length (cadr cl--loop-args)) 2)
(memq (cl-caadr cl--loop-args) key-types) (memq (caadr cl--loop-args) key-types)
(not (eq (cl-caadr cl--loop-args) word))) (not (eq (caadr cl--loop-args) word)))
(cadr (cl--pop2 cl--loop-args)) (cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause")) (error "Bad `using' clause"))
(make-symbol "--cl-var--")))) (make-symbol "--cl-var--"))))
...@@ -1611,7 +1614,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings." ...@@ -1611,7 +1614,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings."
(let ((temps nil) (new nil)) (let ((temps nil) (new nil))
(when par (when par
(let ((p specs)) (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))) (setq p (cdr p)))
(when p (when p
(setq par nil) (setq par nil)
...@@ -1686,7 +1689,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ...@@ -1686,7 +1689,7 @@ such that COMBO is equivalent to (and . CLAUSES)."
(setq clauses (cons (nconc (butlast (car clauses)) (setq clauses (cons (nconc (butlast (car clauses))
(if (eq (car-safe (cadr clauses)) (if (eq (car-safe (cadr clauses))
'progn) 'progn)
(cl-cdadr clauses) (cdadr clauses)
(list (cadr clauses)))) (list (cadr clauses))))
(cddr clauses))) (cddr clauses)))
;; A final (progn ,@A t) is moved outside of the `and'. ;; A final (progn ,@A t) is moved outside of the `and'.
...@@ -1828,7 +1831,7 @@ from OBARRAY. ...@@ -1828,7 +1831,7 @@ from OBARRAY.
(let (,(car spec)) (let (,(car spec))
(mapatoms #'(lambda (,(car spec)) ,@body) (mapatoms #'(lambda (,(car spec)) ,@body)
,@(and (cadr spec) (list (cadr spec)))) ,@(and (cadr spec) (list (cadr spec))))
,(cl-caddr spec)))) ,(caddr spec))))
;;;###autoload ;;;###autoload
(defmacro cl-do-all-symbols (spec &rest body) (defmacro cl-do-all-symbols (spec &rest body)
...@@ -2105,9 +2108,9 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). ...@@ -2105,9 +2108,9 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
;; FIXME: For N bindings, this will traverse `body' N times! ;; FIXME: For N bindings, this will traverse `body' N times!
(macroexpand-all (macroexp-progn body) (macroexpand-all (macroexp-progn body)
(cons (list (symbol-name (caar bindings)) (cons (list (symbol-name (caar bindings))
(cl-cadar bindings)) (cadar bindings))
macroexpand-all-environment)))) macroexpand-all-environment))))
(if (or (null (cdar bindings)) (cl-cddar bindings)) (if (or (null (cdar bindings)) (cddar bindings))
(macroexp--warn-and-return (macroexp--warn-and-return
(format "Malformed `cl-symbol-macrolet' binding: %S" (format "Malformed `cl-symbol-macrolet' binding: %S"
(car bindings)) (car bindings))
...@@ -2216,7 +2219,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). ...@@ -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)) ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
(while (setq spec (cdr spec)) (while (setq spec (cdr spec))
(if (consp (car spec)) (if (consp (car spec))
(if (eq (cl-cadar spec) 0) (if (eq (cadar spec) 0)
(byte-compile-disable-warning (caar spec)) (byte-compile-disable-warning (caar spec))
(byte-compile-enable-warning (caar spec))))))) (byte-compile-enable-warning (caar spec)))))))
nil) nil)
...@@ -2660,9 +2663,9 @@ non-nil value, that slot cannot be set via `setf'. ...@@ -2660,9 +2663,9 @@ non-nil value, that slot cannot be set via `setf'.
(t `(and (consp cl-x) (t `(and (consp cl-x)
(memq (nth ,pos cl-x) ,tag-symbol)))))) (memq (nth ,pos cl-x) ,tag-symbol))))))
pred-check (and pred-form (> safety 0) pred-check (and pred-form (> safety 0)
(if (and (eq (cl-caadr pred-form) 'vectorp) (if (and (eq (caadr pred-form) 'vectorp)
(= safety 1)) (= safety 1))
(cons 'and (cl-cdddr pred-form)) (cons 'and (cdddr pred-form))
`(,predicate cl-x)))) `(,predicate cl-x))))
(let ((pos 0) (descp descs)) (let ((pos 0) (descp descs))
(while descp (while descp
...@@ -3090,14 +3093,14 @@ macro that returns its `&whole' argument." ...@@ -3090,14 +3093,14 @@ macro that returns its `&whole' argument."
cl-fifth cl-sixth cl-seventh cl-fifth cl-sixth cl-seventh
cl-eighth cl-ninth cl-tenth cl-eighth cl-ninth cl-tenth
cl-rest cl-endp cl-plusp cl-minusp cl-rest cl-endp cl-plusp cl-minusp
cl-caaar cl-caadr cl-cadar caaar caadr cadar
cl-caddr cl-cdaar cl-cdadr caddr cdaar cdadr
cl-cddar cl-cdddr cl-caaaar cddar cdddr caaaar
cl-caaadr cl-caadar cl-caaddr caaadr caadar caaddr
cl-cadaar cl-cadadr cl-caddar cadaar cadadr caddar
cl-cadddr cl-cdaaar cl-cdaadr cadddr cdaaar cdaadr
cl-cdadar cl-cdaddr cl-cddaar cdadar cdaddr cddaar
cl-cddadr cl-cdddar cl-cddddr)) cddadr cdddar cddddr))
(put y 'side-effect-free t)) (put y 'side-effect-free t))
;;; Things that are inline. ;;; Things that are inline.
......
...@@ -259,30 +259,6 @@ ...@@ -259,30 +259,6 @@
copy-list copy-list
ldiff ldiff
list* 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 tenth
ninth ninth
eighth eighth
...@@ -397,7 +373,7 @@ lexical closures as in Common Lisp. ...@@ -397,7 +373,7 @@ lexical closures as in Common Lisp.
(macroexpand-all (macroexpand-all
`(cl-symbol-macrolet `(cl-symbol-macrolet
,(mapcar (lambda (x) ,(mapcar (lambda (x)
`(,(car x) (symbol-value ,(cl-caddr x)))) `(,(car x) (symbol-value ,(caddr x))))
vars) vars)
,@body) ,@body)
(cons (cons 'function #'cl--function-convert) (cons (cons 'function #'cl--function-convert)
...@@ -410,20 +386,20 @@ lexical closures as in Common Lisp. ...@@ -410,20 +386,20 @@ lexical closures as in Common Lisp.
;; dynamic scoping, since with lexical scoping we'd need ;; dynamic scoping, since with lexical scoping we'd need
;; (let ((foo <val>)) ...foo...). ;; (let ((foo <val>)) ...foo...).
`(progn `(progn
,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars) ,@(mapcar (lambda (x) `(defvar ,(caddr x))) vars)