diff options
| author | Stefan Monnier | 2011-03-11 22:32:43 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2011-03-11 22:32:43 -0500 |
| commit | 2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942 (patch) | |
| tree | dcfa222d39bd995e82374f077faa49247de6676e | |
| parent | ba83908c4b7fda12991ae9073028a60da87c1fa2 (diff) | |
| download | emacs-2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942.tar.gz emacs-2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942.zip | |
Try and fix w32 build; misc cleanup.
* lisp/subr.el (apply-partially): Move from subr.el; don't use lexical-let.
(eval-after-load): Obey lexical-binding.
* lisp/simple.el (apply-partially): Move to subr.el.
* lisp/makefile.w32-in: Match changes in Makefile.in.
(BIG_STACK_DEPTH, BIG_STACK_OPTS, BYTE_COMPILE_FLAGS): New vars.
(.el.elc, compile-CMD, compile-SH, compile-always-CMD)
(compile-always-SH, compile-calc-CMD, compile-calc-SH): Use them.
(COMPILE_FIRST): Add pcase, macroexp, and cconv.
* lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Silence warning about
calling CL's `compiler-macroexpand'.
* lisp/emacs-lisp/bytecomp.el (byte-compile-preprocess): New function.
(byte-compile-initial-macro-environment)
(byte-compile-toplevel-file-form, byte-compile, byte-compile-sexp): Use it.
(byte-compile-eval, byte-compile-eval-before-compile): Obey lexical-binding.
(byte-compile--for-effect): Rename from `for-effect'.
(display-call-tree): Use case.
* lisp/emacs-lisp/byte-opt.el (for-effect): Don't declare as dynamic.
(byte-optimize-form-code-walker, byte-optimize-form):
Revert to old arg name.
* lisp/Makefile.in (BYTE_COMPILE_FLAGS): New var.
(compile-onefile, .el.elc, compile-calc, recompile): Use it.
| -rw-r--r-- | lisp/ChangeLog | 26 | ||||
| -rw-r--r-- | lisp/Makefile.in | 11 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 33 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 298 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/macroexp.el | 6 | ||||
| -rw-r--r-- | lisp/makefile.w32-in | 34 | ||||
| -rw-r--r-- | lisp/simple.el | 50 | ||||
| -rw-r--r-- | lisp/subr.el | 13 |
9 files changed, 264 insertions, 208 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0b432eb46d9..01571b80124 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,29 @@ | |||
| 1 | 2011-03-12 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * subr.el (apply-partially): Move from subr.el; don't use lexical-let. | ||
| 4 | (eval-after-load): Obey lexical-binding. | ||
| 5 | * simple.el (apply-partially): Move to subr.el. | ||
| 6 | * makefile.w32-in: Match changes in Makefile.in. | ||
| 7 | (BIG_STACK_DEPTH, BIG_STACK_OPTS, BYTE_COMPILE_FLAGS): New vars. | ||
| 8 | (.el.elc, compile-CMD, compile-SH, compile-always-CMD) | ||
| 9 | (compile-always-SH, compile-calc-CMD, compile-calc-SH): Use them. | ||
| 10 | (COMPILE_FIRST): Add pcase, macroexp, and cconv. | ||
| 11 | * emacs-lisp/macroexp.el (macroexpand-all-1): Silence warning about | ||
| 12 | calling CL's `compiler-macroexpand'. | ||
| 13 | * emacs-lisp/bytecomp.el (byte-compile-preprocess): New function. | ||
| 14 | (byte-compile-initial-macro-environment) | ||
| 15 | (byte-compile-toplevel-file-form, byte-compile, byte-compile-sexp): | ||
| 16 | Use it. | ||
| 17 | (byte-compile-eval, byte-compile-eval-before-compile): | ||
| 18 | Obey lexical-binding. | ||
| 19 | (byte-compile--for-effect): Rename from `for-effect'. | ||
| 20 | (display-call-tree): Use case. | ||
| 21 | * emacs-lisp/byte-opt.el (for-effect): Don't declare as dynamic. | ||
| 22 | (byte-optimize-form-code-walker, byte-optimize-form): | ||
| 23 | Revert to old arg name. | ||
| 24 | * Makefile.in (BYTE_COMPILE_FLAGS): New var. | ||
| 25 | (compile-onefile, .el.elc, compile-calc, recompile): Use it. | ||
| 26 | |||
| 1 | 2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca> | 27 | 2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 28 | ||
| 3 | * subr.el (letrec): New macro. | 29 | * subr.el (letrec): New macro. |
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 268a45d8948..4db5ef4f008 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -77,6 +77,8 @@ AUTOGENEL = loaddefs.el \ | |||
| 77 | BIG_STACK_DEPTH = 1200 | 77 | BIG_STACK_DEPTH = 1200 |
| 78 | BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" | 78 | BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" |
| 79 | 79 | ||
| 80 | BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) | ||
| 81 | |||
| 80 | # Files to compile before others during a bootstrap. This is done to | 82 | # Files to compile before others during a bootstrap. This is done to |
| 81 | # speed up the bootstrap process. | 83 | # speed up the bootstrap process. |
| 82 | 84 | ||
| @@ -205,7 +207,7 @@ compile-onefile: | |||
| 205 | @echo Compiling $(THEFILE) | 207 | @echo Compiling $(THEFILE) |
| 206 | @# Use byte-compile-refresh-preloaded to try and work around some of | 208 | @# Use byte-compile-refresh-preloaded to try and work around some of |
| 207 | @# the most common bootstrapping problems. | 209 | @# the most common bootstrapping problems. |
| 208 | @$(emacs) $(BIG_STACK_OPTS) -l bytecomp $(BYTE_COMPILE_EXTRA_FLAGS) \ | 210 | @$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \ |
| 209 | -f byte-compile-refresh-preloaded \ | 211 | -f byte-compile-refresh-preloaded \ |
| 210 | -f batch-byte-compile $(THEFILE) | 212 | -f batch-byte-compile $(THEFILE) |
| 211 | 213 | ||
| @@ -225,7 +227,7 @@ compile-onefile: | |||
| 225 | @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler | 227 | @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler |
| 226 | @# files, which is normally done in compile-first, but may also be | 228 | @# files, which is normally done in compile-first, but may also be |
| 227 | @# recompiled via this rule. | 229 | @# recompiled via this rule. |
| 228 | @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ | 230 | @$(emacs) $(BYTE_COMPILE_FLAGS) \ |
| 229 | -f batch-byte-compile $< | 231 | -f batch-byte-compile $< |
| 230 | 232 | ||
| 231 | .PHONY: compile-first compile-main compile compile-always | 233 | .PHONY: compile-first compile-main compile compile-always |
| @@ -291,7 +293,7 @@ compile-always: doit | |||
| 291 | compile-calc: | 293 | compile-calc: |
| 292 | for el in $(lisp)/calc/*.el; do \ | 294 | for el in $(lisp)/calc/*.el; do \ |
| 293 | echo Compiling $$el; \ | 295 | echo Compiling $$el; \ |
| 294 | $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ | 296 | $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ |
| 295 | done | 297 | done |
| 296 | 298 | ||
| 297 | # Backup compiled Lisp files in elc.tar.gz. If that file already | 299 | # Backup compiled Lisp files in elc.tar.gz. If that file already |
| @@ -318,7 +320,8 @@ compile-after-backup: backup-compiled-files compile-always | |||
| 318 | # since the environment of later files is affected by definitions in | 320 | # since the environment of later files is affected by definitions in |
| 319 | # earlier ones. | 321 | # earlier ones. |
| 320 | recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc | 322 | recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc |
| 321 | $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp) | 323 | $(emacs) $(BYTE_COMPILE_FLAGS) \ |
| 324 | --eval "(batch-byte-recompile-directory 0)" $(lisp) | ||
| 322 | 325 | ||
| 323 | # Update MH-E internal autoloads. These are not to be confused with | 326 | # Update MH-E internal autoloads. These are not to be confused with |
| 324 | # the autoloads for the MH-E entry points, which are already in loaddefs.el. | 327 | # the autoloads for the MH-E entry points, which are already in loaddefs.el. |
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index a4254bfeca1..b07d61ae0d1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el | |||
| @@ -308,9 +308,9 @@ | |||
| 308 | ;; ((lambda ...) ...) | 308 | ;; ((lambda ...) ...) |
| 309 | (defun byte-compile-unfold-lambda (form &optional name) | 309 | (defun byte-compile-unfold-lambda (form &optional name) |
| 310 | ;; In lexical-binding mode, let and functions don't bind vars in the same way | 310 | ;; In lexical-binding mode, let and functions don't bind vars in the same way |
| 311 | ;; (let obey special-variable-p, but functions don't). This doesn't matter | 311 | ;; (let obey special-variable-p, but functions don't). But luckily, this |
| 312 | ;; here, because function's behavior is underspecified so it can safely be | 312 | ;; doesn't matter here, because function's behavior is underspecified so it |
| 313 | ;; turned into a `let', even though the reverse is not true. | 313 | ;; can safely be turned into a `let', even though the reverse is not true. |
| 314 | (or name (setq name "anonymous lambda")) | 314 | (or name (setq name "anonymous lambda")) |
| 315 | (let ((lambda (car form)) | 315 | (let ((lambda (car form)) |
| 316 | (values (cdr form))) | 316 | (values (cdr form))) |
| @@ -378,9 +378,7 @@ | |||
| 378 | 378 | ||
| 379 | ;;; implementing source-level optimizers | 379 | ;;; implementing source-level optimizers |
| 380 | 380 | ||
| 381 | (defvar for-effect) | 381 | (defun byte-optimize-form-code-walker (form for-effect) |
| 382 | |||
| 383 | (defun byte-optimize-form-code-walker (form for-effect-arg) | ||
| 384 | ;; | 382 | ;; |
| 385 | ;; For normal function calls, We can just mapcar the optimizer the cdr. But | 383 | ;; For normal function calls, We can just mapcar the optimizer the cdr. But |
| 386 | ;; we need to have special knowledge of the syntax of the special forms | 384 | ;; we need to have special knowledge of the syntax of the special forms |
| @@ -388,8 +386,7 @@ | |||
| 388 | ;; the important aspect is that they are subrs that don't evaluate all of | 386 | ;; the important aspect is that they are subrs that don't evaluate all of |
| 389 | ;; their args.) | 387 | ;; their args.) |
| 390 | ;; | 388 | ;; |
| 391 | (let ((for-effect for-effect-arg) | 389 | (let ((fn (car-safe form)) |
| 392 | (fn (car-safe form)) | ||
| 393 | tmp) | 390 | tmp) |
| 394 | (cond ((not (consp form)) | 391 | (cond ((not (consp form)) |
| 395 | (if (not (and for-effect | 392 | (if (not (and for-effect |
| @@ -482,8 +479,8 @@ | |||
| 482 | (byte-optimize-form (nth 2 form) for-effect) | 479 | (byte-optimize-form (nth 2 form) for-effect) |
| 483 | (byte-optimize-body (nthcdr 3 form) for-effect))))) | 480 | (byte-optimize-body (nthcdr 3 form) for-effect))))) |
| 484 | 481 | ||
| 485 | ((memq fn '(and or)) ; remember, and/or are control structures. | 482 | ((memq fn '(and or)) ; Remember, and/or are control structures. |
| 486 | ;; take forms off the back until we can't any more. | 483 | ;; Take forms off the back until we can't any more. |
| 487 | ;; In the future it could conceivably be a problem that the | 484 | ;; In the future it could conceivably be a problem that the |
| 488 | ;; subexpressions of these forms are optimized in the reverse | 485 | ;; subexpressions of these forms are optimized in the reverse |
| 489 | ;; order, but it's ok for now. | 486 | ;; order, but it's ok for now. |
| @@ -498,7 +495,8 @@ | |||
| 498 | (byte-compile-log | 495 | (byte-compile-log |
| 499 | " all subforms of %s called for effect; deleted" form)) | 496 | " all subforms of %s called for effect; deleted" form)) |
| 500 | (and backwards | 497 | (and backwards |
| 501 | (cons fn (nreverse (mapcar 'byte-optimize-form backwards))))) | 498 | (cons fn (nreverse (mapcar 'byte-optimize-form |
| 499 | backwards))))) | ||
| 502 | (cons fn (mapcar 'byte-optimize-form (cdr form))))) | 500 | (cons fn (mapcar 'byte-optimize-form (cdr form))))) |
| 503 | 501 | ||
| 504 | ((eq fn 'interactive) | 502 | ((eq fn 'interactive) |
| @@ -537,8 +535,8 @@ | |||
| 537 | ;; However, don't actually bother calling `ignore'. | 535 | ;; However, don't actually bother calling `ignore'. |
| 538 | `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form)))) | 536 | `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form)))) |
| 539 | 537 | ||
| 540 | ((eq fn 'internal-make-closure) | 538 | ;; Neeeded as long as we run byte-optimize-form after cconv. |
| 541 | form) | 539 | ((eq fn 'internal-make-closure) form) |
| 542 | 540 | ||
| 543 | ((not (symbolp fn)) | 541 | ((not (symbolp fn)) |
| 544 | (debug) | 542 | (debug) |
| @@ -589,19 +587,18 @@ | |||
| 589 | (setq list (cdr list))) | 587 | (setq list (cdr list))) |
| 590 | constant)) | 588 | constant)) |
| 591 | 589 | ||
| 592 | (defun byte-optimize-form (form &optional for-effect-arg) | 590 | (defun byte-optimize-form (form &optional for-effect) |
| 593 | "The source-level pass of the optimizer." | 591 | "The source-level pass of the optimizer." |
| 594 | ;; | 592 | ;; |
| 595 | ;; First, optimize all sub-forms of this one. | 593 | ;; First, optimize all sub-forms of this one. |
| 596 | (setq form (byte-optimize-form-code-walker form for-effect-arg)) | 594 | (setq form (byte-optimize-form-code-walker form for-effect)) |
| 597 | ;; | 595 | ;; |
| 598 | ;; after optimizing all subforms, optimize this form until it doesn't | 596 | ;; after optimizing all subforms, optimize this form until it doesn't |
| 599 | ;; optimize any further. This means that some forms will be passed through | 597 | ;; optimize any further. This means that some forms will be passed through |
| 600 | ;; the optimizer many times, but that's necessary to make the for-effect | 598 | ;; the optimizer many times, but that's necessary to make the for-effect |
| 601 | ;; processing do as much as possible. | 599 | ;; processing do as much as possible. |
| 602 | ;; | 600 | ;; |
| 603 | (let ((for-effect for-effect-arg) | 601 | (let (opt new) |
| 604 | opt new) | ||
| 605 | (if (and (consp form) | 602 | (if (and (consp form) |
| 606 | (symbolp (car form)) | 603 | (symbolp (car form)) |
| 607 | (or (and for-effect | 604 | (or (and for-effect |
| @@ -618,7 +615,7 @@ | |||
| 618 | 615 | ||
| 619 | 616 | ||
| 620 | (defun byte-optimize-body (forms all-for-effect) | 617 | (defun byte-optimize-body (forms all-for-effect) |
| 621 | ;; optimize the cdr of a progn or implicit progn; all forms is a list of | 618 | ;; Optimize the cdr of a progn or implicit progn; all forms is a list of |
| 622 | ;; forms, all but the last of which are optimized with the assumption that | 619 | ;; forms, all but the last of which are optimized with the assumption that |
| 623 | ;; they are being called for effect. the last is for-effect as well if | 620 | ;; they are being called for effect. the last is for-effect as well if |
| 624 | ;; all-for-effect is true. returns a new list of forms. | 621 | ;; all-for-effect is true. returns a new list of forms. |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c661e6bea7a..729d91eb1c5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -33,8 +33,7 @@ | |||
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | 35 | ||
| 36 | ;; FIXME: Use lexical-binding and get rid of the atrocious "bytecomp-" | 36 | ;; FIXME: get rid of the atrocious "bytecomp-" variable prefix. |
| 37 | ;; variable prefix. | ||
| 38 | 37 | ||
| 39 | ;; ======================================================================== | 38 | ;; ======================================================================== |
| 40 | ;; Entry points: | 39 | ;; Entry points: |
| @@ -432,12 +431,9 @@ This list lives partly on the stack.") | |||
| 432 | (eval-when-compile . (lambda (&rest body) | 431 | (eval-when-compile . (lambda (&rest body) |
| 433 | (list | 432 | (list |
| 434 | 'quote | 433 | 'quote |
| 435 | ;; FIXME: is that right in lexbind code? | ||
| 436 | (byte-compile-eval | 434 | (byte-compile-eval |
| 437 | (byte-compile-top-level | 435 | (byte-compile-top-level |
| 438 | (macroexpand-all | 436 | (byte-compile-preprocess (cons 'progn body))))))) |
| 439 | (cons 'progn body) | ||
| 440 | byte-compile-initial-macro-environment)))))) | ||
| 441 | (eval-and-compile . (lambda (&rest body) | 437 | (eval-and-compile . (lambda (&rest body) |
| 442 | (byte-compile-eval-before-compile (cons 'progn body)) | 438 | (byte-compile-eval-before-compile (cons 'progn body)) |
| 443 | (cons 'progn body)))) | 439 | (cons 'progn body)))) |
| @@ -692,7 +688,7 @@ otherwise pop it") | |||
| 692 | ;; if (following one byte & 0x80) == 0 | 688 | ;; if (following one byte & 0x80) == 0 |
| 693 | ;; discard (following one byte & 0x7F) stack entries | 689 | ;; discard (following one byte & 0x7F) stack entries |
| 694 | ;; else | 690 | ;; else |
| 695 | ;; discard (following one byte & 0x7F) stack entries _underneath_ the top of stack | 691 | ;; discard (following one byte & 0x7F) stack entries _underneath_ TOS |
| 696 | ;; (that is, if the operand = 0x83, ... X Y Z T => ... T) | 692 | ;; (that is, if the operand = 0x83, ... X Y Z T => ... T) |
| 697 | (byte-defop 182 nil byte-discardN) | 693 | (byte-defop 182 nil byte-discardN) |
| 698 | ;; `byte-discardN-preserve-tos' is a pseudo-op that gets turned into | 694 | ;; `byte-discardN-preserve-tos' is a pseudo-op that gets turned into |
| @@ -829,9 +825,11 @@ CONST2 may be evaulated multiple times." | |||
| 829 | ;; too large to fit in 7 bits, the opcode can be repeated. | 825 | ;; too large to fit in 7 bits, the opcode can be repeated. |
| 830 | (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0))) | 826 | (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0))) |
| 831 | (while (> off #x7f) | 827 | (while (> off #x7f) |
| 832 | (byte-compile-push-bytecodes opcode (logior #x7f flag) bytes pc) | 828 | (byte-compile-push-bytecodes opcode (logior #x7f flag) |
| 829 | bytes pc) | ||
| 833 | (setq off (- off #x7f))) | 830 | (setq off (- off #x7f))) |
| 834 | (byte-compile-push-bytecodes opcode (logior off flag) bytes pc))) | 831 | (byte-compile-push-bytecodes opcode (logior off flag) |
| 832 | bytes pc))) | ||
| 835 | ((null off) | 833 | ((null off) |
| 836 | ;; opcode that doesn't use OFF | 834 | ;; opcode that doesn't use OFF |
| 837 | (byte-compile-push-bytecodes opcode bytes pc)) | 835 | (byte-compile-push-bytecodes opcode bytes pc)) |
| @@ -875,7 +873,7 @@ CONST2 may be evaulated multiple times." | |||
| 875 | Each function's symbol gets added to `byte-compile-noruntime-functions'." | 873 | Each function's symbol gets added to `byte-compile-noruntime-functions'." |
| 876 | (let ((hist-orig load-history) | 874 | (let ((hist-orig load-history) |
| 877 | (hist-nil-orig current-load-list)) | 875 | (hist-nil-orig current-load-list)) |
| 878 | (prog1 (eval form) | 876 | (prog1 (eval form lexical-binding) |
| 879 | (when (byte-compile-warning-enabled-p 'noruntime) | 877 | (when (byte-compile-warning-enabled-p 'noruntime) |
| 880 | (let ((hist-new load-history) | 878 | (let ((hist-new load-history) |
| 881 | (hist-nil-new current-load-list)) | 879 | (hist-nil-new current-load-list)) |
| @@ -927,7 +925,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 927 | (defun byte-compile-eval-before-compile (form) | 925 | (defun byte-compile-eval-before-compile (form) |
| 928 | "Evaluate FORM for `eval-and-compile'." | 926 | "Evaluate FORM for `eval-and-compile'." |
| 929 | (let ((hist-nil-orig current-load-list)) | 927 | (let ((hist-nil-orig current-load-list)) |
| 930 | (prog1 (eval form) | 928 | (prog1 (eval form lexical-binding) |
| 931 | ;; (eval-and-compile (require 'cl) turns off warnings for cl functions. | 929 | ;; (eval-and-compile (require 'cl) turns off warnings for cl functions. |
| 932 | ;; FIXME Why does it do that - just as a hack? | 930 | ;; FIXME Why does it do that - just as a hack? |
| 933 | ;; There are other ways to do this nowadays. | 931 | ;; There are other ways to do this nowadays. |
| @@ -1018,7 +1016,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 1018 | read-symbol-positions-list | 1016 | read-symbol-positions-list |
| 1019 | (byte-compile-delete-first | 1017 | (byte-compile-delete-first |
| 1020 | entry read-symbol-positions-list))) | 1018 | entry read-symbol-positions-list))) |
| 1021 | (or (and allow-previous (not (= last byte-compile-last-position))) | 1019 | (or (and allow-previous |
| 1020 | (not (= last byte-compile-last-position))) | ||
| 1022 | (> last byte-compile-last-position))))))) | 1021 | (> last byte-compile-last-position))))))) |
| 1023 | 1022 | ||
| 1024 | (defvar byte-compile-last-warned-form nil) | 1023 | (defvar byte-compile-last-warned-form nil) |
| @@ -1030,7 +1029,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 1030 | (let* ((inhibit-read-only t) | 1029 | (let* ((inhibit-read-only t) |
| 1031 | (dir default-directory) | 1030 | (dir default-directory) |
| 1032 | (file (cond ((stringp byte-compile-current-file) | 1031 | (file (cond ((stringp byte-compile-current-file) |
| 1033 | (format "%s:" (file-relative-name byte-compile-current-file dir))) | 1032 | (format "%s:" (file-relative-name |
| 1033 | byte-compile-current-file dir))) | ||
| 1034 | ((bufferp byte-compile-current-file) | 1034 | ((bufferp byte-compile-current-file) |
| 1035 | (format "Buffer %s:" | 1035 | (format "Buffer %s:" |
| 1036 | (buffer-name byte-compile-current-file))) | 1036 | (buffer-name byte-compile-current-file))) |
| @@ -1093,13 +1093,15 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 1093 | (insert "\f\nCompiling " | 1093 | (insert "\f\nCompiling " |
| 1094 | (if (stringp byte-compile-current-file) | 1094 | (if (stringp byte-compile-current-file) |
| 1095 | (concat "file " byte-compile-current-file) | 1095 | (concat "file " byte-compile-current-file) |
| 1096 | (concat "buffer " (buffer-name byte-compile-current-file))) | 1096 | (concat "buffer " |
| 1097 | (buffer-name byte-compile-current-file))) | ||
| 1097 | " at " (current-time-string) "\n") | 1098 | " at " (current-time-string) "\n") |
| 1098 | (insert "\f\nCompiling no file at " (current-time-string) "\n")) | 1099 | (insert "\f\nCompiling no file at " (current-time-string) "\n")) |
| 1099 | (when dir | 1100 | (when dir |
| 1100 | (setq default-directory dir) | 1101 | (setq default-directory dir) |
| 1101 | (unless was-same | 1102 | (unless was-same |
| 1102 | (insert (format "Entering directory `%s'\n" default-directory)))) | 1103 | (insert (format "Entering directory `%s'\n" |
| 1104 | default-directory)))) | ||
| 1103 | (setq byte-compile-last-logged-file byte-compile-current-file | 1105 | (setq byte-compile-last-logged-file byte-compile-current-file |
| 1104 | byte-compile-last-warned-form nil) | 1106 | byte-compile-last-warned-form nil) |
| 1105 | ;; Do this after setting default-directory. | 1107 | ;; Do this after setting default-directory. |
| @@ -1325,7 +1327,7 @@ extra args." | |||
| 1325 | (custom-declare-variable . defcustom)))) | 1327 | (custom-declare-variable . defcustom)))) |
| 1326 | (cadr name))) | 1328 | (cadr name))) |
| 1327 | ;; Update the current group, if needed. | 1329 | ;; Update the current group, if needed. |
| 1328 | (if (and byte-compile-current-file ;Only when byte-compiling a whole file. | 1330 | (if (and byte-compile-current-file ;Only when compiling a whole file. |
| 1329 | (eq (car form) 'custom-declare-group) | 1331 | (eq (car form) 'custom-declare-group) |
| 1330 | (eq (car-safe name) 'quote)) | 1332 | (eq (car-safe name) 'quote)) |
| 1331 | (setq byte-compile-current-group (cadr name)))))) | 1333 | (setq byte-compile-current-group (cadr name)))))) |
| @@ -1873,7 +1875,8 @@ With argument ARG, insert value in current buffer after the form." | |||
| 1873 | (let ((read-with-symbol-positions (current-buffer)) | 1875 | (let ((read-with-symbol-positions (current-buffer)) |
| 1874 | (read-symbol-positions-list nil)) | 1876 | (read-symbol-positions-list nil)) |
| 1875 | (displaying-byte-compile-warnings | 1877 | (displaying-byte-compile-warnings |
| 1876 | (byte-compile-sexp (read (current-buffer)))))))) | 1878 | (byte-compile-sexp (read (current-buffer))))) |
| 1879 | lexical-binding))) | ||
| 1877 | (cond (arg | 1880 | (cond (arg |
| 1878 | (message "Compiling from buffer... done.") | 1881 | (message "Compiling from buffer... done.") |
| 1879 | (prin1 value (current-buffer)) | 1882 | (prin1 value (current-buffer)) |
| @@ -2072,7 +2075,7 @@ Call from the source buffer." | |||
| 2072 | nil))) | 2075 | nil))) |
| 2073 | 2076 | ||
| 2074 | (defvar print-gensym-alist) ;Used before print-circle existed. | 2077 | (defvar print-gensym-alist) ;Used before print-circle existed. |
| 2075 | (defvar for-effect) | 2078 | (defvar byte-compile--for-effect) |
| 2076 | 2079 | ||
| 2077 | (defun byte-compile-output-docform (preface name info form specindex quoted) | 2080 | (defun byte-compile-output-docform (preface name info form specindex quoted) |
| 2078 | "Print a form with a doc string. INFO is (prefix doc-index postfix). | 2081 | "Print a form with a doc string. INFO is (prefix doc-index postfix). |
| @@ -2147,8 +2150,10 @@ list that represents a doc string reference. | |||
| 2147 | (byte-compile-output-as-comment | 2150 | (byte-compile-output-as-comment |
| 2148 | (cons (car form) (nth 1 form)) | 2151 | (cons (car form) (nth 1 form)) |
| 2149 | t))) | 2152 | t))) |
| 2150 | (setq position (- (position-bytes position) (point-min) -1)) | 2153 | (setq position (- (position-bytes position) |
| 2151 | (princ (format "(#$ . %d) nil" position) bytecomp-outbuffer) | 2154 | (point-min) -1)) |
| 2155 | (princ (format "(#$ . %d) nil" position) | ||
| 2156 | bytecomp-outbuffer) | ||
| 2152 | (setq form (cdr form)) | 2157 | (setq form (cdr form)) |
| 2153 | (setq index (1+ index)))) | 2158 | (setq index (1+ index)))) |
| 2154 | ((= index (nth 1 info)) | 2159 | ((= index (nth 1 info)) |
| @@ -2170,14 +2175,14 @@ list that represents a doc string reference. | |||
| 2170 | (if (memq byte-optimize '(t source)) | 2175 | (if (memq byte-optimize '(t source)) |
| 2171 | (setq form (byte-optimize-form form t))) | 2176 | (setq form (byte-optimize-form form t))) |
| 2172 | (if bytecomp-handler | 2177 | (if bytecomp-handler |
| 2173 | (let ((for-effect t)) | 2178 | (let ((byte-compile--for-effect t)) |
| 2174 | ;; To avoid consing up monstrously large forms at load time, we split | 2179 | ;; To avoid consing up monstrously large forms at load time, we split |
| 2175 | ;; the output regularly. | 2180 | ;; the output regularly. |
| 2176 | (and (memq (car-safe form) '(fset defalias)) | 2181 | (and (memq (car-safe form) '(fset defalias)) |
| 2177 | (nthcdr 300 byte-compile-output) | 2182 | (nthcdr 300 byte-compile-output) |
| 2178 | (byte-compile-flush-pending)) | 2183 | (byte-compile-flush-pending)) |
| 2179 | (funcall bytecomp-handler form) | 2184 | (funcall bytecomp-handler form) |
| 2180 | (if for-effect | 2185 | (if byte-compile--for-effect |
| 2181 | (byte-compile-discard))) | 2186 | (byte-compile-discard))) |
| 2182 | (byte-compile-form form t)) | 2187 | (byte-compile-form form t)) |
| 2183 | nil) | 2188 | nil) |
| @@ -2195,13 +2200,22 @@ list that represents a doc string reference. | |||
| 2195 | byte-compile-maxdepth 0 | 2200 | byte-compile-maxdepth 0 |
| 2196 | byte-compile-output nil)))) | 2201 | byte-compile-output nil)))) |
| 2197 | 2202 | ||
| 2203 | (defun byte-compile-preprocess (form &optional _for-effect) | ||
| 2204 | (setq form (macroexpand-all form byte-compile-macro-environment)) | ||
| 2205 | ;; FIXME: We should run byte-optimize-form here, but it currently does not | ||
| 2206 | ;; recurse through all the code, so we'd have to fix this first. | ||
| 2207 | ;; Maybe a good fix would be to merge byte-optimize-form into | ||
| 2208 | ;; macroexpand-all. | ||
| 2209 | ;; (if (memq byte-optimize '(t source)) | ||
| 2210 | ;; (setq form (byte-optimize-form form for-effect))) | ||
| 2211 | (if lexical-binding | ||
| 2212 | (cconv-closure-convert form) | ||
| 2213 | form)) | ||
| 2214 | |||
| 2198 | ;; byte-hunk-handlers cannot call this! | 2215 | ;; byte-hunk-handlers cannot call this! |
| 2199 | (defun byte-compile-toplevel-file-form (form) | 2216 | (defun byte-compile-toplevel-file-form (form) |
| 2200 | (let ((byte-compile-current-form nil)) ; close over this for warnings. | 2217 | (let ((byte-compile-current-form nil)) ; close over this for warnings. |
| 2201 | (setq form (macroexpand-all form byte-compile-macro-environment)) | 2218 | (byte-compile-file-form (byte-compile-preprocess form t)))) |
| 2202 | (if lexical-binding | ||
| 2203 | (setq form (cconv-closure-convert form))) | ||
| 2204 | (byte-compile-file-form form))) | ||
| 2205 | 2219 | ||
| 2206 | ;; byte-hunk-handlers can call this. | 2220 | ;; byte-hunk-handlers can call this. |
| 2207 | (defun byte-compile-file-form (form) | 2221 | (defun byte-compile-file-form (form) |
| @@ -2272,7 +2286,8 @@ list that represents a doc string reference. | |||
| 2272 | (byte-compile-top-level (nth 2 form) nil 'file)))) | 2286 | (byte-compile-top-level (nth 2 form) nil 'file)))) |
| 2273 | form)) | 2287 | form)) |
| 2274 | 2288 | ||
| 2275 | (put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table) | 2289 | (put 'define-abbrev-table 'byte-hunk-handler |
| 2290 | 'byte-compile-file-form-define-abbrev-table) | ||
| 2276 | (defun byte-compile-file-form-define-abbrev-table (form) | 2291 | (defun byte-compile-file-form-define-abbrev-table (form) |
| 2277 | (if (eq 'quote (car-safe (car-safe (cdr form)))) | 2292 | (if (eq 'quote (car-safe (car-safe (cdr form)))) |
| 2278 | (push (car-safe (cdr (cadr form))) byte-compile-bound-variables)) | 2293 | (push (car-safe (cdr (cadr form))) byte-compile-bound-variables)) |
| @@ -2542,11 +2557,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2542 | (setq fun (cdr fun))) | 2557 | (setq fun (cdr fun))) |
| 2543 | (cond ((eq (car-safe fun) 'lambda) | 2558 | (cond ((eq (car-safe fun) 'lambda) |
| 2544 | ;; Expand macros. | 2559 | ;; Expand macros. |
| 2545 | (setq fun | 2560 | (setq fun (byte-compile-preprocess fun)) |
| 2546 | (macroexpand-all fun | ||
| 2547 | byte-compile-initial-macro-environment)) | ||
| 2548 | (if lexical-binding | ||
| 2549 | (setq fun (cconv-closure-convert fun))) | ||
| 2550 | ;; Get rid of the `function' quote added by the `lambda' macro. | 2561 | ;; Get rid of the `function' quote added by the `lambda' macro. |
| 2551 | (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) | 2562 | (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) |
| 2552 | (setq fun (if macro | 2563 | (setq fun (if macro |
| @@ -2560,7 +2571,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2560 | "Compile and return SEXP." | 2571 | "Compile and return SEXP." |
| 2561 | (displaying-byte-compile-warnings | 2572 | (displaying-byte-compile-warnings |
| 2562 | (byte-compile-close-variables | 2573 | (byte-compile-close-variables |
| 2563 | (byte-compile-top-level sexp)))) | 2574 | (byte-compile-top-level (byte-compile-preprocess sexp))))) |
| 2564 | 2575 | ||
| 2565 | ;; Given a function made by byte-compile-lambda, make a form which produces it. | 2576 | ;; Given a function made by byte-compile-lambda, make a form which produces it. |
| 2566 | (defun byte-compile-byte-code-maker (fun) | 2577 | (defun byte-compile-byte-code-maker (fun) |
| @@ -2815,14 +2826,14 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2815 | 2826 | ||
| 2816 | ;; Given an expression FORM, compile it and return an equivalent byte-code | 2827 | ;; Given an expression FORM, compile it and return an equivalent byte-code |
| 2817 | ;; expression (a call to the function byte-code). | 2828 | ;; expression (a call to the function byte-code). |
| 2818 | (defun byte-compile-top-level (form &optional for-effect-arg output-type | 2829 | (defun byte-compile-top-level (form &optional for-effect output-type |
| 2819 | lexenv reserved-csts) | 2830 | lexenv reserved-csts) |
| 2820 | ;; OUTPUT-TYPE advises about how form is expected to be used: | 2831 | ;; OUTPUT-TYPE advises about how form is expected to be used: |
| 2821 | ;; 'eval or nil -> a single form, | 2832 | ;; 'eval or nil -> a single form, |
| 2822 | ;; 'progn or t -> a list of forms, | 2833 | ;; 'progn or t -> a list of forms, |
| 2823 | ;; 'lambda -> body of a lambda, | 2834 | ;; 'lambda -> body of a lambda, |
| 2824 | ;; 'file -> used at file-level. | 2835 | ;; 'file -> used at file-level. |
| 2825 | (let ((for-effect for-effect-arg) | 2836 | (let ((byte-compile--for-effect for-effect) |
| 2826 | (byte-compile-constants nil) | 2837 | (byte-compile-constants nil) |
| 2827 | (byte-compile-variables nil) | 2838 | (byte-compile-variables nil) |
| 2828 | (byte-compile-tag-number 0) | 2839 | (byte-compile-tag-number 0) |
| @@ -2832,7 +2843,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2832 | (byte-compile-reserved-constants (or reserved-csts 0)) | 2843 | (byte-compile-reserved-constants (or reserved-csts 0)) |
| 2833 | (byte-compile-output nil)) | 2844 | (byte-compile-output nil)) |
| 2834 | (if (memq byte-optimize '(t source)) | 2845 | (if (memq byte-optimize '(t source)) |
| 2835 | (setq form (byte-optimize-form form for-effect))) | 2846 | (setq form (byte-optimize-form form byte-compile--for-effect))) |
| 2836 | (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) | 2847 | (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) |
| 2837 | (setq form (nth 1 form))) | 2848 | (setq form (nth 1 form))) |
| 2838 | (if (and (eq 'byte-code (car-safe form)) | 2849 | (if (and (eq 'byte-code (car-safe form)) |
| @@ -2850,11 +2861,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2850 | (when (> byte-compile-depth 0) | 2861 | (when (> byte-compile-depth 0) |
| 2851 | (byte-compile-out-tag (byte-compile-make-tag)))) | 2862 | (byte-compile-out-tag (byte-compile-make-tag)))) |
| 2852 | ;; Now compile FORM | 2863 | ;; Now compile FORM |
| 2853 | (byte-compile-form form for-effect) | 2864 | (byte-compile-form form byte-compile--for-effect) |
| 2854 | (byte-compile-out-toplevel for-effect output-type)))) | 2865 | (byte-compile-out-toplevel byte-compile--for-effect output-type)))) |
| 2855 | 2866 | ||
| 2856 | (defun byte-compile-out-toplevel (&optional for-effect-arg output-type) | 2867 | (defun byte-compile-out-toplevel (&optional for-effect output-type) |
| 2857 | (if for-effect-arg | 2868 | (if for-effect |
| 2858 | ;; The stack is empty. Push a value to be returned from (byte-code ..). | 2869 | ;; The stack is empty. Push a value to be returned from (byte-code ..). |
| 2859 | (if (eq (car (car byte-compile-output)) 'byte-discard) | 2870 | (if (eq (car (car byte-compile-output)) 'byte-discard) |
| 2860 | (setq byte-compile-output (cdr byte-compile-output)) | 2871 | (setq byte-compile-output (cdr byte-compile-output)) |
| @@ -2890,7 +2901,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2890 | ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) | 2901 | ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) |
| 2891 | ;; file -> as progn, but takes both quotes and atoms, and longer forms. | 2902 | ;; file -> as progn, but takes both quotes and atoms, and longer forms. |
| 2892 | (let (rest | 2903 | (let (rest |
| 2893 | (for-effect for-effect-arg) | 2904 | (byte-compile--for-effect for-effect) |
| 2894 | (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. | 2905 | (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. |
| 2895 | tmp body) | 2906 | tmp body) |
| 2896 | (cond | 2907 | (cond |
| @@ -2902,34 +2913,35 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2902 | (progn | 2913 | (progn |
| 2903 | (setq rest (nreverse | 2914 | (setq rest (nreverse |
| 2904 | (cdr (memq tmp (reverse byte-compile-output))))) | 2915 | (cdr (memq tmp (reverse byte-compile-output))))) |
| 2905 | (while (cond | 2916 | (while |
| 2906 | ((memq (car (car rest)) '(byte-varref byte-constant)) | 2917 | (cond |
| 2907 | (setq tmp (car (cdr (car rest)))) | 2918 | ((memq (car (car rest)) '(byte-varref byte-constant)) |
| 2908 | (if (if (eq (car (car rest)) 'byte-constant) | 2919 | (setq tmp (car (cdr (car rest)))) |
| 2909 | (or (consp tmp) | 2920 | (if (if (eq (car (car rest)) 'byte-constant) |
| 2910 | (and (symbolp tmp) | 2921 | (or (consp tmp) |
| 2911 | (not (byte-compile-const-symbol-p tmp))))) | 2922 | (and (symbolp tmp) |
| 2912 | (if maycall | 2923 | (not (byte-compile-const-symbol-p tmp))))) |
| 2913 | (setq body (cons (list 'quote tmp) body))) | 2924 | (if maycall |
| 2914 | (setq body (cons tmp body)))) | 2925 | (setq body (cons (list 'quote tmp) body))) |
| 2915 | ((and maycall | 2926 | (setq body (cons tmp body)))) |
| 2916 | ;; Allow a funcall if at most one atom follows it. | 2927 | ((and maycall |
| 2917 | (null (nthcdr 3 rest)) | 2928 | ;; Allow a funcall if at most one atom follows it. |
| 2918 | (setq tmp (get (car (car rest)) 'byte-opcode-invert)) | 2929 | (null (nthcdr 3 rest)) |
| 2919 | (or (null (cdr rest)) | 2930 | (setq tmp (get (car (car rest)) 'byte-opcode-invert)) |
| 2920 | (and (memq output-type '(file progn t)) | 2931 | (or (null (cdr rest)) |
| 2921 | (cdr (cdr rest)) | 2932 | (and (memq output-type '(file progn t)) |
| 2922 | (eq (car (nth 1 rest)) 'byte-discard) | 2933 | (cdr (cdr rest)) |
| 2923 | (progn (setq rest (cdr rest)) t)))) | 2934 | (eq (car (nth 1 rest)) 'byte-discard) |
| 2924 | (setq maycall nil) ; Only allow one real function call. | 2935 | (progn (setq rest (cdr rest)) t)))) |
| 2925 | (setq body (nreverse body)) | 2936 | (setq maycall nil) ; Only allow one real function call. |
| 2926 | (setq body (list | 2937 | (setq body (nreverse body)) |
| 2927 | (if (and (eq tmp 'funcall) | 2938 | (setq body (list |
| 2928 | (eq (car-safe (car body)) 'quote)) | 2939 | (if (and (eq tmp 'funcall) |
| 2929 | (cons (nth 1 (car body)) (cdr body)) | 2940 | (eq (car-safe (car body)) 'quote)) |
| 2930 | (cons tmp body)))) | 2941 | (cons (nth 1 (car body)) (cdr body)) |
| 2931 | (or (eq output-type 'file) | 2942 | (cons tmp body)))) |
| 2932 | (not (delq nil (mapcar 'consp (cdr (car body)))))))) | 2943 | (or (eq output-type 'file) |
| 2944 | (not (delq nil (mapcar 'consp (cdr (car body)))))))) | ||
| 2933 | (setq rest (cdr rest))) | 2945 | (setq rest (cdr rest))) |
| 2934 | rest)) | 2946 | rest)) |
| 2935 | (let ((byte-compile-vector (byte-compile-constants-vector))) | 2947 | (let ((byte-compile-vector (byte-compile-constants-vector))) |
| @@ -2940,9 +2952,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2940 | ((car body))))) | 2952 | ((car body))))) |
| 2941 | 2953 | ||
| 2942 | ;; Given BYTECOMP-BODY, compile it and return a new body. | 2954 | ;; Given BYTECOMP-BODY, compile it and return a new body. |
| 2943 | (defun byte-compile-top-level-body (bytecomp-body &optional for-effect-arg) | 2955 | (defun byte-compile-top-level-body (bytecomp-body &optional for-effect) |
| 2944 | (setq bytecomp-body | 2956 | (setq bytecomp-body |
| 2945 | (byte-compile-top-level (cons 'progn bytecomp-body) for-effect-arg t)) | 2957 | (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) |
| 2946 | (cond ((eq (car-safe bytecomp-body) 'progn) | 2958 | (cond ((eq (car-safe bytecomp-body) 'progn) |
| 2947 | (cdr bytecomp-body)) | 2959 | (cdr bytecomp-body)) |
| 2948 | (bytecomp-body | 2960 | (bytecomp-body |
| @@ -2966,25 +2978,27 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2966 | ;; expression. | 2978 | ;; expression. |
| 2967 | ;; If for-effect is non-nil, byte-compile-form will output a byte-discard | 2979 | ;; If for-effect is non-nil, byte-compile-form will output a byte-discard |
| 2968 | ;; before terminating (ie no value will be left on the stack). | 2980 | ;; before terminating (ie no value will be left on the stack). |
| 2969 | ;; A byte-compile handler may, when for-effect is non-nil, choose output code | 2981 | ;; A byte-compile handler may, when byte-compile--for-effect is non-nil, choose |
| 2970 | ;; which does not leave a value on the stack, and then set for-effect to nil | 2982 | ;; output code which does not leave a value on the stack, and then set |
| 2971 | ;; (to prevent byte-compile-form from outputting the byte-discard). | 2983 | ;; byte-compile--for-effect to nil (to prevent byte-compile-form from |
| 2984 | ;; outputting the byte-discard). | ||
| 2972 | ;; If a handler wants to call another handler, it should do so via | 2985 | ;; If a handler wants to call another handler, it should do so via |
| 2973 | ;; byte-compile-form, or take extreme care to handle for-effect correctly. | 2986 | ;; byte-compile-form, or take extreme care to handle byte-compile--for-effect |
| 2974 | ;; (Use byte-compile-form-do-effect to reset the for-effect flag too.) | 2987 | ;; correctly. (Use byte-compile-form-do-effect to reset the |
| 2988 | ;; byte-compile--for-effect flag too.) | ||
| 2975 | ;; | 2989 | ;; |
| 2976 | (defun byte-compile-form (form &optional for-effect-arg) | 2990 | (defun byte-compile-form (form &optional for-effect) |
| 2977 | (let ((for-effect for-effect-arg)) | 2991 | (let ((byte-compile--for-effect for-effect)) |
| 2978 | (cond | 2992 | (cond |
| 2979 | ((not (consp form)) | 2993 | ((not (consp form)) |
| 2980 | (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form)) | 2994 | (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form)) |
| 2981 | (when (symbolp form) | 2995 | (when (symbolp form) |
| 2982 | (byte-compile-set-symbol-position form)) | 2996 | (byte-compile-set-symbol-position form)) |
| 2983 | (byte-compile-constant form)) | 2997 | (byte-compile-constant form)) |
| 2984 | ((and for-effect byte-compile-delete-errors) | 2998 | ((and byte-compile--for-effect byte-compile-delete-errors) |
| 2985 | (when (symbolp form) | 2999 | (when (symbolp form) |
| 2986 | (byte-compile-set-symbol-position form)) | 3000 | (byte-compile-set-symbol-position form)) |
| 2987 | (setq for-effect nil)) | 3001 | (setq byte-compile--for-effect nil)) |
| 2988 | (t | 3002 | (t |
| 2989 | (byte-compile-variable-ref form)))) | 3003 | (byte-compile-variable-ref form)))) |
| 2990 | ((symbolp (car form)) | 3004 | ((symbolp (car form)) |
| @@ -3018,10 +3032,10 @@ That command is designed for interactive use only" bytecomp-fn)) | |||
| 3018 | ;; if the form comes out the same way it went in, that's | 3032 | ;; if the form comes out the same way it went in, that's |
| 3019 | ;; because it was malformed, and we couldn't unfold it. | 3033 | ;; because it was malformed, and we couldn't unfold it. |
| 3020 | (not (eq form (setq form (byte-compile-unfold-lambda form))))) | 3034 | (not (eq form (setq form (byte-compile-unfold-lambda form))))) |
| 3021 | (byte-compile-form form for-effect) | 3035 | (byte-compile-form form byte-compile--for-effect) |
| 3022 | (setq for-effect nil)) | 3036 | (setq byte-compile--for-effect nil)) |
| 3023 | ((byte-compile-normal-call form))) | 3037 | ((byte-compile-normal-call form))) |
| 3024 | (if for-effect | 3038 | (if byte-compile--for-effect |
| 3025 | (byte-compile-discard)))) | 3039 | (byte-compile-discard)))) |
| 3026 | 3040 | ||
| 3027 | (defun byte-compile-normal-call (form) | 3041 | (defun byte-compile-normal-call (form) |
| @@ -3037,7 +3051,7 @@ That command is designed for interactive use only" bytecomp-fn)) | |||
| 3037 | (byte-compile-callargs-warn form)) | 3051 | (byte-compile-callargs-warn form)) |
| 3038 | (if byte-compile-generate-call-tree | 3052 | (if byte-compile-generate-call-tree |
| 3039 | (byte-compile-annotate-call-tree form)) | 3053 | (byte-compile-annotate-call-tree form)) |
| 3040 | (when (and for-effect (eq (car form) 'mapcar) | 3054 | (when (and byte-compile--for-effect (eq (car form) 'mapcar) |
| 3041 | (byte-compile-warning-enabled-p 'mapcar)) | 3055 | (byte-compile-warning-enabled-p 'mapcar)) |
| 3042 | (byte-compile-set-symbol-position 'mapcar) | 3056 | (byte-compile-set-symbol-position 'mapcar) |
| 3043 | (byte-compile-warn | 3057 | (byte-compile-warn |
| @@ -3119,18 +3133,19 @@ If BINDING is non-nil, VAR is being bound." | |||
| 3119 | (car (setq byte-compile-constants | 3133 | (car (setq byte-compile-constants |
| 3120 | (cons (list ,const) byte-compile-constants))))) | 3134 | (cons (list ,const) byte-compile-constants))))) |
| 3121 | 3135 | ||
| 3122 | ;; Use this when the value of a form is a constant. This obeys for-effect. | 3136 | ;; Use this when the value of a form is a constant. |
| 3137 | ;; This obeys byte-compile--for-effect. | ||
| 3123 | (defun byte-compile-constant (const) | 3138 | (defun byte-compile-constant (const) |
| 3124 | (if for-effect | 3139 | (if byte-compile--for-effect |
| 3125 | (setq for-effect nil) | 3140 | (setq byte-compile--for-effect nil) |
| 3126 | (when (symbolp const) | 3141 | (when (symbolp const) |
| 3127 | (byte-compile-set-symbol-position const)) | 3142 | (byte-compile-set-symbol-position const)) |
| 3128 | (byte-compile-out 'byte-constant (byte-compile-get-constant const)))) | 3143 | (byte-compile-out 'byte-constant (byte-compile-get-constant const)))) |
| 3129 | 3144 | ||
| 3130 | ;; Use this for a constant that is not the value of its containing form. | 3145 | ;; Use this for a constant that is not the value of its containing form. |
| 3131 | ;; This ignores for-effect. | 3146 | ;; This ignores byte-compile--for-effect. |
| 3132 | (defun byte-compile-push-constant (const) | 3147 | (defun byte-compile-push-constant (const) |
| 3133 | (let ((for-effect nil)) | 3148 | (let ((byte-compile--for-effect nil)) |
| 3134 | (inline (byte-compile-constant const)))) | 3149 | (inline (byte-compile-constant const)))) |
| 3135 | 3150 | ||
| 3136 | ;; Compile those primitive ordinary functions | 3151 | ;; Compile those primitive ordinary functions |
| @@ -3335,7 +3350,8 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" | |||
| 3335 | (byte-compile-constant nil)) | 3350 | (byte-compile-constant nil)) |
| 3336 | 3351 | ||
| 3337 | (defun byte-compile-discard (&optional num preserve-tos) | 3352 | (defun byte-compile-discard (&optional num preserve-tos) |
| 3338 | "Output byte codes to discard the NUM entries at the top of the stack (NUM defaults to 1). | 3353 | "Output byte codes to discard the NUM entries at the top of the stack. |
| 3354 | NUM defaults to 1. | ||
| 3339 | If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were | 3355 | If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were |
| 3340 | popped before discarding the num values, and then pushed back again after | 3356 | popped before discarding the num values, and then pushed back again after |
| 3341 | discarding." | 3357 | discarding." |
| @@ -3357,7 +3373,7 @@ discarding." | |||
| 3357 | (setq num (1- num))))) | 3373 | (setq num (1- num))))) |
| 3358 | 3374 | ||
| 3359 | (defun byte-compile-stack-ref (stack-pos) | 3375 | (defun byte-compile-stack-ref (stack-pos) |
| 3360 | "Output byte codes to push the value at position STACK-POS in the stack, on the top of the stack." | 3376 | "Output byte codes to push the value at stack position STACK-POS." |
| 3361 | (let ((dist (- byte-compile-depth (1+ stack-pos)))) | 3377 | (let ((dist (- byte-compile-depth (1+ stack-pos)))) |
| 3362 | (if (zerop dist) | 3378 | (if (zerop dist) |
| 3363 | ;; A simple optimization | 3379 | ;; A simple optimization |
| @@ -3366,7 +3382,7 @@ discarding." | |||
| 3366 | (byte-compile-out 'byte-stack-ref dist)))) | 3382 | (byte-compile-out 'byte-stack-ref dist)))) |
| 3367 | 3383 | ||
| 3368 | (defun byte-compile-stack-set (stack-pos) | 3384 | (defun byte-compile-stack-set (stack-pos) |
| 3369 | "Output byte codes to store the top-of-stack value at position STACK-POS in the stack." | 3385 | "Output byte codes to store the TOS value at stack position STACK-POS." |
| 3370 | (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos)))) | 3386 | (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos)))) |
| 3371 | 3387 | ||
| 3372 | (byte-defop-compiler-1 internal-make-closure byte-compile-make-closure) | 3388 | (byte-defop-compiler-1 internal-make-closure byte-compile-make-closure) |
| @@ -3375,7 +3391,7 @@ discarding." | |||
| 3375 | (defconst byte-compile--env-var (make-symbol "env")) | 3391 | (defconst byte-compile--env-var (make-symbol "env")) |
| 3376 | 3392 | ||
| 3377 | (defun byte-compile-make-closure (form) | 3393 | (defun byte-compile-make-closure (form) |
| 3378 | (if for-effect (setq for-effect nil) | 3394 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3379 | (let* ((vars (nth 1 form)) | 3395 | (let* ((vars (nth 1 form)) |
| 3380 | (env (nth 2 form)) | 3396 | (env (nth 2 form)) |
| 3381 | (body (nthcdr 3 form)) | 3397 | (body (nthcdr 3 form)) |
| @@ -3389,7 +3405,7 @@ discarding." | |||
| 3389 | 3405 | ||
| 3390 | 3406 | ||
| 3391 | (defun byte-compile-get-closed-var (form) | 3407 | (defun byte-compile-get-closed-var (form) |
| 3392 | (if for-effect (setq for-effect nil) | 3408 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3393 | (byte-compile-out 'byte-constant ;; byte-closed-var | 3409 | (byte-compile-out 'byte-constant ;; byte-closed-var |
| 3394 | (nth 1 form)))) | 3410 | (nth 1 form)))) |
| 3395 | 3411 | ||
| @@ -3597,13 +3613,13 @@ discarding." | |||
| 3597 | (if bytecomp-args | 3613 | (if bytecomp-args |
| 3598 | (while bytecomp-args | 3614 | (while bytecomp-args |
| 3599 | (byte-compile-form (car (cdr bytecomp-args))) | 3615 | (byte-compile-form (car (cdr bytecomp-args))) |
| 3600 | (or for-effect (cdr (cdr bytecomp-args)) | 3616 | (or byte-compile--for-effect (cdr (cdr bytecomp-args)) |
| 3601 | (byte-compile-out 'byte-dup 0)) | 3617 | (byte-compile-out 'byte-dup 0)) |
| 3602 | (byte-compile-variable-set (car bytecomp-args)) | 3618 | (byte-compile-variable-set (car bytecomp-args)) |
| 3603 | (setq bytecomp-args (cdr (cdr bytecomp-args)))) | 3619 | (setq bytecomp-args (cdr (cdr bytecomp-args)))) |
| 3604 | ;; (setq), with no arguments. | 3620 | ;; (setq), with no arguments. |
| 3605 | (byte-compile-form nil for-effect)) | 3621 | (byte-compile-form nil byte-compile--for-effect)) |
| 3606 | (setq for-effect nil))) | 3622 | (setq byte-compile--for-effect nil))) |
| 3607 | 3623 | ||
| 3608 | (defun byte-compile-setq-default (form) | 3624 | (defun byte-compile-setq-default (form) |
| 3609 | (setq form (cdr form)) | 3625 | (setq form (cdr form)) |
| @@ -3637,19 +3653,19 @@ discarding." | |||
| 3637 | 3653 | ||
| 3638 | ;;; control structures | 3654 | ;;; control structures |
| 3639 | 3655 | ||
| 3640 | (defun byte-compile-body (bytecomp-body &optional for-effect-arg) | 3656 | (defun byte-compile-body (bytecomp-body &optional for-effect) |
| 3641 | (while (cdr bytecomp-body) | 3657 | (while (cdr bytecomp-body) |
| 3642 | (byte-compile-form (car bytecomp-body) t) | 3658 | (byte-compile-form (car bytecomp-body) t) |
| 3643 | (setq bytecomp-body (cdr bytecomp-body))) | 3659 | (setq bytecomp-body (cdr bytecomp-body))) |
| 3644 | (byte-compile-form (car bytecomp-body) for-effect-arg)) | 3660 | (byte-compile-form (car bytecomp-body) for-effect)) |
| 3645 | 3661 | ||
| 3646 | (defsubst byte-compile-body-do-effect (bytecomp-body) | 3662 | (defsubst byte-compile-body-do-effect (bytecomp-body) |
| 3647 | (byte-compile-body bytecomp-body for-effect) | 3663 | (byte-compile-body bytecomp-body byte-compile--for-effect) |
| 3648 | (setq for-effect nil)) | 3664 | (setq byte-compile--for-effect nil)) |
| 3649 | 3665 | ||
| 3650 | (defsubst byte-compile-form-do-effect (form) | 3666 | (defsubst byte-compile-form-do-effect (form) |
| 3651 | (byte-compile-form form for-effect) | 3667 | (byte-compile-form form byte-compile--for-effect) |
| 3652 | (setq for-effect nil)) | 3668 | (setq byte-compile--for-effect nil)) |
| 3653 | 3669 | ||
| 3654 | (byte-defop-compiler-1 inline byte-compile-progn) | 3670 | (byte-defop-compiler-1 inline byte-compile-progn) |
| 3655 | (byte-defop-compiler-1 progn) | 3671 | (byte-defop-compiler-1 progn) |
| @@ -3729,9 +3745,9 @@ that suppresses all warnings during execution of BODY." | |||
| 3729 | (byte-compile-bound-variables | 3745 | (byte-compile-bound-variables |
| 3730 | (append bound-list byte-compile-bound-variables))) | 3746 | (append bound-list byte-compile-bound-variables))) |
| 3731 | (unwind-protect | 3747 | (unwind-protect |
| 3732 | ;; If things not being bound at all is ok, so must them being obsolete. | 3748 | ;; If things not being bound at all is ok, so must them being |
| 3733 | ;; Note that we add to the existing lists since Tramp (ab)uses | 3749 | ;; obsolete. Note that we add to the existing lists since Tramp |
| 3734 | ;; this feature. | 3750 | ;; (ab)uses this feature. |
| 3735 | (let ((byte-compile-not-obsolete-vars | 3751 | (let ((byte-compile-not-obsolete-vars |
| 3736 | (append byte-compile-not-obsolete-vars bound-list)) | 3752 | (append byte-compile-not-obsolete-vars bound-list)) |
| 3737 | (byte-compile-not-obsolete-funcs | 3753 | (byte-compile-not-obsolete-funcs |
| @@ -3753,20 +3769,20 @@ that suppresses all warnings during execution of BODY." | |||
| 3753 | (if (null (nthcdr 3 form)) | 3769 | (if (null (nthcdr 3 form)) |
| 3754 | ;; No else-forms | 3770 | ;; No else-forms |
| 3755 | (progn | 3771 | (progn |
| 3756 | (byte-compile-goto-if nil for-effect donetag) | 3772 | (byte-compile-goto-if nil byte-compile--for-effect donetag) |
| 3757 | (byte-compile-maybe-guarded clause | 3773 | (byte-compile-maybe-guarded clause |
| 3758 | (byte-compile-form (nth 2 form) for-effect)) | 3774 | (byte-compile-form (nth 2 form) byte-compile--for-effect)) |
| 3759 | (byte-compile-out-tag donetag)) | 3775 | (byte-compile-out-tag donetag)) |
| 3760 | (let ((elsetag (byte-compile-make-tag))) | 3776 | (let ((elsetag (byte-compile-make-tag))) |
| 3761 | (byte-compile-goto 'byte-goto-if-nil elsetag) | 3777 | (byte-compile-goto 'byte-goto-if-nil elsetag) |
| 3762 | (byte-compile-maybe-guarded clause | 3778 | (byte-compile-maybe-guarded clause |
| 3763 | (byte-compile-form (nth 2 form) for-effect)) | 3779 | (byte-compile-form (nth 2 form) byte-compile--for-effect)) |
| 3764 | (byte-compile-goto 'byte-goto donetag) | 3780 | (byte-compile-goto 'byte-goto donetag) |
| 3765 | (byte-compile-out-tag elsetag) | 3781 | (byte-compile-out-tag elsetag) |
| 3766 | (byte-compile-maybe-guarded (list 'not clause) | 3782 | (byte-compile-maybe-guarded (list 'not clause) |
| 3767 | (byte-compile-body (cdr (cdr (cdr form))) for-effect)) | 3783 | (byte-compile-body (cdr (cdr (cdr form))) byte-compile--for-effect)) |
| 3768 | (byte-compile-out-tag donetag)))) | 3784 | (byte-compile-out-tag donetag)))) |
| 3769 | (setq for-effect nil)) | 3785 | (setq byte-compile--for-effect nil)) |
| 3770 | 3786 | ||
| 3771 | (defun byte-compile-cond (clauses) | 3787 | (defun byte-compile-cond (clauses) |
| 3772 | (let ((donetag (byte-compile-make-tag)) | 3788 | (let ((donetag (byte-compile-make-tag)) |
| @@ -3783,18 +3799,18 @@ that suppresses all warnings during execution of BODY." | |||
| 3783 | (byte-compile-form (car clause)) | 3799 | (byte-compile-form (car clause)) |
| 3784 | (if (null (cdr clause)) | 3800 | (if (null (cdr clause)) |
| 3785 | ;; First clause is a singleton. | 3801 | ;; First clause is a singleton. |
| 3786 | (byte-compile-goto-if t for-effect donetag) | 3802 | (byte-compile-goto-if t byte-compile--for-effect donetag) |
| 3787 | (setq nexttag (byte-compile-make-tag)) | 3803 | (setq nexttag (byte-compile-make-tag)) |
| 3788 | (byte-compile-goto 'byte-goto-if-nil nexttag) | 3804 | (byte-compile-goto 'byte-goto-if-nil nexttag) |
| 3789 | (byte-compile-maybe-guarded (car clause) | 3805 | (byte-compile-maybe-guarded (car clause) |
| 3790 | (byte-compile-body (cdr clause) for-effect)) | 3806 | (byte-compile-body (cdr clause) byte-compile--for-effect)) |
| 3791 | (byte-compile-goto 'byte-goto donetag) | 3807 | (byte-compile-goto 'byte-goto donetag) |
| 3792 | (byte-compile-out-tag nexttag))))) | 3808 | (byte-compile-out-tag nexttag))))) |
| 3793 | ;; Last clause | 3809 | ;; Last clause |
| 3794 | (let ((guard (car clause))) | 3810 | (let ((guard (car clause))) |
| 3795 | (and (cdr clause) (not (eq guard t)) | 3811 | (and (cdr clause) (not (eq guard t)) |
| 3796 | (progn (byte-compile-form guard) | 3812 | (progn (byte-compile-form guard) |
| 3797 | (byte-compile-goto-if nil for-effect donetag) | 3813 | (byte-compile-goto-if nil byte-compile--for-effect donetag) |
| 3798 | (setq clause (cdr clause)))) | 3814 | (setq clause (cdr clause)))) |
| 3799 | (byte-compile-maybe-guarded guard | 3815 | (byte-compile-maybe-guarded guard |
| 3800 | (byte-compile-body-do-effect clause))) | 3816 | (byte-compile-body-do-effect clause))) |
| @@ -3813,7 +3829,7 @@ that suppresses all warnings during execution of BODY." | |||
| 3813 | (if (cdr rest) | 3829 | (if (cdr rest) |
| 3814 | (progn | 3830 | (progn |
| 3815 | (byte-compile-form (car rest)) | 3831 | (byte-compile-form (car rest)) |
| 3816 | (byte-compile-goto-if nil for-effect failtag) | 3832 | (byte-compile-goto-if nil byte-compile--for-effect failtag) |
| 3817 | (byte-compile-maybe-guarded (car rest) | 3833 | (byte-compile-maybe-guarded (car rest) |
| 3818 | (byte-compile-and-recursion (cdr rest) failtag))) | 3834 | (byte-compile-and-recursion (cdr rest) failtag))) |
| 3819 | (byte-compile-form-do-effect (car rest)) | 3835 | (byte-compile-form-do-effect (car rest)) |
| @@ -3832,7 +3848,7 @@ that suppresses all warnings during execution of BODY." | |||
| 3832 | (if (cdr rest) | 3848 | (if (cdr rest) |
| 3833 | (progn | 3849 | (progn |
| 3834 | (byte-compile-form (car rest)) | 3850 | (byte-compile-form (car rest)) |
| 3835 | (byte-compile-goto-if t for-effect wintag) | 3851 | (byte-compile-goto-if t byte-compile--for-effect wintag) |
| 3836 | (byte-compile-maybe-guarded (list 'not (car rest)) | 3852 | (byte-compile-maybe-guarded (list 'not (car rest)) |
| 3837 | (byte-compile-or-recursion (cdr rest) wintag))) | 3853 | (byte-compile-or-recursion (cdr rest) wintag))) |
| 3838 | (byte-compile-form-do-effect (car rest)) | 3854 | (byte-compile-form-do-effect (car rest)) |
| @@ -3843,11 +3859,11 @@ that suppresses all warnings during execution of BODY." | |||
| 3843 | (looptag (byte-compile-make-tag))) | 3859 | (looptag (byte-compile-make-tag))) |
| 3844 | (byte-compile-out-tag looptag) | 3860 | (byte-compile-out-tag looptag) |
| 3845 | (byte-compile-form (car (cdr form))) | 3861 | (byte-compile-form (car (cdr form))) |
| 3846 | (byte-compile-goto-if nil for-effect endtag) | 3862 | (byte-compile-goto-if nil byte-compile--for-effect endtag) |
| 3847 | (byte-compile-body (cdr (cdr form)) t) | 3863 | (byte-compile-body (cdr (cdr form)) t) |
| 3848 | (byte-compile-goto 'byte-goto looptag) | 3864 | (byte-compile-goto 'byte-goto looptag) |
| 3849 | (byte-compile-out-tag endtag) | 3865 | (byte-compile-out-tag endtag) |
| 3850 | (setq for-effect nil))) | 3866 | (setq byte-compile--for-effect nil))) |
| 3851 | 3867 | ||
| 3852 | (defun byte-compile-funcall (form) | 3868 | (defun byte-compile-funcall (form) |
| 3853 | (mapc 'byte-compile-form (cdr form)) | 3869 | (mapc 'byte-compile-form (cdr form)) |
| @@ -4008,7 +4024,7 @@ binding slots have been popped." | |||
| 4008 | (byte-compile-form `(list 'funcall ,f))) | 4024 | (byte-compile-form `(list 'funcall ,f))) |
| 4009 | (body | 4025 | (body |
| 4010 | (byte-compile-push-constant | 4026 | (byte-compile-push-constant |
| 4011 | (byte-compile-top-level (cons 'progn body) for-effect)))) | 4027 | (byte-compile-top-level (cons 'progn body) byte-compile--for-effect)))) |
| 4012 | (byte-compile-out 'byte-catch 0)) | 4028 | (byte-compile-out 'byte-catch 0)) |
| 4013 | 4029 | ||
| 4014 | (defun byte-compile-unwind-protect (form) | 4030 | (defun byte-compile-unwind-protect (form) |
| @@ -4044,7 +4060,7 @@ binding slots have been popped." | |||
| 4044 | (if fun-bodies | 4060 | (if fun-bodies |
| 4045 | (byte-compile-form `(list 'funcall ,(nth 2 form))) | 4061 | (byte-compile-form `(list 'funcall ,(nth 2 form))) |
| 4046 | (byte-compile-push-constant | 4062 | (byte-compile-push-constant |
| 4047 | (byte-compile-top-level (nth 2 form) for-effect))) | 4063 | (byte-compile-top-level (nth 2 form) byte-compile--for-effect))) |
| 4048 | (let ((compiled-clauses | 4064 | (let ((compiled-clauses |
| 4049 | (mapcar | 4065 | (mapcar |
| 4050 | (lambda (clause) | 4066 | (lambda (clause) |
| @@ -4072,7 +4088,7 @@ binding slots have been popped." | |||
| 4072 | `(list ',condition (list 'funcall ,(cadr clause) ',var)) | 4088 | `(list ',condition (list 'funcall ,(cadr clause) ',var)) |
| 4073 | (cons condition | 4089 | (cons condition |
| 4074 | (byte-compile-top-level-body | 4090 | (byte-compile-top-level-body |
| 4075 | (cdr clause) for-effect))))) | 4091 | (cdr clause) byte-compile--for-effect))))) |
| 4076 | (cdr (cdr (cdr form)))))) | 4092 | (cdr (cdr (cdr form)))))) |
| 4077 | (if fun-bodies | 4093 | (if fun-bodies |
| 4078 | (byte-compile-form `(list ,@compiled-clauses)) | 4094 | (byte-compile-form `(list ,@compiled-clauses)) |
| @@ -4113,7 +4129,7 @@ binding slots have been popped." | |||
| 4113 | (byte-compile-set-symbol-position (car form)) | 4129 | (byte-compile-set-symbol-position (car form)) |
| 4114 | (byte-compile-set-symbol-position 'defun) | 4130 | (byte-compile-set-symbol-position 'defun) |
| 4115 | (error "defun name must be a symbol, not %s" (car form))) | 4131 | (error "defun name must be a symbol, not %s" (car form))) |
| 4116 | (let ((for-effect nil)) | 4132 | (let ((byte-compile--for-effect nil)) |
| 4117 | (byte-compile-push-constant 'defalias) | 4133 | (byte-compile-push-constant 'defalias) |
| 4118 | (byte-compile-push-constant (nth 1 form)) | 4134 | (byte-compile-push-constant (nth 1 form)) |
| 4119 | (byte-compile-closure (cdr (cdr form)) t)) | 4135 | (byte-compile-closure (cdr (cdr form)) t)) |
| @@ -4410,22 +4426,22 @@ invoked interactively." | |||
| 4410 | (if byte-compile-call-tree-sort | 4426 | (if byte-compile-call-tree-sort |
| 4411 | (setq byte-compile-call-tree | 4427 | (setq byte-compile-call-tree |
| 4412 | (sort byte-compile-call-tree | 4428 | (sort byte-compile-call-tree |
| 4413 | (cond ((eq byte-compile-call-tree-sort 'callers) | 4429 | (case byte-compile-call-tree-sort |
| 4414 | (function (lambda (x y) (< (length (nth 1 x)) | 4430 | (callers |
| 4415 | (length (nth 1 y)))))) | 4431 | (lambda (x y) (< (length (nth 1 x)) |
| 4416 | ((eq byte-compile-call-tree-sort 'calls) | 4432 | (length (nth 1 y))))) |
| 4417 | (function (lambda (x y) (< (length (nth 2 x)) | 4433 | (calls |
| 4418 | (length (nth 2 y)))))) | 4434 | (lambda (x y) (< (length (nth 2 x)) |
| 4419 | ((eq byte-compile-call-tree-sort 'calls+callers) | 4435 | (length (nth 2 y))))) |
| 4420 | (function (lambda (x y) (< (+ (length (nth 1 x)) | 4436 | (calls+callers |
| 4421 | (length (nth 2 x))) | 4437 | (lambda (x y) (< (+ (length (nth 1 x)) |
| 4422 | (+ (length (nth 1 y)) | 4438 | (length (nth 2 x))) |
| 4423 | (length (nth 2 y))))))) | 4439 | (+ (length (nth 1 y)) |
| 4424 | ((eq byte-compile-call-tree-sort 'name) | 4440 | (length (nth 2 y)))))) |
| 4425 | (function (lambda (x y) (string< (car x) | 4441 | (name |
| 4426 | (car y))))) | 4442 | (lambda (x y) (string< (car x) (car y)))) |
| 4427 | (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" | 4443 | (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" |
| 4428 | byte-compile-call-tree-sort)))))) | 4444 | byte-compile-call-tree-sort)))))) |
| 4429 | (message "Generating call tree...") | 4445 | (message "Generating call tree...") |
| 4430 | (let ((rest byte-compile-call-tree) | 4446 | (let ((rest byte-compile-call-tree) |
| 4431 | (b (current-buffer)) | 4447 | (b (current-buffer)) |
| @@ -4533,7 +4549,8 @@ Each file is processed even if an error occurred previously. | |||
| 4533 | For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\". | 4549 | For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\". |
| 4534 | If NOFORCE is non-nil, don't recompile a file that seems to be | 4550 | If NOFORCE is non-nil, don't recompile a file that seems to be |
| 4535 | already up-to-date." | 4551 | already up-to-date." |
| 4536 | ;; command-line-args-left is what is left of the command line (from startup.el) | 4552 | ;; command-line-args-left is what is left of the command line, from |
| 4553 | ;; startup.el. | ||
| 4537 | (defvar command-line-args-left) ;Avoid 'free variable' warning | 4554 | (defvar command-line-args-left) ;Avoid 'free variable' warning |
| 4538 | (if (not noninteractive) | 4555 | (if (not noninteractive) |
| 4539 | (error "`batch-byte-compile' is to be used only with -batch")) | 4556 | (error "`batch-byte-compile' is to be used only with -batch")) |
| @@ -4558,7 +4575,8 @@ already up-to-date." | |||
| 4558 | ;; Specific file argument | 4575 | ;; Specific file argument |
| 4559 | (if (or (not noforce) | 4576 | (if (or (not noforce) |
| 4560 | (let* ((bytecomp-source (car command-line-args-left)) | 4577 | (let* ((bytecomp-source (car command-line-args-left)) |
| 4561 | (bytecomp-dest (byte-compile-dest-file bytecomp-source))) | 4578 | (bytecomp-dest (byte-compile-dest-file |
| 4579 | bytecomp-source))) | ||
| 4562 | (or (not (file-exists-p bytecomp-dest)) | 4580 | (or (not (file-exists-p bytecomp-dest)) |
| 4563 | (file-newer-than-file-p bytecomp-source bytecomp-dest)))) | 4581 | (file-newer-than-file-p bytecomp-source bytecomp-dest)))) |
| 4564 | (if (null (batch-byte-compile-file (car command-line-args-left))) | 4582 | (if (null (batch-byte-compile-file (car command-line-args-left))) |
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 5be84c15d89..2229be0de58 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el | |||
| @@ -67,7 +67,6 @@ | |||
| 67 | 67 | ||
| 68 | ;; TODO: | 68 | ;; TODO: |
| 69 | ;; - byte-optimize-form should be applied before cconv. | 69 | ;; - byte-optimize-form should be applied before cconv. |
| 70 | ;; - maybe unify byte-optimize and compiler-macros. | ||
| 71 | ;; - canonize code in macro-expand so we don't have to handle (let (var) body) | 70 | ;; - canonize code in macro-expand so we don't have to handle (let (var) body) |
| 72 | ;; and other oddities. | 71 | ;; and other oddities. |
| 73 | ;; - new byte codes for unwind-protect, catch, and condition-case so that | 72 | ;; - new byte codes for unwind-protect, catch, and condition-case so that |
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 55ca90597d1..f0a075ace37 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el | |||
| @@ -183,7 +183,9 @@ Assumes the caller has bound `macroexpand-all-environment'." | |||
| 183 | (cons (macroexpand-all-1 | 183 | (cons (macroexpand-all-1 |
| 184 | (list 'function f)) | 184 | (list 'function f)) |
| 185 | (macroexpand-all-forms args))))) | 185 | (macroexpand-all-forms args))))) |
| 186 | ;; Macro expand compiler macros. | 186 | ;; Macro expand compiler macros. This cannot be delayed to |
| 187 | ;; byte-optimize-form because the output of the compiler-macro can | ||
| 188 | ;; use macros. | ||
| 187 | ;; FIXME: Don't depend on CL. | 189 | ;; FIXME: Don't depend on CL. |
| 188 | (`(,(pred (lambda (fun) | 190 | (`(,(pred (lambda (fun) |
| 189 | (and (symbolp fun) | 191 | (and (symbolp fun) |
| @@ -191,7 +193,7 @@ Assumes the caller has bound `macroexpand-all-environment'." | |||
| 191 | 'cl-byte-compile-compiler-macro) | 193 | 'cl-byte-compile-compiler-macro) |
| 192 | (functionp 'compiler-macroexpand)))) | 194 | (functionp 'compiler-macroexpand)))) |
| 193 | . ,_) | 195 | . ,_) |
| 194 | (let ((newform (compiler-macroexpand form))) | 196 | (let ((newform (with-no-warnings (compiler-macroexpand form)))) |
| 195 | (if (eq form newform) | 197 | (if (eq form newform) |
| 196 | (macroexpand-all-forms form 1) | 198 | (macroexpand-all-forms form 1) |
| 197 | (macroexpand-all-1 newform)))) | 199 | (macroexpand-all-1 newform)))) |
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 0e3d54408fd..088410172e6 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in | |||
| @@ -66,6 +66,15 @@ AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \ | |||
| 66 | $(lisp)/cedet/semantic/loaddefs.el $(lisp)/cedet/ede/loaddefs.el \ | 66 | $(lisp)/cedet/semantic/loaddefs.el $(lisp)/cedet/ede/loaddefs.el \ |
| 67 | $(lisp)/cedet/srecode/loaddefs.el | 67 | $(lisp)/cedet/srecode/loaddefs.el |
| 68 | 68 | ||
| 69 | # Value of max-lisp-eval-depth when compiling initially. | ||
| 70 | # During bootstrapping the byte-compiler is run interpreted when compiling | ||
| 71 | # itself, and uses more stack than usual. | ||
| 72 | # | ||
| 73 | BIG_STACK_DEPTH = 1200 | ||
| 74 | BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" | ||
| 75 | |||
| 76 | BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) | ||
| 77 | |||
| 69 | # Files to compile before others during a bootstrap. This is done to | 78 | # Files to compile before others during a bootstrap. This is done to |
| 70 | # speed up the bootstrap process. The CC files are compiled first | 79 | # speed up the bootstrap process. The CC files are compiled first |
| 71 | # because CC mode tweaks the compilation process, and requiring | 80 | # because CC mode tweaks the compilation process, and requiring |
| @@ -75,6 +84,9 @@ AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \ | |||
| 75 | COMPILE_FIRST = \ | 84 | COMPILE_FIRST = \ |
| 76 | $(lisp)/emacs-lisp/byte-opt.el \ | 85 | $(lisp)/emacs-lisp/byte-opt.el \ |
| 77 | $(lisp)/emacs-lisp/bytecomp.el \ | 86 | $(lisp)/emacs-lisp/bytecomp.el \ |
| 87 | $(lisp)/emacs-lisp/pcase.elc \ | ||
| 88 | $(lisp)/emacs-lisp/macroexp.elc \ | ||
| 89 | $(lisp)/emacs-lisp/cconv.elc \ | ||
| 78 | $(lisp)/subr.el \ | 90 | $(lisp)/subr.el \ |
| 79 | $(lisp)/progmodes/cc-mode.el \ | 91 | $(lisp)/progmodes/cc-mode.el \ |
| 80 | $(lisp)/progmodes/cc-vars.el | 92 | $(lisp)/progmodes/cc-vars.el |
| @@ -287,7 +299,7 @@ TAGS-LISP-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsf | |||
| 287 | .SUFFIXES: .elc .el | 299 | .SUFFIXES: .elc .el |
| 288 | 300 | ||
| 289 | .el.elc: | 301 | .el.elc: |
| 290 | -$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $< | 302 | -$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< |
| 291 | 303 | ||
| 292 | # Compile all Lisp files, but don't recompile those that are up to | 304 | # Compile all Lisp files, but don't recompile those that are up to |
| 293 | # date. Some files don't actually get compiled because they set the | 305 | # date. Some files don't actually get compiled because they set the |
| @@ -307,22 +319,22 @@ compile: $(lisp)/subdirs.el mh-autoloads compile-$(SHELLTYPE) doit | |||
| 307 | compile-CMD: | 319 | compile-CMD: |
| 308 | # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g | 320 | # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g |
| 309 | for %%f in ($(COMPILE_FIRST)) do \ | 321 | for %%f in ($(COMPILE_FIRST)) do \ |
| 310 | $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done %%f | 322 | $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f |
| 311 | for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do \ | 323 | for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do \ |
| 312 | $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g | 324 | $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g |
| 313 | 325 | ||
| 314 | compile-SH: | 326 | compile-SH: |
| 315 | # for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done | 327 | # for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done |
| 316 | for el in $(COMPILE_FIRST); do \ | 328 | for el in $(COMPILE_FIRST); do \ |
| 317 | echo Compiling $$el; \ | 329 | echo Compiling $$el; \ |
| 318 | $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done $$el; \ | 330 | $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ |
| 319 | done | 331 | done |
| 320 | for dir in $(lisp) $(WINS); do \ | 332 | for dir in $(lisp) $(WINS); do \ |
| 321 | for el in $$dir/*.el; do \ | 333 | for el in $$dir/*.el; do \ |
| 322 | if test -f $$el; \ | 334 | if test -f $$el; \ |
| 323 | then \ | 335 | then \ |
| 324 | echo Compiling $$el; \ | 336 | echo Compiling $$el; \ |
| 325 | $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done $$el; \ | 337 | $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ |
| 326 | fi \ | 338 | fi \ |
| 327 | done; \ | 339 | done; \ |
| 328 | done | 340 | done |
| @@ -335,31 +347,31 @@ compile-always: $(lisp)/subdirs.el compile-always-$(SHELLTYPE) doit | |||
| 335 | 347 | ||
| 336 | compile-always-CMD: | 348 | compile-always-CMD: |
| 337 | # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g | 349 | # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g |
| 338 | for %%f in ($(COMPILE_FIRST)) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f | 350 | for %%f in ($(COMPILE_FIRST)) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f |
| 339 | for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f/%%g | 351 | for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f/%%g |
| 340 | 352 | ||
| 341 | compile-always-SH: | 353 | compile-always-SH: |
| 342 | # for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done | 354 | # for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done |
| 343 | for el in $(COMPILE_FIRST); do \ | 355 | for el in $(COMPILE_FIRST); do \ |
| 344 | echo Compiling $$el; \ | 356 | echo Compiling $$el; \ |
| 345 | $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ | 357 | $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ |
| 346 | done | 358 | done |
| 347 | for dir in $(lisp) $(WINS); do \ | 359 | for dir in $(lisp) $(WINS); do \ |
| 348 | for el in $$dir/*.el; do \ | 360 | for el in $$dir/*.el; do \ |
| 349 | echo Compiling $$el; \ | 361 | echo Compiling $$el; \ |
| 350 | $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ | 362 | $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ |
| 351 | done; \ | 363 | done; \ |
| 352 | done | 364 | done |
| 353 | 365 | ||
| 354 | compile-calc: compile-calc-$(SHELLTYPE) | 366 | compile-calc: compile-calc-$(SHELLTYPE) |
| 355 | 367 | ||
| 356 | compile-calc-CMD: | 368 | compile-calc-CMD: |
| 357 | for %%f in ($(lisp)/calc/*.el) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f | 369 | for %%f in ($(lisp)/calc/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f |
| 358 | 370 | ||
| 359 | compile-calc-SH: | 371 | compile-calc-SH: |
| 360 | for el in $(lisp)/calc/*.el; do \ | 372 | for el in $(lisp)/calc/*.el; do \ |
| 361 | echo Compiling $$el; \ | 373 | echo Compiling $$el; \ |
| 362 | $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ | 374 | $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ |
| 363 | done | 375 | done |
| 364 | 376 | ||
| 365 | # Backup compiled Lisp files in elc.tar.gz. If that file already | 377 | # Backup compiled Lisp files in elc.tar.gz. If that file already |
diff --git a/lisp/simple.el b/lisp/simple.el index f84812570bf..7a191f0cc9a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -28,8 +28,7 @@ | |||
| 28 | 28 | ||
| 29 | ;;; Code: | 29 | ;;; Code: |
| 30 | 30 | ||
| 31 | ;; This is for lexical-let in apply-partially. | 31 | (eval-when-compile (require 'cl)) ;For define-minor-mode. |
| 32 | (eval-when-compile (require 'cl)) | ||
| 33 | 32 | ||
| 34 | (declare-function widget-convert "wid-edit" (type &rest args)) | 33 | (declare-function widget-convert "wid-edit" (type &rest args)) |
| 35 | (declare-function shell-mode "shell" ()) | 34 | (declare-function shell-mode "shell" ()) |
| @@ -6605,38 +6604,25 @@ saving the value of `buffer-invisibility-spec' and setting it to nil." | |||
| 6605 | buffer-invisibility-spec) | 6604 | buffer-invisibility-spec) |
| 6606 | (setq buffer-invisibility-spec nil))) | 6605 | (setq buffer-invisibility-spec nil))) |
| 6607 | 6606 | ||
| 6608 | ;; Partial application of functions (similar to "currying"). | ||
| 6609 | ;; This function is here rather than in subr.el because it uses CL. | ||
| 6610 | ;; (defalias 'apply-partially #'curry) | ||
| 6611 | (defun apply-partially (fun &rest args) | ||
| 6612 | "Return a function that is a partial application of FUN to ARGS. | ||
| 6613 | ARGS is a list of the first N arguments to pass to FUN. | ||
| 6614 | The result is a new function which does the same as FUN, except that | ||
| 6615 | the first N arguments are fixed at the values with which this function | ||
| 6616 | was called." | ||
| 6617 | (lexical-let ((fun fun) (args1 args)) | ||
| 6618 | (lambda (&rest args2) (apply fun (append args1 args2))))) | ||
| 6619 | |||
| 6620 | ;; Minibuffer prompt stuff. | 6607 | ;; Minibuffer prompt stuff. |
| 6621 | 6608 | ||
| 6622 | ;(defun minibuffer-prompt-modification (start end) | 6609 | ;;(defun minibuffer-prompt-modification (start end) |
| 6623 | ; (error "You cannot modify the prompt")) | 6610 | ;; (error "You cannot modify the prompt")) |
| 6624 | ; | 6611 | ;; |
| 6625 | ; | 6612 | ;; |
| 6626 | ;(defun minibuffer-prompt-insertion (start end) | 6613 | ;;(defun minibuffer-prompt-insertion (start end) |
| 6627 | ; (let ((inhibit-modification-hooks t)) | 6614 | ;; (let ((inhibit-modification-hooks t)) |
| 6628 | ; (delete-region start end) | 6615 | ;; (delete-region start end) |
| 6629 | ; ;; Discard undo information for the text insertion itself | 6616 | ;; ;; Discard undo information for the text insertion itself |
| 6630 | ; ;; and for the text deletion.above. | 6617 | ;; ;; and for the text deletion.above. |
| 6631 | ; (when (consp buffer-undo-list) | 6618 | ;; (when (consp buffer-undo-list) |
| 6632 | ; (setq buffer-undo-list (cddr buffer-undo-list))) | 6619 | ;; (setq buffer-undo-list (cddr buffer-undo-list))) |
| 6633 | ; (message "You cannot modify the prompt"))) | 6620 | ;; (message "You cannot modify the prompt"))) |
| 6634 | ; | 6621 | ;; |
| 6635 | ; | 6622 | ;; |
| 6636 | ;(setq minibuffer-prompt-properties | 6623 | ;;(setq minibuffer-prompt-properties |
| 6637 | ; (list 'modification-hooks '(minibuffer-prompt-modification) | 6624 | ;; (list 'modification-hooks '(minibuffer-prompt-modification) |
| 6638 | ; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) | 6625 | ;; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) |
| 6639 | ; | ||
| 6640 | 6626 | ||
| 6641 | 6627 | ||
| 6642 | ;;;; Problematic external packages. | 6628 | ;;;; Problematic external packages. |
diff --git a/lisp/subr.el b/lisp/subr.el index b6f095136ff..5faaa2130a2 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -116,6 +116,17 @@ BODY should be a list of Lisp expressions. | |||
| 116 | ;; depend on backquote.el. | 116 | ;; depend on backquote.el. |
| 117 | (list 'function (cons 'lambda cdr))) | 117 | (list 'function (cons 'lambda cdr))) |
| 118 | 118 | ||
| 119 | ;; Partial application of functions (similar to "currying"). | ||
| 120 | ;; This function is here rather than in subr.el because it uses CL. | ||
| 121 | (defun apply-partially (fun &rest args) | ||
| 122 | "Return a function that is a partial application of FUN to ARGS. | ||
| 123 | ARGS is a list of the first N arguments to pass to FUN. | ||
| 124 | The result is a new function which does the same as FUN, except that | ||
| 125 | the first N arguments are fixed at the values with which this function | ||
| 126 | was called." | ||
| 127 | `(closure () lambda (&rest args) | ||
| 128 | (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) | ||
| 129 | |||
| 119 | (if (null (featurep 'cl)) | 130 | (if (null (featurep 'cl)) |
| 120 | (progn | 131 | (progn |
| 121 | ;; If we reload subr.el after having loaded CL, be careful not to | 132 | ;; If we reload subr.el after having loaded CL, be careful not to |
| @@ -1675,6 +1686,8 @@ This function makes or adds to an entry on `after-load-alist'." | |||
| 1675 | (unless elt | 1686 | (unless elt |
| 1676 | (setq elt (list regexp-or-feature)) | 1687 | (setq elt (list regexp-or-feature)) |
| 1677 | (push elt after-load-alist)) | 1688 | (push elt after-load-alist)) |
| 1689 | ;; Make sure `form' is evalled in the current lexical/dynamic code. | ||
| 1690 | (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding))) | ||
| 1678 | (when (symbolp regexp-or-feature) | 1691 | (when (symbolp regexp-or-feature) |
| 1679 | ;; For features, the after-load-alist elements get run when `provide' is | 1692 | ;; For features, the after-load-alist elements get run when `provide' is |
| 1680 | ;; called rather than at the end of the file. So add an indirection to | 1693 | ;; called rather than at the end of the file. So add an indirection to |