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)