Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
5561:9a93bc90b3bd | 5562:855b667dea13 |
---|---|
489 (or (eval (cl-make-type-test form type)) | 489 (or (eval (cl-make-type-test form type)) |
490 (byte-compile-warn | 490 (byte-compile-warn |
491 "%s is not of type %s" form type))) | 491 "%s is not of type %s" form type))) |
492 (if byte-compile-delete-errors | 492 (if byte-compile-delete-errors |
493 form | 493 form |
494 (funcall (cdr (symbol-function 'the)) type form))))) | 494 (funcall (cdr (symbol-function 'the)) type form)))) |
495 (load-time-value | |
496 . ,#'(lambda (form &optional read-only) | |
497 (let* ((gensym (gensym)) | |
498 (byte-compile-bound-variables | |
499 (acons gensym byte-compile-global-bit | |
500 byte-compile-bound-variables))) | |
501 (setq byte-compile-output-preface | |
502 (byte-compile-top-level | |
503 `(progn (setq ,gensym ,form) ,byte-compile-output-preface) | |
504 t 'file)) | |
505 `(symbol-value ',gensym)))) | |
506 (labels | |
507 . ,#'(lambda (bindings &rest body) | |
508 (let* ((bindings | |
509 (mapcar (function* | |
510 (lambda ((name . binding)) | |
511 (list* name 'lambda | |
512 (cdr (cl-transform-lambda binding | |
513 name))))) | |
514 bindings)) | |
515 ;; These placeholders are to ensure that the | |
516 ;; lexically-scoped functions can be called from each | |
517 ;; other. | |
518 (placeholders | |
519 (mapcar #'(lambda (binding) | |
520 (cons (car binding) | |
521 (make-byte-code (third binding) | |
522 "\xc0\x87" [42] 1))) | |
523 bindings)) | |
524 (byte-compile-macro-environment | |
525 (nconc | |
526 (mapcar | |
527 (function* | |
528 (lambda ((name . placeholder)) | |
529 (cons name `(lambda (&rest cl-labels-args) | |
530 (list* 'funcall ,placeholder | |
531 cl-labels-args))))) | |
532 placeholders) | |
533 byte-compile-macro-environment)) | |
534 placeholder-map) | |
535 (setq bindings | |
536 (mapcar (function* | |
537 (lambda ((name . lambda)) | |
538 (cons name (byte-compile-lambda lambda)))) | |
539 bindings) | |
540 placeholder-map | |
541 (mapcar (function* | |
542 (lambda ((name . compiled-function)) | |
543 (cons (cdr (assq name placeholders)) | |
544 compiled-function))) | |
545 bindings)) | |
546 (loop | |
547 for (placeholder . compiled-function) | |
548 in placeholder-map | |
549 do (nsubst compiled-function placeholder bindings | |
550 :test 'eq :descend-structures t)) | |
551 (cl-macroexpand-all (cons 'progn body) | |
552 (sublis placeholder-map | |
553 byte-compile-macro-environment | |
554 :test 'eq)))))) | |
495 "The default macro-environment passed to macroexpand by the compiler. | 555 "The default macro-environment passed to macroexpand by the compiler. |
496 Placing a macro here will cause a macro to have different semantics when | 556 Placing a macro here will cause a macro to have different semantics when |
497 expanded by the compiler as when expanded by the interpreter.") | 557 expanded by the compiler as when expanded by the interpreter.") |
498 | |
499 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment | |
500 "Alist of macros defined in the file being compiled. | |
501 Each element looks like (MACRONAME . DEFINITION). It is | |
502 \(MACRONAME . nil) when a macro is redefined as a function.") | |
503 | 558 |
504 (defvar byte-compile-function-environment nil | 559 (defvar byte-compile-function-environment nil |
505 "Alist of functions defined in the file being compiled. | 560 "Alist of functions defined in the file being compiled. |
506 This is so we can inline them when necessary. | 561 This is so we can inline them when necessary. |
507 Each element looks like (FUNCTIONNAME . DEFINITION). It is | 562 Each element looks like (FUNCTIONNAME . DEFINITION). It is |
3084 (byte-defop-compiler not 1) | 3139 (byte-defop-compiler not 1) |
3085 (byte-defop-compiler (null byte-not) 1) | 3140 (byte-defop-compiler (null byte-not) 1) |
3086 (byte-defop-compiler car 1) | 3141 (byte-defop-compiler car 1) |
3087 (byte-defop-compiler cdr 1) | 3142 (byte-defop-compiler cdr 1) |
3088 (byte-defop-compiler length 1) | 3143 (byte-defop-compiler length 1) |
3089 (byte-defop-compiler symbol-value) | 3144 (byte-defop-compiler symbol-value 1) |
3090 (byte-defop-compiler symbol-function 1) | 3145 (byte-defop-compiler symbol-function 1) |
3091 (byte-defop-compiler (1+ byte-add1) 1) | 3146 (byte-defop-compiler (1+ byte-add1) 1) |
3092 (byte-defop-compiler (1- byte-sub1) 1) | 3147 (byte-defop-compiler (1- byte-sub1) 1) |
3093 (byte-defop-compiler goto-char 1+1) | 3148 (byte-defop-compiler goto-char 1+1) |
3094 (byte-defop-compiler char-after 0-1+1) | 3149 (byte-defop-compiler char-after 0-1+1) |
4235 (defun byte-compile-with-output-to-temp-buffer (form) | 4290 (defun byte-compile-with-output-to-temp-buffer (form) |
4236 (byte-compile-form (car (cdr form))) | 4291 (byte-compile-form (car (cdr form))) |
4237 (byte-compile-out 'byte-temp-output-buffer-setup 0) | 4292 (byte-compile-out 'byte-temp-output-buffer-setup 0) |
4238 (byte-compile-body (cdr (cdr form))) | 4293 (byte-compile-body (cdr (cdr form))) |
4239 (byte-compile-out 'byte-temp-output-buffer-show 0)) | 4294 (byte-compile-out 'byte-temp-output-buffer-show 0)) |
4240 | |
4241 (defun byte-compile-symbol-value (form) | |
4242 (symbol-macrolet ((not-present '#:not-present)) | |
4243 (let ((cl-load-time-value-form not-present) | |
4244 (byte-compile-bound-variables byte-compile-bound-variables) gensym) | |
4245 (and (consp (cadr form)) | |
4246 (eq 'quote (caadr form)) | |
4247 (setq gensym (cadadr form)) | |
4248 (symbolp gensym) | |
4249 (setq cl-load-time-value-form | |
4250 (get gensym 'cl-load-time-value-form not-present))) | |
4251 (unless (eq cl-load-time-value-form not-present) | |
4252 (setq byte-compile-bound-variables | |
4253 (acons gensym byte-compile-global-bit | |
4254 byte-compile-bound-variables) | |
4255 byte-compile-output-preface | |
4256 (byte-compile-top-level | |
4257 (if byte-compile-output-preface | |
4258 `(progn (setq ,gensym ,cl-load-time-value-form) | |
4259 ,byte-compile-output-preface) | |
4260 `(setq ,gensym ,cl-load-time-value-form)) | |
4261 t 'file))) | |
4262 (byte-compile-one-arg form)))) | |
4263 | 4295 |
4264 (defun byte-compile-multiple-value-call (form) | 4296 (defun byte-compile-multiple-value-call (form) |
4265 (if (< (length form) 2) | 4297 (if (< (length form) 2) |
4266 (progn | 4298 (progn |
4267 (byte-compile-warn-wrong-args form 1) | 4299 (byte-compile-warn-wrong-args form 1) |