cl-lib.el: Partial revert of "2015-04-05 Rationalize c[ad]+r"

* lisp/emacs-lisp/cl-lib.el: Partial revert of "2015-04-05 Rationalize
use of c[ad]+r", so as to keep the "cl-" prefix on all
cl-lib definitions.

3 files changed, 108 insertions, 128 deletions

diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 3ee5e0416c0..6b43c126130 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 'caddr "Return the third element of the list X.")
-(cl--defalias 'cl-fourth 'cadddr "Return the fourth element of the list 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.")
 
 (defsubst cl-fifth (x)
   "Return the fifth element of the list X."
@@ -418,159 +418,126 @@ Signal an error if X is not a list."
   (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
   (nth 9 x))
 
-(defun caaar (x)
+(defun cl-caaar (x)
   "Return the `car' of the `car' of the `car' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (car (car (car x))))
 
-(defun caadr (x)
+(defun cl-caadr (x)
   "Return the `car' of the `car' of the `cdr' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (car (car (cdr x))))
 
-(defun cadar (x)
+(defun cl-cadar (x)
   "Return the `car' of the `cdr' of the `car' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (car (cdr (car x))))
 
-(defun caddr (x)
+(defun cl-caddr (x)
   "Return the `car' of the `cdr' of the `cdr' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (car (cdr (cdr x))))
 
-(defun cdaar (x)
+(defun cl-cdaar (x)
   "Return the `cdr' of the `car' of the `car' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (cdr (car (car x))))
 
-(defun cdadr (x)
+(defun cl-cdadr (x)
   "Return the `cdr' of the `car' of the `cdr' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (cdr (car (cdr x))))
 
-(defun cddar (x)
+(defun cl-cddar (x)
   "Return the `cdr' of the `cdr' of the `car' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (cdr (cdr (car x))))
 
-(defun cdddr (x)
+(defun cl-cdddr (x)
   "Return the `cdr' of the `cdr' of the `cdr' of X."
-  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (declare (compiler-macro internal--compiler-macro-cXXr))
   (cdr (cdr (cdr x))))
 
-(defun caaaar (x)
+(defun cl-caaaar (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 internal--compiler-macro-cXXr))
   (car (car (car (car x)))))
 
-(defun caaadr (x)
+(defun cl-caaadr (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 internal--compiler-macro-cXXr))
   (car (car (car (cdr x)))))
 
-(defun caadar (x)
+(defun cl-caadar (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 internal--compiler-macro-cXXr))
   (car (car (cdr (car x)))))
 
-(defun caaddr (x)
+(defun cl-caaddr (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 internal--compiler-macro-cXXr))
   (car (car (cdr (cdr x)))))
 
-(defun cadaar (x)
+(defun cl-cadaar (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 internal--compiler-macro-cXXr))
   (car (cdr (car (car x)))))
 
-(defun cadadr (x)
+(defun cl-cadadr (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 internal--compiler-macro-cXXr))
   (car (cdr (car (cdr x)))))
 
-(defun caddar (x)
+(defun cl-caddar (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 internal--compiler-macro-cXXr))
   (car (cdr (cdr (car x)))))
 
-(defun cadddr (x)
+(defun cl-cadddr (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 internal--compiler-macro-cXXr))
   (car (cdr (cdr (cdr x)))))
 
-(defun cdaaar (x)
+(defun cl-cdaaar (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 internal--compiler-macro-cXXr))
   (cdr (car (car (car x)))))
 
-(defun cdaadr (x)
+(defun cl-cdaadr (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 internal--compiler-macro-cXXr))
   (cdr (car (car (cdr x)))))
 
-(defun cdadar (x)
+(defun cl-cdadar (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 internal--compiler-macro-cXXr))
   (cdr (car (cdr (car x)))))
 
-(defun cdaddr (x)
+(defun cl-cdaddr (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 internal--compiler-macro-cXXr))
   (cdr (car (cdr (cdr x)))))
 
-(defun cddaar (x)
+(defun cl-cddaar (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 internal--compiler-macro-cXXr))
   (cdr (cdr (car (car x)))))
 
-(defun cddadr (x)
+(defun cl-cddadr (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 internal--compiler-macro-cXXr))
   (cdr (cdr (car (cdr x)))))
 
-(defun cdddar (x)
+(defun cl-cdddar (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 internal--compiler-macro-cXXr))
   (cdr (cdr (cdr (car x)))))
 
-(defun cddddr (x)
+(defun cl-cddddr (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 internal--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 fa6a4bc3a72..69f2792f4bd 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -74,19 +74,8 @@
 ;; `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))
-         (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)))
-            (cl--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)))
+(define-obsolete-function-alias 'cl--compiler-macro-cXXr
+  'internal--compiler-macro-cXXr "25.1")
 
 ;;; Some predicates for analyzing Lisp forms.
 ;; These are used by various
@@ -503,7 +492,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 (cadar args))
+          (if (and cl--bind-enquote (cl-cadar args))
               (cl--do-arglist (caar args)
                               `',(cadr (pop args)))
             (cl--do-arglist (caar args) (cadr (pop args))))
@@ -587,7 +576,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)) (cadar arg) (car arg)))
+		   (varg (if (consp (car arg)) (cl-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
@@ -1191,10 +1180,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 (caddr cl--loop-args)
+				 (memq (nth 2 cl--loop-args)
                                        '(downto above))))
 		       (excl (or (memq (car cl--loop-args) '(above below))
-				 (memq (caddr cl--loop-args)
+				 (memq (nth 2 cl--loop-args)
                                        '(above below))))
 		       (start (and (memq (car cl--loop-args)
                                          '(from upfrom downfrom))
@@ -1294,7 +1283,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 (caadr cl--loop-args) 'index))
+                                    (eq (cl-caadr cl--loop-args) 'index))
                                (cadr (cl--pop2 cl--loop-args))
                              (error "Bad `using' clause"))
                          (make-symbol "--cl-idx--"))))
@@ -1326,8 +1315,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 (caadr cl--loop-args) hash-types)
-                                     (not (eq (caadr cl--loop-args) word)))
+                                     (memq (cl-caadr cl--loop-args) hash-types)
+                                     (not (eq (cl-caadr cl--loop-args) word)))
                                 (cadr (cl--pop2 cl--loop-args))
                               (error "Bad `using' clause"))
                           (make-symbol "--cl-var--"))))
@@ -1389,8 +1378,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 (caadr cl--loop-args) key-types)
-                                    (not (eq (caadr cl--loop-args) word)))
+                                    (memq (cl-caadr cl--loop-args) key-types)
+                                    (not (eq (cl-caadr cl--loop-args) word)))
                                (cadr (cl--pop2 cl--loop-args))
                              (error "Bad `using' clause"))
                          (make-symbol "--cl-var--"))))
@@ -1614,7 +1603,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 (cadar p))))
+        (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
           (setq p (cdr p)))
         (when p
           (setq par nil)
@@ -1689,7 +1678,7 @@ such that COMBO is equivalent to (and . CLAUSES)."
 	      (setq clauses (cons (nconc (butlast (car clauses))
 					 (if (eq (car-safe (cadr clauses))
 						 'progn)
-					     (cdadr clauses)
+					     (cl-cdadr clauses)
 					   (list (cadr clauses))))
 				  (cddr clauses)))
             ;; A final (progn ,@A t) is moved outside of the `and'.
@@ -1831,7 +1820,7 @@ from OBARRAY.
      (let (,(car spec))
        (mapatoms #'(lambda (,(car spec)) ,@body)
                  ,@(and (cadr spec) (list (cadr spec))))
-       ,(caddr spec))))
+       ,(nth 2 spec))))
 
 ;;;###autoload
 (defmacro cl-do-all-symbols (spec &rest body)
@@ -2108,9 +2097,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))
-                                                (cadar bindings))
+                                                (cl-cadar bindings))
                                           macroexpand-all-environment))))
-              (if (or (null (cdar bindings)) (cddar bindings))
+              (if (or (null (cdar bindings)) (cl-cddar bindings))
                   (macroexp--warn-and-return
                    (format "Malformed `cl-symbol-macrolet' binding: %S"
                            (car bindings))
@@ -2219,7 +2208,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 (cadar spec) 0)
+	       (if (eq (cl-cadar spec) 0)
                    (byte-compile-disable-warning (caar spec))
                  (byte-compile-enable-warning (caar spec)))))))
   nil)
@@ -2663,9 +2652,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 (caadr pred-form) 'vectorp)
+			  (if (and (eq (cl-caadr pred-form) 'vectorp)
 				   (= safety 1))
-			      (cons 'and (cdddr pred-form))
+			      (cons 'and (cl-cdddr pred-form))
                             `(,predicate cl-x))))
     (let ((pos 0) (descp descs))
       (while descp
@@ -3093,14 +3082,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
-             caaar caadr cadar
-             caddr cdaar cdadr
-             cddar cdddr caaaar
-             caaadr caadar caaddr
-             cadaar cadadr caddar
-             cadddr cdaaar cdaadr
-             cdadar cdaddr cddaar
-             cddadr cdddar cddddr))
+             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))
   (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 be7b6f4022a..564a44457d8 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -259,6 +259,30 @@
                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
@@ -373,7 +397,7 @@ lexical closures as in Common Lisp.
 	  (macroexpand-all
            `(cl-symbol-macrolet
                 ,(mapcar (lambda (x)
-                           `(,(car x) (symbol-value ,(caddr x))))
+                           `(,(car x) (symbol-value ,(nth 2 x))))
                          vars)
               ,@body)
 	   (cons (cons 'function #'cl--function-convert)
@@ -386,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 ,(caddr x))) vars)
-           (let ,(mapcar (lambda (x) (list (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 (caddr x)
-                                    `',(caddr x)))
+                              (cons (nth 2 x)
+                                    `',(nth 2 x)))
                             vars)
                     ebody)))
       `(let ,(mapcar (lambda (x)
-                       (list (caddr x)
+                       (list (nth 2 x)
                              `(make-symbol ,(format "--%s--" (car x)))))
                      vars)
          (setf ,@(apply #'append
                         (mapcar (lambda (x)
-                                  (list `(symbol-value ,(caddr x)) (cadr x)))
+                                  (list `(symbol-value ,(nth 2 x)) (nth 1 x)))
                                 vars)))
          ,ebody))))