comparison lisp/bytecomp.el @ 5566:4654c01af32b

Improve the implementation, documentation of #'labels, #'flet. lisp/ChangeLog addition: 2011-09-07 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (for-effect): Move this earlier in the file, it's referenced in byte-compile-initial-macro-environment. * bytecomp.el (byte-compile-initial-macro-environment): In the byte-compile-macro-environment definition for #'labels, put off the compiling the lambda bodies until the point where the rest of the form is being compiled, allowing the lambda bodies to access appropriate values for byte-compile-bound-variables, and reducing excessive warning about free variables. Add a byte-compile-macro-environment definition for #'flet. This modifies byte-compile-function-environment appropriately, and warns about bindings of functions that have macro definitions in the current environment, about functions that have byte codes, and about functions that have byte-compile methods (which may not do what the user wants at runtime). * bytecomp.el (byte-compile-funcall): If FUNCTION is constant, call #'byte-compile-callargs-warn if that's appropriate, giving warnings about problems with calling functions bound with #'labels. * cl-macs.el: * cl-macs.el (flet): Mention the main difference from Common Lisp, that the bindings are dynamic, not lexical. Counsel the use of #'labels, not #'flet, for this and other reasons. Explain the limited single use case for #'flet. Cross-reference to bytecomp.el in a comment. * cl-macs.el (labels): Go into detail on which functions may be called from where. Explain how to access the function definition of a label within FORM. Add a comment cross-referencing to bytecomp.el. man/ChangeLog addition: 2011-09-07 Aidan Kehoe <kehoea@parhasard.net> * cl.texi (Function Bindings): Move #'labels first, describe it in more detail, explaining that it is to be preferred over #'flet, and explaining why. Explain that dynamic bindings with #'flet will also not work when functions are accessed through their bytecodes.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 07 Sep 2011 16:26:45 +0100
parents 855b667dea13
children b039c0f018b8
comparison
equal deleted inserted replaced
5565:48a3d3281b48 5566:4654c01af32b
470 (dolist (elt save-macro-environment) 470 (dolist (elt save-macro-environment)
471 (if (symbolp elt) 471 (if (symbolp elt)
472 (fmakunbound elt) 472 (fmakunbound elt)
473 (fset (car elt) (cdr elt))))))) 473 (fset (car elt) (cdr elt)))))))
474 474
475 (defvar for-effect) ; ## Kludge! This should be an arg, not a special.
476
475 (defconst byte-compile-initial-macro-environment 477 (defconst byte-compile-initial-macro-environment
476 `((byte-compiler-options 478 `((byte-compiler-options
477 . ,#'(lambda (&rest forms) 479 . ,#'(lambda (&rest forms)
478 (apply 'byte-compiler-options-handler forms))) 480 (apply 'byte-compiler-options-handler forms)))
479 (eval-when-compile 481 (eval-when-compile
503 `(progn (setq ,gensym ,form) ,byte-compile-output-preface) 505 `(progn (setq ,gensym ,form) ,byte-compile-output-preface)
504 t 'file)) 506 t 'file))
505 `(symbol-value ',gensym)))) 507 `(symbol-value ',gensym))))
506 (labels 508 (labels
507 . ,#'(lambda (bindings &rest body) 509 . ,#'(lambda (bindings &rest body)
508 (let* ((bindings 510 (let* ((names (mapcar 'car bindings))
509 (mapcar (function* 511 (lambdas (mapcar
510 (lambda ((name . binding)) 512 (function*
511 (list* name 'lambda 513 (lambda ((name . definition))
512 (cdr (cl-transform-lambda binding 514 (cons 'lambda (cdr (cl-transform-lambda
513 name))))) 515 definition name)))))
514 bindings)) 516 bindings))
515 ;; These placeholders are to ensure that the
516 ;; lexically-scoped functions can be called from each
517 ;; other.
518 (placeholders 517 (placeholders
519 (mapcar #'(lambda (binding) 518 (mapcar #'(lambda (lambda)
520 (cons (car binding) 519 (make-byte-code (second lambda) "\xc0\x87"
521 (make-byte-code (third binding) 520 [42] 1))
522 "\xc0\x87" [42] 1))) 521 lambdas))
523 bindings))
524 (byte-compile-macro-environment 522 (byte-compile-macro-environment
525 (nconc 523 (pairlis names (mapcar
526 (mapcar 524 #'(lambda (placeholder)
527 (function* 525 `(lambda (&rest cl-labels-args)
528 (lambda ((name . placeholder)) 526 (list* 'funcall ,placeholder
529 (cons name `(lambda (&rest cl-labels-args) 527 cl-labels-args)))
530 (list* 'funcall ,placeholder 528 placeholders)
531 cl-labels-args))))) 529 byte-compile-macro-environment))
532 placeholders) 530 (gensym (gensym)))
533 byte-compile-macro-environment)) 531 (put gensym 'byte-compile-label-alist
534 placeholder-map) 532 (pairlis placeholders
535 (setq bindings 533 (mapcar 'second (mapcar 'cl-macroexpand-all
536 (mapcar (function* 534 lambdas))))
537 (lambda ((name . lambda)) 535 (put gensym 'byte-compile
538 (cons name (byte-compile-lambda lambda)))) 536 #'(lambda (form)
539 bindings) 537 (let* ((byte-compile-label-alist
540 placeholder-map 538 (get (car form) 'byte-compile-label-alist)))
541 (mapcar (function* 539 (dolist (acons byte-compile-label-alist)
542 (lambda ((name . compiled-function)) 540 (setf (cdr acons)
543 (cons (cdr (assq name placeholders)) 541 (byte-compile-lambda (cdr acons))))
544 compiled-function))) 542 (byte-compile-body-do-effect
545 bindings)) 543 (sublis byte-compile-label-alist (cdr form)
546 (loop 544 :test #'eq))
547 for (placeholder . compiled-function) 545 (dolist (acons byte-compile-label-alist)
548 in placeholder-map 546 (nsubst (cdr acons) (car acons)
549 do (nsubst compiled-function placeholder bindings 547 byte-compile-label-alist :test #'eq
550 :test 'eq :descend-structures t)) 548 :descend-structures t)))))
551 (cl-macroexpand-all (cons 'progn body) 549 (cl-macroexpand-all (cons gensym body)
552 (sublis placeholder-map 550 byte-compile-macro-environment))))
553 byte-compile-macro-environment 551 (flet .
554 :test 'eq)))))) 552 ,#'(lambda (bindings &rest body)
553 (let* ((names (mapcar 'car bindings))
554 (lambdas (mapcar
555 (function*
556 (lambda ((function . definition))
557 (cons 'lambda (cdr (cl-transform-lambda
558 definition function)))))
559 bindings))
560 (gensym (gensym)))
561 (put gensym 'byte-compile-flet-environment
562 (pairlis names lambdas))
563 (put gensym 'byte-compile
564 #'(lambda (form)
565 (let* ((byte-compile-flet-environment
566 (get (car form) 'byte-compile-flet-environment))
567 (byte-compile-function-environment
568 (append byte-compile-flet-environment
569 byte-compile-function-environment))
570 name)
571 (dolist (acons byte-compile-flet-environment)
572 (setq name (car acons))
573 (if (and (memq 'redefine byte-compile-warnings)
574 (or (cdr
575 (assq name
576 byte-compile-macro-environment))
577 (eq 'macro
578 (ignore-errors
579 (car (symbol-function name))))))
580 ;; XEmacs change; this is a warning, not an
581 ;; error. The only use case for #'flet instead
582 ;; of #'labels is to shadow a dynamically
583 ;; bound function at runtime, and it's
584 ;; reasonable to do this even if that symbol
585 ;; has a macro binding at compile time.
586 (byte-compile-warn
587 "flet: redefining macro %s as a function"
588 name))
589 (if (get name 'byte-opcode)
590 (byte-compile-warn
591 "flet: %s has a byte code, consider #'labels"
592 name))
593 (if (get name 'byte-compile)
594 (byte-compile-warn
595 "flet: %s has a byte-compile method,
596 consider #'labels" name)))
597 (byte-compile-form (second form)))))
598 `(,gensym (letf* ,(mapcar* #'(lambda (name lambda)
599 `((symbol-function ',name)
600 ,lambda)) names lambdas)
601 ,@body))))))
602
555 "The default macro-environment passed to macroexpand by the compiler. 603 "The default macro-environment passed to macroexpand by the compiler.
556 Placing a macro here will cause a macro to have different semantics when 604 Placing a macro here will cause a macro to have different semantics when
557 expanded by the compiler as when expanded by the interpreter.") 605 expanded by the compiler as when expanded by the interpreter.")
558 606
559 (defvar byte-compile-function-environment nil 607 (defvar byte-compile-function-environment nil
2084 (insert (nth 2 info)) 2132 (insert (nth 2 info))
2085 (when byte-compile-output-preface 2133 (when byte-compile-output-preface
2086 (princ ")" byte-compile-outbuffer)))))) 2134 (princ ")" byte-compile-outbuffer))))))
2087 nil) 2135 nil)
2088 2136
2089 (defvar for-effect) ; ## Kludge! This should be an arg, not a special.
2090
2091 (defun byte-compile-keep-pending (form &optional handler) 2137 (defun byte-compile-keep-pending (form &optional handler)
2092 (if (memq byte-optimize '(t source)) 2138 (if (memq byte-optimize '(t source))
2093 (setq form (byte-optimize-form form t))) 2139 (setq form (byte-optimize-form form t)))
2094 (if handler 2140 (if handler
2095 (let ((for-effect t)) 2141 (let ((for-effect t))
4020 (byte-compile-goto 'byte-goto looptag) 4066 (byte-compile-goto 'byte-goto looptag)
4021 (byte-compile-out-tag endtag) 4067 (byte-compile-out-tag endtag)
4022 (setq for-effect nil))) 4068 (setq for-effect nil)))
4023 4069
4024 (defun byte-compile-funcall (form) 4070 (defun byte-compile-funcall (form)
4071 (if (and (memq 'callargs byte-compile-warnings)
4072 (byte-compile-constp (second form)))
4073 (byte-compile-callargs-warn (cons (cl-const-expr-val (second form))
4074 (nthcdr 2 form))))
4025 (mapc 'byte-compile-form (cdr form)) 4075 (mapc 'byte-compile-form (cdr form))
4026 (byte-compile-out 'byte-call (length (cdr (cdr form))))) 4076 (byte-compile-out 'byte-call (length (cdr (cdr form)))))
4027 4077
4028 4078
4029 (defun byte-compile-let (form) 4079 (defun byte-compile-let (form)