mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-24 06:20:43 -08:00
Cleanup cl-macs namespace. Add macro helpers in macroexp.el.
* emacs-lisp/macroexp.el (macroexp-progn, macroexp-let*, macroexp-if) (macroexp-let², macroexp--const-symbol-p, macroexp-const-p) (macroexp-copyable-p): New functions and macros. * emacs-lisp/edebug.el (edebug-unwrap): * emacs-lisp/disass.el (disassemble-internal): Use macroexp-progn. * emacs-lisp/pcase.el: Use macroexp-let*, macroexp-if, ... (pcase--let*): Remove. * emacs-lisp/bytecomp.el (byte-compile-const-symbol-p) (byte-compile-constp): Remove. Use macroexp--const-symbol-p and macroexp-const-p instead. * emacs-lisp/byte-opt.el: Use macroexp-const-p and macroexp-progn. * emacs-lisp/cl-macs.el: Clean up the name space by using "cl--" instead of "cl-" for internal definitions. Use macroexp-const-p. (cl-old-bc-file-form): Remove var. (cl-const-exprs-p): Remove fun. (cl-labels, cl-macrolet): Use backquote. (cl-lexical-let): Use cl-symbol-macrolet. Don't use cl-defun-expander. (cl-defun-expander, cl-byte-compile-compiler-macro): Remove fun. (cl-define-setf-expander): Rename from cl-define-setf-method. * emacs-lisp/cl.el: Adjust alias for define-setf-method. * international/mule-cmds.el: Don't require CL. (view-hello-file): Don't use `letf'.
This commit is contained in:
parent
7287f2f345
commit
4dd1c416d1
11 changed files with 535 additions and 498 deletions
|
|
@ -225,6 +225,84 @@ definitions to shadow the loaded ones for use in file byte-compilation."
|
|||
(let ((macroexpand-all-environment environment))
|
||||
(macroexp--expand-all form)))
|
||||
|
||||
;;; Handy functions to use in macros.
|
||||
|
||||
(defun macroexp-progn (exps)
|
||||
"Return an expression equivalent to `(progn ,@EXPS)."
|
||||
(if (cdr exps) `(progn ,@exps) (car exps)))
|
||||
|
||||
(defun macroexp-let* (bindings exp)
|
||||
"Return an expression equivalent to `(let* ,bindings ,exp)."
|
||||
(cond
|
||||
((null bindings) exp)
|
||||
((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
|
||||
(t `(let* ,bindings ,exp))))
|
||||
|
||||
(defun macroexp-if (test then else)
|
||||
"Return an expression equivalent to `(if ,test ,then ,else)."
|
||||
(cond
|
||||
((eq (car-safe else) 'if)
|
||||
(if (equal test (nth 1 else))
|
||||
;; Doing a test a second time: get rid of the redundancy.
|
||||
`(if ,test ,then ,@(nthcdr 3 else))
|
||||
`(cond (,test ,then)
|
||||
(,(nth 1 else) ,(nth 2 else))
|
||||
(t ,@(nthcdr 3 else)))))
|
||||
((eq (car-safe else) 'cond)
|
||||
`(cond (,test ,then)
|
||||
;; Doing a test a second time: get rid of the redundancy, as above.
|
||||
,@(remove (assoc test else) (cdr else))))
|
||||
;; Invert the test if that lets us reduce the depth of the tree.
|
||||
((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
|
||||
(t `(if ,test ,then ,else))))
|
||||
|
||||
(defmacro macroexp-let² (test var exp &rest exps)
|
||||
"Bind VAR to a copyable expression that returns the value of EXP.
|
||||
This is like `(let ((v ,EXP)) ,EXPS) except that `v' is a new generated
|
||||
symbol which EXPS can find in VAR.
|
||||
TEST should be the name of a predicate on EXP checking whether the `let' can
|
||||
be skipped; if nil, as is usual, `macroexp-const-p' is used."
|
||||
(declare (indent 3) (debug (sexp form sexp body)))
|
||||
(let ((bodysym (make-symbol "body"))
|
||||
(expsym (make-symbol "exp")))
|
||||
`(let* ((,expsym ,exp)
|
||||
(,var (if (,(or test #'macroexp-const-p) ,expsym)
|
||||
,expsym (make-symbol "x")))
|
||||
(,bodysym ,(macroexp-progn exps)))
|
||||
(if (eq ,var ,expsym) ,bodysym
|
||||
(macroexp-let* (list (list ,var ,expsym))
|
||||
,bodysym)))))
|
||||
|
||||
(defsubst macroexp--const-symbol-p (symbol &optional any-value)
|
||||
"Non-nil if SYMBOL is constant.
|
||||
If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
|
||||
symbol itself."
|
||||
(or (memq symbol '(nil t))
|
||||
(keywordp symbol)
|
||||
(if any-value
|
||||
(or (memq symbol byte-compile-const-variables)
|
||||
;; FIXME: We should provide a less intrusive way to find out
|
||||
;; if a variable is "constant".
|
||||
(and (boundp symbol)
|
||||
(condition-case nil
|
||||
(progn (set symbol (symbol-value symbol)) nil)
|
||||
(setting-constant t)))))))
|
||||
|
||||
(defun macroexp-const-p (exp)
|
||||
"Return non-nil if EXP will always evaluate to the same value."
|
||||
(cond ((consp exp) (or (eq (car exp) 'quote)
|
||||
(and (eq (car exp) 'function)
|
||||
(symbolp (cadr exp)))))
|
||||
;; It would sometimes make sense to pass `any-value', but it's not
|
||||
;; always safe since a "constant" variable may not actually always have
|
||||
;; the same value.
|
||||
((symbolp exp) (macroexp--const-symbol-p exp))
|
||||
(t t)))
|
||||
|
||||
(defun macroexp-copyable-p (exp)
|
||||
"Return non-nil if EXP can be copied without extra cost."
|
||||
(or (symbolp exp) (macroexp-const-p exp)))
|
||||
|
||||
(provide 'macroexp)
|
||||
|
||||
;;; macroexp.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue