Mercurial > hg > xemacs-beta
diff lisp/bytecomp.el @ 5562:855b667dea13
Drop cl-macro-environment in favour of byte-compile-macro-environment.
lisp/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp-runtime.el:
* bytecomp-runtime.el (byte-compile-macro-environment): Moved from
bytecomp.el.
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Add implementations for #'load-time-value, #'labels here, now
cl-macs respects byte-compile-macro-environment.
* bytecomp.el (byte-compile-function-environment):
* bytecomp.el (byte-compile-macro-environment): Removed.
* bytecomp.el (symbol-value):
* bytecomp.el (byte-compile-symbol-value): Removed.
* cl-extra.el (cl-macroexpand-all):
* cl-macs.el:
* cl-macs.el (bind-block):
* cl-macs.el (cl-macro-environment): Removed.
* cl-macs.el (cl-transform-lambda):
* cl-macs.el (load-time-value):
* cl-macs.el (block):
* cl-macs.el (flet):
* cl-macs.el (labels):
* cl-macs.el (macrolet):
* cl-macs.el (symbol-macrolet):
* cl-macs.el (lexical-let):
* cl-macs.el (apply):
* cl-macs.el (nthcdr):
* cl-macs.el (getf):
* cl-macs.el (substring):
* cl-macs.el (values):
* cl-macs.el (get-setf-method):
* cl-macs.el (cl-setf-do-modify):
* cl.el:
* cl.el (cl-macro-environment): Removed.
* cl.el (cl-macroexpand):
* obsolete.el (cl-macro-environment): Moved here.
Drop cl-macro-environment, in favour of
byte-compile-macro-environment; make the latter available in
bytecomp-runtime.el. This makes byte-compile-macro-environment far
less useless, since previously code that used cl-macs would ignore
it when calling #'cl-macroexpand-all.
Add byte-compiler-specific implementations for #'load-time-value,
#'labels. The latter is very nice indeed; it avoids the run-time
consing of the current implementation, is fully lexical and avoids
the run-time shadowing of symbol function slots that flet uses. It
would now be reasonable to move most core uses of flet to use
labels instead. Non-core code can't rely on print-circle for
mutually recursive functions, though, so it's less of an evident
win.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 04 Sep 2011 20:37:55 +0100 |
parents | 58b38d5b32d0 |
children | 4654c01af32b |
line wrap: on
line diff
--- a/lisp/bytecomp.el Sun Sep 04 20:35:31 2011 +0100 +++ b/lisp/bytecomp.el Sun Sep 04 20:37:55 2011 +0100 @@ -491,16 +491,71 @@ "%s is not of type %s" form type))) (if byte-compile-delete-errors form - (funcall (cdr (symbol-function 'the)) type form))))) + (funcall (cdr (symbol-function 'the)) type form)))) + (load-time-value + . ,#'(lambda (form &optional read-only) + (let* ((gensym (gensym)) + (byte-compile-bound-variables + (acons gensym byte-compile-global-bit + byte-compile-bound-variables))) + (setq byte-compile-output-preface + (byte-compile-top-level + `(progn (setq ,gensym ,form) ,byte-compile-output-preface) + t 'file)) + `(symbol-value ',gensym)))) + (labels + . ,#'(lambda (bindings &rest body) + (let* ((bindings + (mapcar (function* + (lambda ((name . binding)) + (list* name 'lambda + (cdr (cl-transform-lambda binding + name))))) + bindings)) + ;; These placeholders are to ensure that the + ;; lexically-scoped functions can be called from each + ;; other. + (placeholders + (mapcar #'(lambda (binding) + (cons (car binding) + (make-byte-code (third binding) + "\xc0\x87" [42] 1))) + bindings)) + (byte-compile-macro-environment + (nconc + (mapcar + (function* + (lambda ((name . placeholder)) + (cons name `(lambda (&rest cl-labels-args) + (list* 'funcall ,placeholder + cl-labels-args))))) + placeholders) + byte-compile-macro-environment)) + placeholder-map) + (setq bindings + (mapcar (function* + (lambda ((name . lambda)) + (cons name (byte-compile-lambda lambda)))) + bindings) + placeholder-map + (mapcar (function* + (lambda ((name . compiled-function)) + (cons (cdr (assq name placeholders)) + compiled-function))) + bindings)) + (loop + for (placeholder . compiled-function) + in placeholder-map + do (nsubst compiled-function placeholder bindings + :test 'eq :descend-structures t)) + (cl-macroexpand-all (cons 'progn body) + (sublis placeholder-map + byte-compile-macro-environment + :test 'eq)))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") -(defvar byte-compile-macro-environment byte-compile-initial-macro-environment - "Alist of macros defined in the file being compiled. -Each element looks like (MACRONAME . DEFINITION). It is -\(MACRONAME . nil) when a macro is redefined as a function.") - (defvar byte-compile-function-environment nil "Alist of functions defined in the file being compiled. This is so we can inline them when necessary. @@ -3086,7 +3141,7 @@ (byte-defop-compiler car 1) (byte-defop-compiler cdr 1) (byte-defop-compiler length 1) -(byte-defop-compiler symbol-value) +(byte-defop-compiler symbol-value 1) (byte-defop-compiler symbol-function 1) (byte-defop-compiler (1+ byte-add1) 1) (byte-defop-compiler (1- byte-sub1) 1) @@ -4237,29 +4292,6 @@ (byte-compile-out 'byte-temp-output-buffer-setup 0) (byte-compile-body (cdr (cdr form))) (byte-compile-out 'byte-temp-output-buffer-show 0)) - -(defun byte-compile-symbol-value (form) - (symbol-macrolet ((not-present '#:not-present)) - (let ((cl-load-time-value-form not-present) - (byte-compile-bound-variables byte-compile-bound-variables) gensym) - (and (consp (cadr form)) - (eq 'quote (caadr form)) - (setq gensym (cadadr form)) - (symbolp gensym) - (setq cl-load-time-value-form - (get gensym 'cl-load-time-value-form not-present))) - (unless (eq cl-load-time-value-form not-present) - (setq byte-compile-bound-variables - (acons gensym byte-compile-global-bit - byte-compile-bound-variables) - byte-compile-output-preface - (byte-compile-top-level - (if byte-compile-output-preface - `(progn (setq ,gensym ,cl-load-time-value-form) - ,byte-compile-output-preface) - `(setq ,gensym ,cl-load-time-value-form)) - t 'file))) - (byte-compile-one-arg form)))) (defun byte-compile-multiple-value-call (form) (if (< (length form) 2)