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.

21 files changed, 202 insertions, 143 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 33e14568376..643ea78de71 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,41 @@
+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>
 
         * mail/rmail.el (rmail-show-message-1): When displaying a mime message,
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 3eca5a6a774..4b76052ca21 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1468,7 +1468,7 @@ after that many seconds of idle time."
             (dolist (record compacted-vars)
               (let*
                   ((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))))))))
         result))))
 
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 84dfd4f1ebf..d759160d10d 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -612,7 +612,7 @@ This function assumes that the events can be stored in a string."
                 ((eq (car ev) 'switch-frame))
                 ((equal ev '(menu-bar))
                  (push 'menu-bar result))
-                ((equal (cl-cadadr ev) '(menu-bar))
+                ((equal (cadadr ev) '(menu-bar))
                  (push (vector 'menu-bar (car ev)) result))
                 ;; It would be nice to do pop-up menus, too, but not enough
                 ;; info is recorded in macros to make this possible.
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))))
 
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 17fe39be844..adff85332a8 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -809,7 +809,7 @@ For the description of FORCE-ONSCREEN, see `frameset-restore'.
 When forced onscreen, frames wider than the monitor's workarea are converted
 to fullwidth, and frames taller than the workarea are converted to fullheight.
 NOTE: This only works for non-iconified frames."
-  (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr (frame-monitor-attributes frame)))
+  (pcase-let* ((`(,left ,top ,width ,height) (cdadr (frame-monitor-attributes frame)))
                (right (+ left width -1))
                (bottom (+ top height -1))
                (fr-left (frameset-compute-pos (frame-parameter frame 'left) left right))
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 8bd1e469650..837fbaeea2c 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2162,7 +2162,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
                       (eq ibuffer-always-show-last-buffer
                           :nomini)
                       (minibufferp (cadr bufs)))
-                     (cl-caddr bufs)
+                     (caddr bufs)
                    (cadr bufs))
                  (ibuffer-current-buffers-with-marks bufs)
                  ibuffer-display-maybe-show-predicates)))
@@ -2194,7 +2194,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
     (require 'ibuf-ext))
   (let* ((sortdat (assq ibuffer-sorting-mode
                         ibuffer-sorting-functions-alist))
-         (func (cl-caddr sortdat)))
+         (func (caddr sortdat)))
     (let ((result
            ;; actually sort the buffers
            (if (and sortdat func)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index ea674434a2f..d841187df0f 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -644,7 +644,7 @@ by using `Footnote-back-to-message'."
   (interactive "*P")
   (let ((num
          (if footnote-text-marker-alist
-             (if (< (point) (cl-cadar (last footnote-pointer-marker-alist)))
+             (if (< (point) (cadar (last footnote-pointer-marker-alist)))
                  (Footnote-make-hole)
                (1+ (caar (last footnote-text-marker-alist))))
            1)))
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index b2c1ba883a4..4f63374a9b6 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -869,7 +869,7 @@ association to the service from D-Bus."
                                 ;; Service.
                                 (string-equal service (cadr e))
                                 ;; Non-empty object path.
-                                (cl-caddr e)
+                                (caddr e)
                                 (throw :found t)))))
                          dbus-registered-objects-table)
                         nil))))
@@ -1474,7 +1474,7 @@ name of the property, and its value.  If there are no properties,
                 bus service path dbus-interface-properties
                 "GetAll" :timeout 500 interface)
                result)
-        (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append)))))
+        (add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
 
 (defun dbus-register-property
   (bus service path interface property access value
@@ -1672,7 +1672,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
                 (if (cadr entry2)
                     ;; "sv".
                     (dolist (entry3 (cadr entry2))
-                      (setcdr entry3 (cl-caadr entry3)))
+                      (setcdr entry3 (caadr entry3)))
                   (setcdr entry2 nil)))))
 
         ;; Fallback: collect the information.  Slooow!
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index 0e54d841d57..ec0914d636b 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -174,7 +174,7 @@ LOCATION is used as the phone location for BBDB."
       (condition-case err
           (setq phone-list (bbdb-parse-phone-number phone))
         (error
-         (if (string= "phone number unparsable." (eudc-cadr err))
+         (if (string= "phone number unparsable." (cadr err))
              (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone)))
                  (error "Phone number unparsable")
                (setq phone-list (list (bbdb-string-trim phone))))
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index cf5d13fce88..ada9eae813e 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -105,18 +105,6 @@
 ;; attribute name
 (defvar eudc-protocol-has-default-query-attributes nil)
 
-(defun eudc-cadr (obj)
-  (car (cdr obj)))
-
-(defun eudc-cdar (obj)
-  (cdr (car obj)))
-
-(defun eudc-caar (obj)
-  (car (car obj)))
-
-(defun eudc-cdaar (obj)
-  (cdr (car (car obj))))
-
 (defun eudc-plist-member (plist prop)
   "Return t if PROP has a value specified in PLIST."
   (if (not (= 0 (% (length plist) 2)))
@@ -555,10 +543,10 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
 
     ;; Search for multiple records
     (while (and rec
-                (not (listp (eudc-cdar rec))))
+                (not (listp (cdar rec))))
       (setq rec (cdr rec)))
 
-    (if (null (eudc-cdar rec))
+    (if (null (cdar rec))
         (list record)                   ; No duplicate attrs in this record
       (mapc (function
              (lambda (field)
@@ -590,7 +578,7 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
              ((eq 'first method)
               (setq result
                     (eudc-add-field-to-records (cons (car field)
-                                                     (eudc-cadr field))
+                                                     (cadr field))
                                                result)))
              ((eq 'concat method)
               (setq result
@@ -710,7 +698,7 @@ If ERROR is non-nil, report an error if there is none."
   (let ((result (eudc-query (list (cons 'name name)) '(email)))
         email)
     (if (null (cdr result))
-        (setq email (eudc-cdaar result))
+        (setq email (cdaar result))
       (error "Multiple match--use the query form"))
     (if error
         (if email
@@ -728,7 +716,7 @@ If ERROR is non-nil, report an error if there is none."
   (let ((result (eudc-query (list (cons 'name name)) '(phone)))
         phone)
     (if (null (cdr result))
-        (setq phone (eudc-cdaar result))
+        (setq phone (cdaar result))
       (error "Multiple match--use the query form"))
     (if error
         (if phone
@@ -765,8 +753,8 @@ otherwise a list of symbols is returned."
           ;; If the same attribute appears more than once, merge
           ;; the corresponding values
           (while query-alist
-            (setq key (eudc-caar query-alist)
-                  val (eudc-cdar query-alist)
+            (setq key (caar query-alist)
+                  val (cdar query-alist)
                   cell (assq key query))
             (if cell
                 (setcdr cell (concat (cdr cell) " " val))
@@ -863,7 +851,7 @@ see `eudc-inline-expansion-servers'"
                 (catch 'found
                   ;; Loop on the servers
                   (while servers
-                    (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t)
+                    (eudc-set-server (caar servers) (cdar servers) t)
 
                     ;; Determine which formats apply in the query-format list
                     (setq query-formats
@@ -1047,14 +1035,14 @@ queries the server for the existing fields and displays a corresponding form."
                                  (point))
                   (setq set-server-p t))
                  ((and (eq (car sexp)  'setq)
-                       (eq (eudc-cadr sexp) 'eudc-server-hotlist))
+                       (eq (cadr sexp) 'eudc-server-hotlist))
                   (delete-region (save-excursion
                                    (backward-sexp)
                                    (point))
                                  (point))
                   (setq set-hotlist-p t))
                  ((and (eq (car sexp)  'provide)
-                       (equal (eudc-cadr sexp) '(quote eudc-options-file)))
+                       (equal (cadr sexp) '(quote eudc-options-file)))
                   (setq provide-p t)))
               (if (and provide-p
                        set-hotlist-p
diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el
index 1897e0b08bc..15e15e2144d 100644
--- a/lisp/net/eudcb-ph.el
+++ b/lisp/net/eudcb-ph.el
@@ -81,7 +81,7 @@ are returned"
   (eudc-ph-do-request "fields")
   (if full-records
       (eudc-ph-parse-query-result)
-    (mapcar 'eudc-caar (eudc-ph-parse-query-result))))
+    (mapcar 'caar (eudc-ph-parse-query-result))))
 
 (defun eudc-ph-parse-query-result (&optional fields)
   "Return a list of alists of key/values from in `eudc-ph-process-buffer'.
@@ -126,9 +126,9 @@ Fields not in FIELDS are discarded."
                       (memq current-key fields))
                   (if key
                       (setq record (cons (cons key value) record)) ; New key
-                    (setcdr (car record) (if (listp (eudc-cdar record))
-                                             (append (eudc-cdar record) (list value))
-                                           (list (eudc-cdar record) value))))))))
+                    (setcdr (car record) (if (listp (cdar record))
+                                             (append (cdar record) (list value))
+                                           (list (cdar record) value))))))))
         (and (not ignore)
              (or (null fields)
                  (eq 'all fields)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 74d03f59f3d..b418c5192be 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2148,7 +2148,7 @@ activity.  Only run if the buffer is not visible and
             (when (and (listp x) (listp (cadr x)))
               (setcdr x (if (> (length (cdr x)) 1)
                             (rcirc-make-trees (cdr x))
-                          (setcdr x (list (cl-cdadr x)))))))
+                          (setcdr x (list (cdadr x)))))))
           alist)))
 
 ;;; /commands these are called with 3 args: PROCESS, TARGET, which is
@@ -2693,7 +2693,7 @@ the only argument."
 (defun rcirc-handler-KICK (process sender args _text)
   (let* ((channel (car args))
          (nick (cadr args))
-         (reason (cl-caddr args))
+         (reason (caddr args))
          (message (concat nick " " channel " " reason)))
     (rcirc-print process sender "KICK" channel message t)
     ;; print in private chat buffer if it exists
@@ -2777,7 +2777,7 @@ the only argument."
   "RPL_AWAY"
   (let* ((nick (cadr args))
          (rec (assoc-string nick rcirc-nick-away-alist))
-         (away-message (cl-caddr args)))
+         (away-message (caddr args)))
     (when (or (not rec)
               (not (string= (cdr rec) away-message)))
       ;; away message has changed
@@ -2806,7 +2806,7 @@ the only argument."
   (let ((buffer (or (rcirc-get-buffer process (cadr args))
                     (rcirc-get-temp-buffer-create process (cadr args)))))
     (with-current-buffer buffer
-      (setq rcirc-topic (cl-caddr args)))))
+      (setq rcirc-topic (caddr args)))))
 
 (defun rcirc-handler-333 (process sender args _text)
   "333 says who set the topic and when.
@@ -2814,16 +2814,16 @@ Not in rfc1459.txt"
   (let ((buffer (or (rcirc-get-buffer process (cadr args))
                     (rcirc-get-temp-buffer-create process (cadr args)))))
     (with-current-buffer buffer
-      (let ((setter (cl-caddr args))
+      (let ((setter (caddr args))
             (time (current-time-string
                    (seconds-to-time
-                    (string-to-number (cl-cadddr args))))))
+                    (string-to-number (cadddr args))))))
         (rcirc-print process sender "TOPIC" (cadr args)
                      (format "%s (%s on %s)" rcirc-topic setter time))))))
 
 (defun rcirc-handler-477 (process sender args _text)
   "ERR_NOCHANMODES"
-  (rcirc-print process sender "477" (cadr args) (cl-caddr args)))
+  (rcirc-print process sender "477" (cadr args) (caddr args)))
 
 (defun rcirc-handler-MODE (process sender args _text)
   (let ((target (car args))
@@ -2883,9 +2883,9 @@ Passwords are stored in `rcirc-authinfo' (which see)."
     (dolist (i rcirc-authinfo)
       (let ((process (rcirc-buffer-process))
             (server (car i))
-            (nick (cl-caddr i))
+            (nick (caddr i))
             (method (cadr i))
-            (args (cl-cdddr i)))
+            (args (cdddr i)))
         (when (and (string-match server rcirc-server))
           (if (and (memq method '(nickserv chanserv bitlbee))
                    (string-match nick rcirc-nick))
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index 45caf7c2339..f7bb91b14f6 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -702,7 +702,7 @@ If there is no such item, return nil."
   (let ((item-path (secrets-item-path collection item)))
     (unless (secrets-empty-path item-path)
       (dbus-byte-array-to-string
-       (cl-caddr
+       (caddr
         (dbus-call-method
          :session secrets-service item-path secrets-interface-item
          "GetSecret" :object-path secrets-session-path))))))
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 0258f1e4e4a..8b1b2171d5c 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -322,7 +322,7 @@ Quit current game           \\[5x5-quit-game]"
           (save-excursion
             (goto-char grid-org)
             (beginning-of-line (+ 1 (/ 5x5-y-scale 2)))
-            (let ((solution-grid (cl-cdadr 5x5-solver-output)))
+            (let ((solution-grid (cdadr 5x5-solver-output)))
               (dotimes (y 5x5-grid-size)
                 (save-excursion
                   (forward-char  (+ 1 (/ (1+ 5x5-x-scale) 2)))
@@ -747,9 +747,9 @@ Solutions are sorted from least to greatest Hamming weight."
                     ;; The Hamming Weight is computed by matrix reduction
                     ;; with an ad-hoc operator.
                     (math-reduce-vec
-                     ;; (cl-cadadr '(vec (mod x 2))) => x
-                     (lambda (r x) (+ (if (integerp r) r (cl-cadadr r))
-                                      (cl-cadadr x)))
+                     ;; (cadadr '(vec (mod x 2))) => x
+                     (lambda (r x) (+ (if (integerp r) r (cadadr r))
+                                      (cadadr x)))
                      solution); car
                     (5x5-vec-to-grid
                      (calcFunc-arrange solution 5x5-grid-size));cdr
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index f42ae90f3c8..98a3ae247fe 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -792,8 +792,8 @@ TOTAL is the total number of letters in the ciphertext."
       (while temp-list
         (insert (caar temp-list)
                 (format "%4d%3d%%  "
-                        (cl-cadar temp-list)
-                        (/ (* 100 (cl-cadar temp-list)) total)))
+                        (cadar temp-list)
+                        (/ (* 100 (cadar temp-list)) total)))
         (setq temp-list (nthcdr 4 temp-list)))
       (insert ?\n)
       (setq freq-list (cdr freq-list)
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index b868db68f30..d2734450593 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -277,7 +277,7 @@ BITS must be of length nrings.  Start at START-TIME."
              ;; Disable display of line and column numbers, for speed.
              (line-number-mode nil) (column-number-mode nil))
           ;; do it!
-          (hanoi-n bits rings (car poles) (cadr poles) (cl-caddr poles)
+          (hanoi-n bits rings (car poles) (cadr poles) (caddr poles)
                    start-time))
         (message "Done"))
     (setq buffer-read-only t)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 7f2fd9274f7..64913c2e014 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -663,8 +663,8 @@ that form should be displayed.")
              (setq tok (cadr tokens))
              (if (eq (car tokens) 'hif-lparen)
                  (if (and (hif-if-valid-identifier-p tok)
-                          (eq (cl-caddr tokens) 'hif-rparen))
-                     (setq tokens (cl-cdddr tokens))
+                          (eq (caddr tokens) 'hif-rparen))
+                     (setq tokens (cdddr tokens))
                    (error "#define followed by non-identifier: %S" tok))
                (setq tok (car tokens)
                      tokens (cdr tokens))
@@ -730,7 +730,7 @@ detecting self-reference."
                        result))
                  ;; Argument list is nil, direct expansion
                  (setq rep (hif-expand-token-list
-                            (cl-caddr rep) ; Macro's token list
+                            (caddr rep) ; Macro's token list
                             tok expand_list))
                  ;; Replace all remaining references immediately
                  (setq remains (cl-substitute tok rep remains))
diff --git a/lisp/ses.el b/lisp/ses.el
index b0a09fff057..f42b61c20e7 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1577,7 +1577,7 @@ if the range was altered."
                  (funcall field (ses-sym-rowcol min))))
           ;; This range has changed size.
           (setq ses-relocate-return 'range))
-      `(ses-range ,min ,max ,@(cl-cdddr range)))))
+      `(ses-range ,min ,max ,@(cdddr range)))))
 
 (defun ses-relocate-all (minrow mincol rowincr colincr)
   "Alter all cell values, symbols, formulas, and reference-lists to relocate
diff --git a/lisp/subr.el b/lisp/subr.el
index 163a1c419d4..00acdb6541f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -339,20 +339,41 @@ configuration."
 
 ;;;; List functions.
 
-(defsubst caar (x)
+;; Note: `internal--compiler-macro-cXXr' was copied from
+;; `cl--compiler-macro-cXXr' in cl-macs.el.  If you amend either one,
+;; you may want to amend the other, too.
+(defun internal--compiler-macro-cXXr (form x)
+  (let* ((head (car form))
+         (n (symbol-name (car form)))
+         (i (- (length n) 2)))
+    (if (not (string-match "c[ad]+r\\'" n))
+        (if (and (fboundp head) (symbolp (symbol-function head)))
+            (internal--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
+                                     x)
+          (error "Compiler macro for cXXr applied to non-cXXr form"))
+      (while (> i (match-beginning 0))
+        (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
+        (setq i (1- i)))
+      x)))
+
+(defun caar (x)
   "Return the car of the car of X."
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (car (car x)))
 
-(defsubst cadr (x)
+(defun cadr (x)
   "Return the car of the cdr of X."
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (car (cdr x)))
 
-(defsubst cdar (x)
+(defun cdar (x)
   "Return the cdr of the car of X."
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (cdr (car x)))
 
-(defsubst cddr (x)
+(defun cddr (x)
   "Return the cdr of the cdr of X."
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (cdr (cdr x)))
 
 (defun last (list &optional n)