procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2015-04-10 01:50:22 -04:00
parent 5194890891
commit 26f8a38497
18 changed files with 143 additions and 161 deletions
Download patch file Download diff file Expand all files Collapse all files

133
lisp/emacs-lisp/cl-lib.el
View file

@ -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)."

65
lisp/emacs-lisp/cl-macs.el
View file

@ -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.

38
lisp/emacs-lisp/cl.el
View file

@ -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))))