mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
Move old compatiblity to cl.el. Remove cl-macroexpand-all.
* emacs-lisp/cl-extra.el (cl-map-keymap, cl-copy-tree) (cl-not-hash-table, cl-builtin-gethash, cl-builtin-remhash) (cl-builtin-clrhash, cl-builtin-maphash, cl-gethash, cl-puthash) (cl-remhash, cl-clrhash, cl-maphash, cl-make-hash-table) (cl-hash-table-p, cl-hash-table-count): Move to cl.el. (cl-macroexpand-cmacs): Remove var. (cl-macroexpand-all, cl-macroexpand-body): Remove funs. Use macroexpand-all instead. * emacs-lisp/cl-lib.el (cl-macro-environment): Remove decl. (cl-macroexpand): Move to cl-macs.el and rename to cl--sm-macroexpand. (cl-member): Remove old alias. * emacs-lisp/cl-macs.el (cl-macro-environment): Remove var. Use macroexpand-all-environment instead. (cl--old-macroexpand): New var. (cl--sm-macroexpand): New function. (cl-symbol-macrolet): Use it during macro expansion. (cl--function-convert-cache): New var. (cl--function-convert): New function, extracted from cl-macroexpand-all. (cl-lexical-let): Use it. * emacs-lisp/cl.el (cl-macroexpand, cl-macro-environment) (cl-macroexpand-all, cl-not-hash-table, cl-builtin-gethash) (cl-builtin-remhash, cl-builtin-clrhash, cl-builtin-maphash) (cl-map-keymap, cl-copy-tree, cl-gethash, cl-puthash, cl-remhash) (cl-clrhash, cl-maphash, cl-make-hash-table, cl-hash-table-p) (cl-hash-table-count): Add old compatibility aliases.
This commit is contained in:
parent
4dd1c416d1
commit
6fa6c4aedb
6 changed files with 191 additions and 210 deletions
|
|
@ -221,10 +221,6 @@ If so, return the true (non-nil) value returned by PREDICATE.
|
|||
\n(fn PREDICATE SEQ...)"
|
||||
(not (apply 'cl-every cl-pred cl-seq cl-rest)))
|
||||
|
||||
;;; Support for `cl-loop'.
|
||||
;;;###autoload
|
||||
(defalias 'cl-map-keymap 'map-keymap)
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
|
||||
(or cl-base
|
||||
|
|
@ -460,7 +456,7 @@ Optional second arg STATE is a random-state object."
|
|||
"Return a copy of random-state STATE, or of the internal state if omitted.
|
||||
If STATE is t, return a new state object seeded from the time of day."
|
||||
(cond ((null state) (cl-make-random-state cl--random-state))
|
||||
((vectorp state) (cl-copy-tree state t))
|
||||
((vectorp state) (copy-tree state t))
|
||||
((integerp state) (vector 'cl-random-state-tag -1 30 state))
|
||||
(t (cl-make-random-state (cl-random-time)))))
|
||||
|
||||
|
|
@ -585,9 +581,6 @@ If START or END is negative, it counts from the end."
|
|||
(setq list (cdr list)))
|
||||
(if (numberp sublist) (equal sublist list) (eq sublist list)))
|
||||
|
||||
(defalias 'cl-copy-tree 'copy-tree)
|
||||
|
||||
|
||||
;;; Property lists.
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -637,36 +630,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
(progn (setplist sym (cdr (cdr plist))) t)
|
||||
(cl-do-remf plist tag))))
|
||||
|
||||
;;; Hash tables.
|
||||
;; This is just kept for compatibility with code byte-compiled by Emacs-20.
|
||||
|
||||
;; No idea if this might still be needed.
|
||||
(defun cl-not-hash-table (x &optional y &rest z)
|
||||
(signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
|
||||
|
||||
(defvar cl-builtin-gethash (symbol-function 'gethash))
|
||||
(defvar cl-builtin-remhash (symbol-function 'remhash))
|
||||
(defvar cl-builtin-clrhash (symbol-function 'clrhash))
|
||||
(defvar cl-builtin-maphash (symbol-function 'maphash))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'cl-gethash 'gethash)
|
||||
;;;###autoload
|
||||
(defalias 'cl-puthash 'puthash)
|
||||
;;;###autoload
|
||||
(defalias 'cl-remhash 'remhash)
|
||||
;;;###autoload
|
||||
(defalias 'cl-clrhash 'clrhash)
|
||||
;;;###autoload
|
||||
(defalias 'cl-maphash 'maphash)
|
||||
;; These three actually didn't exist in Emacs-20.
|
||||
;;;###autoload
|
||||
(defalias 'cl-make-hash-table 'make-hash-table)
|
||||
;;;###autoload
|
||||
(defalias 'cl-hash-table-p 'hash-table-p)
|
||||
;;;###autoload
|
||||
(defalias 'cl-hash-table-count 'hash-table-count)
|
||||
|
||||
;;; Some debugging aids.
|
||||
|
||||
(defun cl-prettyprint (form)
|
||||
|
|
@ -710,93 +673,13 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
(forward-char 1))))
|
||||
(forward-sexp)))
|
||||
|
||||
(defvar cl-macroexpand-cmacs nil)
|
||||
(defvar cl-closure-vars nil)
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-macroexpand-all (form &optional env)
|
||||
"Expand all macro calls through a Lisp FORM.
|
||||
This also does some trivial optimizations to make the form prettier."
|
||||
(while (or (not (eq form (setq form (macroexpand form env))))
|
||||
(and cl-macroexpand-cmacs
|
||||
(not (eq form (setq form (cl-compiler-macroexpand form)))))))
|
||||
(cond ((not (consp form)) form)
|
||||
((memq (car form) '(let let*))
|
||||
(if (null (nth 1 form))
|
||||
(cl-macroexpand-all (cons 'progn (cddr form)) env)
|
||||
(let ((letf nil) (res nil) (lets (cadr form)))
|
||||
(while lets
|
||||
(push (if (consp (car lets))
|
||||
(let ((exp (cl-macroexpand-all (caar lets) env)))
|
||||
(or (symbolp exp) (setq letf t))
|
||||
(cons exp (cl-macroexpand-body (cdar lets) env)))
|
||||
(let ((exp (cl-macroexpand-all (car lets) env)))
|
||||
(if (symbolp exp) exp
|
||||
(setq letf t) (list exp nil)))) res)
|
||||
(setq lets (cdr lets)))
|
||||
(cl-list* (if letf (if (eq (car form) 'let) 'cl-letf 'cl-letf*) (car form))
|
||||
(nreverse res) (cl-macroexpand-body (cddr form) env)))))
|
||||
((eq (car form) 'cond)
|
||||
(cons (car form)
|
||||
(mapcar (function (lambda (x) (cl-macroexpand-body x env)))
|
||||
(cdr form))))
|
||||
((eq (car form) 'condition-case)
|
||||
(cl-list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env)
|
||||
(mapcar (function
|
||||
(lambda (x)
|
||||
(cons (car x) (cl-macroexpand-body (cdr x) env))))
|
||||
(cl-cdddr form))))
|
||||
((memq (car form) '(quote function))
|
||||
(if (eq (car-safe (nth 1 form)) 'lambda)
|
||||
(let ((body (cl-macroexpand-body (cl-cddadr form) env)))
|
||||
(if (and cl-closure-vars (eq (car form) 'function)
|
||||
(cl-expr-contains-any body cl-closure-vars))
|
||||
(let* ((new (mapcar 'cl-gensym cl-closure-vars))
|
||||
(sub (cl-pairlis cl-closure-vars new)) (decls nil))
|
||||
(while (or (stringp (car body))
|
||||
(eq (car-safe (car body)) 'interactive))
|
||||
(push (list 'quote (pop body)) decls))
|
||||
(put (car (last cl-closure-vars)) 'used t)
|
||||
`(list 'lambda '(&rest --cl-rest--)
|
||||
,@(cl-sublis sub (nreverse decls))
|
||||
(list 'apply
|
||||
(list 'quote
|
||||
#'(lambda ,(append new (cl-cadadr form))
|
||||
,@(cl-sublis sub body)))
|
||||
,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
|
||||
cl-closure-vars)
|
||||
'((quote --cl-rest--))))))
|
||||
(list (car form) (cl-list* 'lambda (cl-cadadr form) body))))
|
||||
(let ((found (assq (cadr form) env)))
|
||||
(if (and found (ignore-errors
|
||||
(eq (cadr (cl-caddr found)) 'cl-labels-args)))
|
||||
(cl-macroexpand-all (cadr (cl-caddr (cl-cadddr found))) env)
|
||||
form))))
|
||||
((memq (car form) '(defun defmacro))
|
||||
(cl-list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
|
||||
((and (eq (car form) 'progn) (not (cddr form)))
|
||||
(cl-macroexpand-all (nth 1 form) env))
|
||||
((eq (car form) 'setq)
|
||||
(let* ((args (cl-macroexpand-body (cdr form) env)) (p args))
|
||||
(while (and p (symbolp (car p))) (setq p (cddr p)))
|
||||
(if p (cl-macroexpand-all (cons 'cl-setf args)) (cons 'setq args))))
|
||||
((consp (car form))
|
||||
(cl-macroexpand-all (cl-list* 'funcall
|
||||
(list 'function (car form))
|
||||
(cdr form))
|
||||
env))
|
||||
(t (cons (car form) (cl-macroexpand-body (cdr form) env)))))
|
||||
|
||||
(defun cl-macroexpand-body (body &optional env)
|
||||
(mapcar (function (lambda (x) (cl-macroexpand-all x env))) body))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-prettyexpand (form &optional full)
|
||||
(message "Expanding...")
|
||||
(let ((cl-macroexpand-cmacs full) (cl-compiling-file full)
|
||||
(byte-compile-macro-environment nil))
|
||||
(setq form (cl-macroexpand-all form
|
||||
(and (not full) '((cl-block) (cl-eval-when)))))
|
||||
(setq form (macroexpand-all form
|
||||
(and (not full) '((cl-block) (cl-eval-when)))))
|
||||
(message "Formatting...")
|
||||
(prog1 (cl-prettyprint form)
|
||||
(message ""))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue