aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-03-11 22:32:43 -0500
committerStefan Monnier2011-03-11 22:32:43 -0500
commit2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942 (patch)
treedcfa222d39bd995e82374f077faa49247de6676e
parentba83908c4b7fda12991ae9073028a60da87c1fa2 (diff)
downloademacs-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/ChangeLog26
-rw-r--r--lisp/Makefile.in11
-rw-r--r--lisp/emacs-lisp/byte-opt.el33
-rw-r--r--lisp/emacs-lisp/bytecomp.el298
-rw-r--r--lisp/emacs-lisp/cconv.el1
-rw-r--r--lisp/emacs-lisp/macroexp.el6
-rw-r--r--lisp/makefile.w32-in34
-rw-r--r--lisp/simple.el50
-rw-r--r--lisp/subr.el13
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 @@
12011-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
12011-03-11 Stefan Monnier <monnier@iro.umontreal.ca> 272011-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 \
77BIG_STACK_DEPTH = 1200 77BIG_STACK_DEPTH = 1200
78BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" 78BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
79 79
80BYTE_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
291compile-calc: 293compile-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.
320recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc 322recompile: 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."
875Each function's symbol gets added to `byte-compile-noruntime-functions'." 873Each 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.
3354NUM defaults to 1.
3339If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were 3355If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were
3340popped before discarding the num values, and then pushed back again after 3356popped before discarding the num values, and then pushed back again after
3341discarding." 3357discarding."
@@ -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.
4533For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\". 4549For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
4534If NOFORCE is non-nil, don't recompile a file that seems to be 4550If NOFORCE is non-nil, don't recompile a file that seems to be
4535already up-to-date." 4551already 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#
73BIG_STACK_DEPTH = 1200
74BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
75
76BYTE_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 \
75COMPILE_FIRST = \ 84COMPILE_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
307compile-CMD: 319compile-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
314compile-SH: 326compile-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
336compile-always-CMD: 348compile-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
341compile-always-SH: 353compile-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
354compile-calc: compile-calc-$(SHELLTYPE) 366compile-calc: compile-calc-$(SHELLTYPE)
355 367
356compile-calc-CMD: 368compile-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
359compile-calc-SH: 371compile-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.
6613ARGS is a list of the first N arguments to pass to FUN.
6614The result is a new function which does the same as FUN, except that
6615the first N arguments are fixed at the values with which this function
6616was 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.
123ARGS is a list of the first N arguments to pass to FUN.
124The result is a new function which does the same as FUN, except that
125the first N arguments are fixed at the values with which this function
126was 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