diff options
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 59 |
1 files changed, 38 insertions, 21 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2bd8d07851b..548aaa9626b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -31,6 +31,10 @@ | |||
| 31 | ;; faster. [`LAP' == `Lisp Assembly Program'.] | 31 | ;; faster. [`LAP' == `Lisp Assembly Program'.] |
| 32 | ;; The user entry points are byte-compile-file and byte-recompile-directory. | 32 | ;; The user entry points are byte-compile-file and byte-recompile-directory. |
| 33 | 33 | ||
| 34 | ;;; Todo: | ||
| 35 | |||
| 36 | ;; - Turn "not bound at runtime" functions into autoloads. | ||
| 37 | |||
| 34 | ;;; Code: | 38 | ;;; Code: |
| 35 | 39 | ||
| 36 | ;; ======================================================================== | 40 | ;; ======================================================================== |
| @@ -450,7 +454,7 @@ Return the compile-time value of FORM." | |||
| 450 | (eval-when-compile . ,(lambda (&rest body) | 454 | (eval-when-compile . ,(lambda (&rest body) |
| 451 | (let ((result nil)) | 455 | (let ((result nil)) |
| 452 | (byte-compile-recurse-toplevel | 456 | (byte-compile-recurse-toplevel |
| 453 | (cons 'progn body) | 457 | (macroexp-progn body) |
| 454 | (lambda (form) | 458 | (lambda (form) |
| 455 | (setf result | 459 | (setf result |
| 456 | (byte-compile-eval | 460 | (byte-compile-eval |
| @@ -459,7 +463,7 @@ Return the compile-time value of FORM." | |||
| 459 | (list 'quote result)))) | 463 | (list 'quote result)))) |
| 460 | (eval-and-compile . ,(lambda (&rest body) | 464 | (eval-and-compile . ,(lambda (&rest body) |
| 461 | (byte-compile-recurse-toplevel | 465 | (byte-compile-recurse-toplevel |
| 462 | (cons 'progn body) | 466 | (macroexp-progn body) |
| 463 | (lambda (form) | 467 | (lambda (form) |
| 464 | ;; Don't compile here, since we don't know | 468 | ;; Don't compile here, since we don't know |
| 465 | ;; whether to compile as byte-compile-form | 469 | ;; whether to compile as byte-compile-form |
| @@ -1458,7 +1462,7 @@ extra args." | |||
| 1458 | ;; These would sometimes be warned about | 1462 | ;; These would sometimes be warned about |
| 1459 | ;; but such warnings are never useful, | 1463 | ;; but such warnings are never useful, |
| 1460 | ;; so don't warn about them. | 1464 | ;; so don't warn about them. |
| 1461 | macroexpand cl-macroexpand-all | 1465 | macroexpand |
| 1462 | cl--compiling-file)))) | 1466 | cl--compiling-file)))) |
| 1463 | (byte-compile-warn "function `%s' from cl package called at runtime" | 1467 | (byte-compile-warn "function `%s' from cl package called at runtime" |
| 1464 | func))) | 1468 | func))) |
| @@ -2319,10 +2323,12 @@ list that represents a doc string reference. | |||
| 2319 | form)) | 2323 | form)) |
| 2320 | 2324 | ||
| 2321 | (put 'define-abbrev-table 'byte-hunk-handler | 2325 | (put 'define-abbrev-table 'byte-hunk-handler |
| 2322 | 'byte-compile-file-form-define-abbrev-table) | 2326 | 'byte-compile-file-form-defvar-function) |
| 2323 | (defun byte-compile-file-form-define-abbrev-table (form) | 2327 | (put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function) |
| 2324 | (if (eq 'quote (car-safe (car-safe (cdr form)))) | 2328 | |
| 2325 | (byte-compile--declare-var (car-safe (cdr (cadr form))))) | 2329 | (defun byte-compile-file-form-defvar-function (form) |
| 2330 | (pcase-let (((or `',name (let name nil)) (nth 1 form))) | ||
| 2331 | (if name (byte-compile--declare-var name))) | ||
| 2326 | (byte-compile-keep-pending form)) | 2332 | (byte-compile-keep-pending form)) |
| 2327 | 2333 | ||
| 2328 | (put 'custom-declare-variable 'byte-hunk-handler | 2334 | (put 'custom-declare-variable 'byte-hunk-handler |
| @@ -2330,8 +2336,7 @@ list that represents a doc string reference. | |||
| 2330 | (defun byte-compile-file-form-custom-declare-variable (form) | 2336 | (defun byte-compile-file-form-custom-declare-variable (form) |
| 2331 | (when (byte-compile-warning-enabled-p 'callargs) | 2337 | (when (byte-compile-warning-enabled-p 'callargs) |
| 2332 | (byte-compile-nogroup-warn form)) | 2338 | (byte-compile-nogroup-warn form)) |
| 2333 | (byte-compile--declare-var (nth 1 (nth 1 form))) | 2339 | (byte-compile-file-form-defvar-function form)) |
| 2334 | (byte-compile-keep-pending form)) | ||
| 2335 | 2340 | ||
| 2336 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) | 2341 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) |
| 2337 | (defun byte-compile-file-form-require (form) | 2342 | (defun byte-compile-file-form-require (form) |
| @@ -2580,17 +2585,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2580 | fun) | 2585 | fun) |
| 2581 | (t | 2586 | (t |
| 2582 | (when (symbolp form) | 2587 | (when (symbolp form) |
| 2583 | (unless (memq (car-safe fun) '(closure lambda)) | ||
| 2584 | (error "Don't know how to compile %S" fun)) | ||
| 2585 | (setq lexical-binding (eq (car fun) 'closure)) | 2588 | (setq lexical-binding (eq (car fun) 'closure)) |
| 2586 | (setq fun (byte-compile--reify-function fun))) | 2589 | (setq fun (byte-compile--reify-function fun))) |
| 2587 | (unless (eq (car-safe fun) 'lambda) | ||
| 2588 | (error "Don't know how to compile %S" fun)) | ||
| 2589 | ;; Expand macros. | 2590 | ;; Expand macros. |
| 2590 | (setq fun (byte-compile-preprocess fun)) | 2591 | (setq fun (byte-compile-preprocess fun)) |
| 2591 | ;; Get rid of the `function' quote added by the `lambda' macro. | 2592 | (setq fun (byte-compile-top-level fun nil 'eval)) |
| 2592 | (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) | ||
| 2593 | (setq fun (byte-compile-lambda fun)) | ||
| 2594 | (if macro (push 'macro fun)) | 2593 | (if macro (push 'macro fun)) |
| 2595 | (if (symbolp form) | 2594 | (if (symbolp form) |
| 2596 | (fset form fun) | 2595 | (fset form fun) |
| @@ -2966,6 +2965,16 @@ for symbols generated by the byte compiler itself." | |||
| 2966 | (interactive-only | 2965 | (interactive-only |
| 2967 | (or (get fn 'interactive-only) | 2966 | (or (get fn 'interactive-only) |
| 2968 | (memq fn byte-compile-interactive-only-functions)))) | 2967 | (memq fn byte-compile-interactive-only-functions)))) |
| 2968 | (when (memq fn '(set symbol-value run-hooks ;; add-to-list | ||
| 2969 | add-hook remove-hook run-hook-with-args | ||
| 2970 | run-hook-with-args-until-success | ||
| 2971 | run-hook-with-args-until-failure)) | ||
| 2972 | (pcase (cdr form) | ||
| 2973 | (`(',var . ,_) | ||
| 2974 | (when (assq var byte-compile-lexical-variables) | ||
| 2975 | (byte-compile-log-warning | ||
| 2976 | (format "%s cannot use lexical var `%s'" fn var) | ||
| 2977 | nil :error))))) | ||
| 2969 | (when (macroexp--const-symbol-p fn) | 2978 | (when (macroexp--const-symbol-p fn) |
| 2970 | (byte-compile-warn "`%s' called as a function" fn)) | 2979 | (byte-compile-warn "`%s' called as a function" fn)) |
| 2971 | (when (and (byte-compile-warning-enabled-p 'interactive-only) | 2980 | (when (and (byte-compile-warning-enabled-p 'interactive-only) |
| @@ -3079,8 +3088,9 @@ for symbols generated by the byte compiler itself." | |||
| 3079 | (dotimes (_ (- (/ (1+ fmax2) 2) alen)) | 3088 | (dotimes (_ (- (/ (1+ fmax2) 2) alen)) |
| 3080 | (byte-compile-push-constant nil))) | 3089 | (byte-compile-push-constant nil))) |
| 3081 | ((zerop (logand fmax2 1)) | 3090 | ((zerop (logand fmax2 1)) |
| 3082 | (byte-compile-log-warning "Too many arguments for inlined function" | 3091 | (byte-compile-log-warning |
| 3083 | nil :error) | 3092 | (format "Too many arguments for inlined function %S" form) |
| 3093 | nil :error) | ||
| 3084 | (byte-compile-discard (- alen (/ fmax2 2)))) | 3094 | (byte-compile-discard (- alen (/ fmax2 2)))) |
| 3085 | (t | 3095 | (t |
| 3086 | ;; Turn &rest args into a list. | 3096 | ;; Turn &rest args into a list. |
| @@ -3453,15 +3463,22 @@ discarding." | |||
| 3453 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) | 3463 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3454 | (let* ((vars (nth 1 form)) | 3464 | (let* ((vars (nth 1 form)) |
| 3455 | (env (nth 2 form)) | 3465 | (env (nth 2 form)) |
| 3456 | (body (nthcdr 3 form)) | 3466 | (docstring-exp (nth 3 form)) |
| 3467 | (body (nthcdr 4 form)) | ||
| 3457 | (fun | 3468 | (fun |
| 3458 | (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) | 3469 | (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) |
| 3459 | (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure. | 3470 | (cl-assert (or (> (length env) 0) |
| 3471 | docstring-exp)) ;Otherwise, we don't need a closure. | ||
| 3460 | (cl-assert (byte-code-function-p fun)) | 3472 | (cl-assert (byte-code-function-p fun)) |
| 3461 | (byte-compile-form `(make-byte-code | 3473 | (byte-compile-form `(make-byte-code |
| 3462 | ',(aref fun 0) ',(aref fun 1) | 3474 | ',(aref fun 0) ',(aref fun 1) |
| 3463 | (vconcat (vector . ,env) ',(aref fun 2)) | 3475 | (vconcat (vector . ,env) ',(aref fun 2)) |
| 3464 | ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) | 3476 | ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) |
| 3477 | (if docstring-exp | ||
| 3478 | `(,(car rest) | ||
| 3479 | ,docstring-exp | ||
| 3480 | ,@(cddr rest)) | ||
| 3481 | rest))))))) | ||
| 3465 | 3482 | ||
| 3466 | (defun byte-compile-get-closed-var (form) | 3483 | (defun byte-compile-get-closed-var (form) |
| 3467 | "Byte-compile the special `internal-get-closed-var' form." | 3484 | "Byte-compile the special `internal-get-closed-var' form." |