]> git.eshelyaron.com Git - emacs.git/commitdiff
Try and fix w32 build; misc cleanup.
authorStefan Monnier <monnier@iro.umontreal.ca>
Sat, 12 Mar 2011 03:32:43 +0000 (22:32 -0500)
committerStefan Monnier <monnier@iro.umontreal.ca>
Sat, 12 Mar 2011 03:32:43 +0000 (22:32 -0500)
* 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.

lisp/ChangeLog
lisp/Makefile.in
lisp/emacs-lisp/byte-opt.el
lisp/emacs-lisp/bytecomp.el
lisp/emacs-lisp/cconv.el
lisp/emacs-lisp/macroexp.el
lisp/makefile.w32-in
lisp/simple.el
lisp/subr.el

index 0b432eb46d9785163fdf7be0dbae24495e942dd5..01571b801243bce030f43e66941b64e69218284b 100644 (file)
@@ -1,3 +1,29 @@
+2011-03-12  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * subr.el (apply-partially): Move from subr.el; don't use lexical-let.
+       (eval-after-load): Obey lexical-binding.
+       * simple.el (apply-partially): Move to subr.el.
+       * 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.
+       * emacs-lisp/macroexp.el (macroexpand-all-1): Silence warning about
+       calling CL's `compiler-macroexpand'.
+       * 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.
+       * 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.
+       * Makefile.in (BYTE_COMPILE_FLAGS): New var.
+       (compile-onefile, .el.elc, compile-calc, recompile): Use it.
+
 2011-03-11  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * subr.el (letrec): New macro.
index 268a45d89483b5ca7fdfb57798ed7d3ef0646d6e..4db5ef4f0085b8a89187bdb86ee28bbc7f600243 100644 (file)
@@ -77,6 +77,8 @@ AUTOGENEL = loaddefs.el \
 BIG_STACK_DEPTH = 1200
 BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
 
+BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
+
 # Files to compile before others during a bootstrap.  This is done to
 # speed up the bootstrap process.
 
@@ -205,7 +207,7 @@ compile-onefile:
        @echo Compiling $(THEFILE)
        @# Use byte-compile-refresh-preloaded to try and work around some of
        @# the most common bootstrapping problems.
-       @$(emacs) $(BIG_STACK_OPTS) -l bytecomp $(BYTE_COMPILE_EXTRA_FLAGS) \
+       @$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \
                -f byte-compile-refresh-preloaded \
                -f batch-byte-compile $(THEFILE)
 
@@ -225,7 +227,7 @@ compile-onefile:
        @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler
        @# files, which is normally done in compile-first, but may also be
        @# recompiled via this rule.
-       @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
+       @$(emacs) $(BYTE_COMPILE_FLAGS) \
                -f batch-byte-compile $<
 
 .PHONY: compile-first compile-main compile compile-always
@@ -291,7 +293,7 @@ compile-always: doit
 compile-calc:
        for el in $(lisp)/calc/*.el; do \
          echo Compiling $$el; \
-         $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \
+         $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
        done
 
 # Backup compiled Lisp files in elc.tar.gz.  If that file already
@@ -318,7 +320,8 @@ compile-after-backup: backup-compiled-files compile-always
 # since the environment of later files is affected by definitions in
 # earlier ones.
 recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc
-       $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp)
+       $(emacs) $(BYTE_COMPILE_FLAGS) \
+           --eval "(batch-byte-recompile-directory 0)" $(lisp)
 
 # Update MH-E internal autoloads. These are not to be confused with
 # the autoloads for the MH-E entry points, which are already in loaddefs.el.
index a4254bfeca1b55857d84f9f70f9a589e684334fe..b07d61ae0d19940fd60c0c3e9c29f2dbecc3d7a1 100644 (file)
 ;; ((lambda ...) ...)
 (defun byte-compile-unfold-lambda (form &optional name)
   ;; In lexical-binding mode, let and functions don't bind vars in the same way
-  ;; (let obey special-variable-p, but functions don't).  This doesn't matter
-  ;; here, because function's behavior is underspecified so it can safely be
-  ;; turned into a `let', even though the reverse is not true.
+  ;; (let obey special-variable-p, but functions don't).  But luckily, this
+  ;; doesn't matter here, because function's behavior is underspecified so it
+  ;; can safely be turned into a `let', even though the reverse is not true.
   (or name (setq name "anonymous lambda"))
   (let ((lambda (car form))
        (values (cdr form)))
 \f
 ;;; implementing source-level optimizers
 
-(defvar for-effect)
-
-(defun byte-optimize-form-code-walker (form for-effect-arg)
+(defun byte-optimize-form-code-walker (form for-effect)
   ;;
   ;; For normal function calls, We can just mapcar the optimizer the cdr.  But
   ;; we need to have special knowledge of the syntax of the special forms
   ;; the important aspect is that they are subrs that don't evaluate all of
   ;; their args.)
   ;;
-  (let ((for-effect for-effect-arg)
-        (fn (car-safe form))
+  (let ((fn (car-safe form))
        tmp)
     (cond ((not (consp form))
           (if (not (and for-effect
                (byte-optimize-form (nth 2 form) for-effect)
                (byte-optimize-body (nthcdr 3 form) for-effect)))))
 
-         ((memq fn '(and or))  ; remember, and/or are control structures.
-          ;; take forms off the back until we can't any more.
+         ((memq fn '(and or))  ; Remember, and/or are control structures.
+          ;; Take forms off the back until we can't any more.
           ;; In the future it could conceivably be a problem that the
           ;; subexpressions of these forms are optimized in the reverse
           ;; order, but it's ok for now.
                     (byte-compile-log
                      "  all subforms of %s called for effect; deleted" form))
                 (and backwards
-                     (cons fn (nreverse (mapcar 'byte-optimize-form backwards)))))
+                     (cons fn (nreverse (mapcar 'byte-optimize-form
+                                                 backwards)))))
             (cons fn (mapcar 'byte-optimize-form (cdr form)))))
 
          ((eq fn 'interactive)
           ;; However, don't actually bother calling `ignore'.
           `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
 
-          ((eq fn 'internal-make-closure)
-           form)
+          ;; Neeeded as long as we run byte-optimize-form after cconv.
+          ((eq fn 'internal-make-closure) form)
           
          ((not (symbolp fn))
            (debug)
       (setq list (cdr list)))
     constant))
 
-(defun byte-optimize-form (form &optional for-effect-arg)
+(defun byte-optimize-form (form &optional for-effect)
   "The source-level pass of the optimizer."
   ;;
   ;; First, optimize all sub-forms of this one.
-  (setq form (byte-optimize-form-code-walker form for-effect-arg))
+  (setq form (byte-optimize-form-code-walker form for-effect))
   ;;
   ;; after optimizing all subforms, optimize this form until it doesn't
   ;; optimize any further.  This means that some forms will be passed through
   ;; the optimizer many times, but that's necessary to make the for-effect
   ;; processing do as much as possible.
   ;;
-  (let ((for-effect for-effect-arg)
-        opt new)
+  (let (opt new)
     (if (and (consp form)
             (symbolp (car form))
             (or (and for-effect
 
 
 (defun byte-optimize-body (forms all-for-effect)
-  ;; optimize the cdr of a progn or implicit progn; all forms is a list of
+  ;; Optimize the cdr of a progn or implicit progn; all forms is a list of
   ;; forms, all but the last of which are optimized with the assumption that
   ;; they are being called for effect.  the last is for-effect as well if
   ;; all-for-effect is true.  returns a new list of forms.
index c661e6bea7a3c64704ca6e0f89fe8bc160ac72dd..729d91eb1c537dd90893d5614dd61241a04a0c40 100644 (file)
@@ -33,8 +33,7 @@
 
 ;;; Code:
 
-;; FIXME: Use lexical-binding and get rid of the atrocious "bytecomp-"
-;; variable prefix.
+;; FIXME: get rid of the atrocious "bytecomp-" variable prefix.
 
 ;; ========================================================================
 ;; Entry points:
@@ -432,12 +431,9 @@ This list lives partly on the stack.")
     (eval-when-compile . (lambda (&rest body)
                           (list
                            'quote
-                            ;; FIXME: is that right in lexbind code?
                            (byte-compile-eval
                              (byte-compile-top-level
-                              (macroexpand-all
-                               (cons 'progn body)
-                               byte-compile-initial-macro-environment))))))
+                              (byte-compile-preprocess (cons 'progn body)))))))
     (eval-and-compile . (lambda (&rest body)
                          (byte-compile-eval-before-compile (cons 'progn body))
                          (cons 'progn body))))
@@ -692,7 +688,7 @@ otherwise pop it")
 ;; if (following one byte & 0x80) == 0
 ;;    discard (following one byte & 0x7F) stack entries
 ;; else
-;;    discard (following one byte & 0x7F) stack entries _underneath_ the top of stack
+;;    discard (following one byte & 0x7F) stack entries _underneath_ TOS
 ;;    (that is, if the operand = 0x83,  ... X Y Z T  =>  ... T)
 (byte-defop 182 nil byte-discardN)
 ;; `byte-discardN-preserve-tos' is a pseudo-op that gets turned into
@@ -829,9 +825,11 @@ CONST2 may be evaulated multiple times."
                ;; too large to fit in 7 bits, the opcode can be repeated.
                (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0)))
                  (while (> off #x7f)
-                   (byte-compile-push-bytecodes opcode (logior #x7f flag) bytes pc)
+                   (byte-compile-push-bytecodes opcode (logior #x7f flag)
+                                                bytes pc)
                    (setq off (- off #x7f)))
-                 (byte-compile-push-bytecodes opcode (logior off flag) bytes pc)))
+                 (byte-compile-push-bytecodes opcode (logior off flag)
+                                              bytes pc)))
               ((null off)
                ;; opcode that doesn't use OFF
                (byte-compile-push-bytecodes opcode bytes pc))
@@ -875,7 +873,7 @@ CONST2 may be evaulated multiple times."
 Each function's symbol gets added to `byte-compile-noruntime-functions'."
   (let ((hist-orig load-history)
        (hist-nil-orig current-load-list))
-    (prog1 (eval form)
+    (prog1 (eval form lexical-binding)
       (when (byte-compile-warning-enabled-p 'noruntime)
        (let ((hist-new load-history)
              (hist-nil-new current-load-list))
@@ -927,7 +925,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 (defun byte-compile-eval-before-compile (form)
   "Evaluate FORM for `eval-and-compile'."
   (let ((hist-nil-orig current-load-list))
-    (prog1 (eval form)
+    (prog1 (eval form lexical-binding)
       ;; (eval-and-compile (require 'cl) turns off warnings for cl functions.
       ;; FIXME Why does it do that - just as a hack?
       ;; There are other ways to do this nowadays.
@@ -1018,7 +1016,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
                       read-symbol-positions-list
                       (byte-compile-delete-first
                        entry read-symbol-positions-list)))
-              (or (and allow-previous (not (= last byte-compile-last-position)))
+              (or (and allow-previous
+                        (not (= last byte-compile-last-position)))
                   (> last byte-compile-last-position)))))))
 
 (defvar byte-compile-last-warned-form nil)
@@ -1030,7 +1029,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
   (let* ((inhibit-read-only t)
         (dir default-directory)
         (file (cond ((stringp byte-compile-current-file)
-                     (format "%s:" (file-relative-name byte-compile-current-file dir)))
+                     (format "%s:" (file-relative-name
+                                     byte-compile-current-file dir)))
                     ((bufferp byte-compile-current-file)
                      (format "Buffer %s:"
                              (buffer-name byte-compile-current-file)))
@@ -1093,13 +1093,15 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
               (insert "\f\nCompiling "
                       (if (stringp byte-compile-current-file)
                           (concat "file " byte-compile-current-file)
-                        (concat "buffer " (buffer-name byte-compile-current-file)))
+                        (concat "buffer "
+                                 (buffer-name byte-compile-current-file)))
                       " at " (current-time-string) "\n")
             (insert "\f\nCompiling no file at " (current-time-string) "\n"))
           (when dir
             (setq default-directory dir)
             (unless was-same
-              (insert (format "Entering directory `%s'\n" default-directory))))
+              (insert (format "Entering directory `%s'\n"
+                               default-directory))))
           (setq byte-compile-last-logged-file byte-compile-current-file
                 byte-compile-last-warned-form nil)
           ;; Do this after setting default-directory.
@@ -1325,7 +1327,7 @@ extra args."
                         (custom-declare-variable . defcustom))))
            (cadr name)))
       ;; Update the current group, if needed.
-      (if (and byte-compile-current-file ;Only when byte-compiling a whole file.
+      (if (and byte-compile-current-file ;Only when compiling a whole file.
                (eq (car form) 'custom-declare-group)
                (eq (car-safe name) 'quote))
           (setq byte-compile-current-group (cadr name))))))
@@ -1873,7 +1875,8 @@ With argument ARG, insert value in current buffer after the form."
                   (let ((read-with-symbol-positions (current-buffer))
                         (read-symbol-positions-list nil))
                     (displaying-byte-compile-warnings
-                     (byte-compile-sexp (read (current-buffer))))))))
+                     (byte-compile-sexp (read (current-buffer)))))
+                   lexical-binding)))
       (cond (arg
             (message "Compiling from buffer... done.")
             (prin1 value (current-buffer))
@@ -2072,7 +2075,7 @@ Call from the source buffer."
       nil)))
 
 (defvar print-gensym-alist)            ;Used before print-circle existed.
-(defvar for-effect)
+(defvar byte-compile--for-effect)
 
 (defun byte-compile-output-docform (preface name info form specindex quoted)
   "Print a form with a doc string.  INFO is (prefix doc-index postfix).
@@ -2147,8 +2150,10 @@ list that represents a doc string reference.
                           (byte-compile-output-as-comment
                            (cons (car form) (nth 1 form))
                            t)))
-                     (setq position (- (position-bytes position) (point-min) -1))
-                     (princ (format "(#$ . %d) nil" position) bytecomp-outbuffer)
+                     (setq position (- (position-bytes position)
+                                       (point-min) -1))
+                     (princ (format "(#$ . %d) nil" position)
+                            bytecomp-outbuffer)
                      (setq form (cdr form))
                      (setq index (1+ index))))
                   ((= index (nth 1 info))
@@ -2170,14 +2175,14 @@ list that represents a doc string reference.
   (if (memq byte-optimize '(t source))
       (setq form (byte-optimize-form form t)))
   (if bytecomp-handler
-      (let ((for-effect t))
+      (let ((byte-compile--for-effect t))
        ;; To avoid consing up monstrously large forms at load time, we split
        ;; the output regularly.
        (and (memq (car-safe form) '(fset defalias))
             (nthcdr 300 byte-compile-output)
             (byte-compile-flush-pending))
        (funcall bytecomp-handler form)
-       (if for-effect
+       (if byte-compile--for-effect
            (byte-compile-discard)))
     (byte-compile-form form t))
   nil)
@@ -2195,13 +2200,22 @@ list that represents a doc string reference.
              byte-compile-maxdepth 0
              byte-compile-output nil))))
 
+(defun byte-compile-preprocess (form &optional _for-effect)
+  (setq form (macroexpand-all form byte-compile-macro-environment))
+  ;; FIXME: We should run byte-optimize-form here, but it currently does not
+  ;; recurse through all the code, so we'd have to fix this first.
+  ;; Maybe a good fix would be to merge byte-optimize-form into
+  ;; macroexpand-all.
+  ;; (if (memq byte-optimize '(t source))
+  ;;     (setq form (byte-optimize-form form for-effect)))
+  (if lexical-binding
+      (cconv-closure-convert form)
+    form))
+
 ;; byte-hunk-handlers cannot call this!
 (defun byte-compile-toplevel-file-form (form)
   (let ((byte-compile-current-form nil))       ; close over this for warnings.
-    (setq form (macroexpand-all form byte-compile-macro-environment))
-    (if lexical-binding
-        (setq form (cconv-closure-convert form)))
-    (byte-compile-file-form form)))
+    (byte-compile-file-form (byte-compile-preprocess form t))))
 
 ;; byte-hunk-handlers can call this.
 (defun byte-compile-file-form (form)
@@ -2272,7 +2286,8 @@ list that represents a doc string reference.
                   (byte-compile-top-level (nth 2 form) nil 'file))))
     form))
 
-(put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table)
+(put 'define-abbrev-table 'byte-hunk-handler
+     'byte-compile-file-form-define-abbrev-table)
 (defun byte-compile-file-form-define-abbrev-table (form)
   (if (eq 'quote (car-safe (car-safe (cdr form))))
       (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."
          (setq fun (cdr fun)))
       (cond ((eq (car-safe fun) 'lambda)
             ;; Expand macros.
-             (setq fun
-                   (macroexpand-all fun
-                                    byte-compile-initial-macro-environment))
-             (if lexical-binding
-                 (setq fun (cconv-closure-convert fun)))
+             (setq fun (byte-compile-preprocess fun))
             ;; Get rid of the `function' quote added by the `lambda' macro.
             (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
             (setq fun (if macro
@@ -2560,7 +2571,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   "Compile and return SEXP."
   (displaying-byte-compile-warnings
    (byte-compile-close-variables
-    (byte-compile-top-level sexp))))
+    (byte-compile-top-level (byte-compile-preprocess sexp)))))
 
 ;; Given a function made by byte-compile-lambda, make a form which produces it.
 (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."
 
 ;; Given an expression FORM, compile it and return an equivalent byte-code
 ;; expression (a call to the function byte-code).
-(defun byte-compile-top-level (form &optional for-effect-arg output-type
+(defun byte-compile-top-level (form &optional for-effect output-type
                                     lexenv reserved-csts)
   ;; OUTPUT-TYPE advises about how form is expected to be used:
   ;;   'eval or nil    -> a single form,
   ;;   'progn or t     -> a list of forms,
   ;;   'lambda         -> body of a lambda,
   ;;   'file           -> used at file-level.
-  (let ((for-effect for-effect-arg)
+  (let ((byte-compile--for-effect for-effect)
         (byte-compile-constants nil)
        (byte-compile-variables nil)
        (byte-compile-tag-number 0)
@@ -2832,7 +2843,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
         (byte-compile-reserved-constants (or reserved-csts 0))
        (byte-compile-output nil))
     (if (memq byte-optimize '(t source))
-       (setq form (byte-optimize-form form for-effect)))
+       (setq form (byte-optimize-form form byte-compile--for-effect)))
     (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
       (setq form (nth 1 form)))
     (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."
        (when (> byte-compile-depth 0)
          (byte-compile-out-tag (byte-compile-make-tag))))
       ;; Now compile FORM
-      (byte-compile-form form for-effect)
-      (byte-compile-out-toplevel for-effect output-type))))
+      (byte-compile-form form byte-compile--for-effect)
+      (byte-compile-out-toplevel byte-compile--for-effect output-type))))
 
-(defun byte-compile-out-toplevel (&optional for-effect-arg output-type)
-  (if for-effect-arg
+(defun byte-compile-out-toplevel (&optional for-effect output-type)
+  (if for-effect
       ;; The stack is empty. Push a value to be returned from (byte-code ..).
       (if (eq (car (car byte-compile-output)) 'byte-discard)
          (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."
   ;;   progn   -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
   ;;   file    -> as progn, but takes both quotes and atoms, and longer forms.
   (let (rest
-        (for-effect for-effect-arg)
+        (byte-compile--for-effect for-effect)
        (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
        tmp body)
     (cond
@@ -2902,34 +2913,35 @@ If FORM is a lambda or a macro, byte-compile it as a function."
          (progn
            (setq rest (nreverse
                        (cdr (memq tmp (reverse byte-compile-output)))))
-           (while (cond
-                   ((memq (car (car rest)) '(byte-varref byte-constant))
-                    (setq tmp (car (cdr (car rest))))
-                    (if (if (eq (car (car rest)) 'byte-constant)
-                            (or (consp tmp)
-                                (and (symbolp tmp)
-                                     (not (byte-compile-const-symbol-p tmp)))))
-                        (if maycall
-                            (setq body (cons (list 'quote tmp) body)))
-                      (setq body (cons tmp body))))
-                   ((and maycall
-                         ;; Allow a funcall if at most one atom follows it.
-                         (null (nthcdr 3 rest))
-                         (setq tmp (get (car (car rest)) 'byte-opcode-invert))
-                         (or (null (cdr rest))
-                             (and (memq output-type '(file progn t))
-                                  (cdr (cdr rest))
-                                  (eq (car (nth 1 rest)) 'byte-discard)
-                                  (progn (setq rest (cdr rest)) t))))
-                    (setq maycall nil) ; Only allow one real function call.
-                    (setq body (nreverse body))
-                    (setq body (list
-                                (if (and (eq tmp 'funcall)
-                                         (eq (car-safe (car body)) 'quote))
-                                    (cons (nth 1 (car body)) (cdr body))
-                                  (cons tmp body))))
-                    (or (eq output-type 'file)
-                        (not (delq nil (mapcar 'consp (cdr (car body))))))))
+           (while
+                (cond
+                 ((memq (car (car rest)) '(byte-varref byte-constant))
+                  (setq tmp (car (cdr (car rest))))
+                  (if (if (eq (car (car rest)) 'byte-constant)
+                          (or (consp tmp)
+                              (and (symbolp tmp)
+                                   (not (byte-compile-const-symbol-p tmp)))))
+                      (if maycall
+                          (setq body (cons (list 'quote tmp) body)))
+                    (setq body (cons tmp body))))
+                 ((and maycall
+                       ;; Allow a funcall if at most one atom follows it.
+                       (null (nthcdr 3 rest))
+                       (setq tmp (get (car (car rest)) 'byte-opcode-invert))
+                       (or (null (cdr rest))
+                           (and (memq output-type '(file progn t))
+                                (cdr (cdr rest))
+                                (eq (car (nth 1 rest)) 'byte-discard)
+                                (progn (setq rest (cdr rest)) t))))
+                  (setq maycall nil)   ; Only allow one real function call.
+                  (setq body (nreverse body))
+                  (setq body (list
+                              (if (and (eq tmp 'funcall)
+                                       (eq (car-safe (car body)) 'quote))
+                                  (cons (nth 1 (car body)) (cdr body))
+                                (cons tmp body))))
+                  (or (eq output-type 'file)
+                      (not (delq nil (mapcar 'consp (cdr (car body))))))))
              (setq rest (cdr rest)))
            rest))
       (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."
      ((car body)))))
 
 ;; Given BYTECOMP-BODY, compile it and return a new body.
-(defun byte-compile-top-level-body (bytecomp-body &optional for-effect-arg)
+(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
   (setq bytecomp-body
-       (byte-compile-top-level (cons 'progn bytecomp-body) for-effect-arg t))
+       (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
   (cond ((eq (car-safe bytecomp-body) 'progn)
         (cdr bytecomp-body))
        (bytecomp-body
@@ -2966,25 +2978,27 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; expression.
 ;; If for-effect is non-nil, byte-compile-form will output a byte-discard
 ;; before terminating (ie no value will be left on the stack).
-;; A byte-compile handler may, when for-effect is non-nil, choose output code
-;; which does not leave a value on the stack, and then set for-effect to nil
-;; (to prevent byte-compile-form from outputting the byte-discard).
+;; A byte-compile handler may, when byte-compile--for-effect is non-nil, choose
+;; output code which does not leave a value on the stack, and then set
+;; byte-compile--for-effect to nil (to prevent byte-compile-form from
+;; outputting the byte-discard).
 ;; If a handler wants to call another handler, it should do so via
-;; byte-compile-form, or take extreme care to handle for-effect correctly.
-;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
+;; byte-compile-form, or take extreme care to handle byte-compile--for-effect
+;; correctly.  (Use byte-compile-form-do-effect to reset the
+;; byte-compile--for-effect flag too.)
 ;;
-(defun byte-compile-form (form &optional for-effect-arg)
-  (let ((for-effect for-effect-arg))
+(defun byte-compile-form (form &optional for-effect)
+  (let ((byte-compile--for-effect for-effect))
     (cond
      ((not (consp form))
       (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
              (when (symbolp form)
                (byte-compile-set-symbol-position form))
              (byte-compile-constant form))
-            ((and for-effect byte-compile-delete-errors)
+            ((and byte-compile--for-effect byte-compile-delete-errors)
              (when (symbolp form)
                (byte-compile-set-symbol-position form))
-             (setq for-effect nil))
+             (setq byte-compile--for-effect nil))
             (t
              (byte-compile-variable-ref form))))
      ((symbolp (car form))
@@ -3018,10 +3032,10 @@ That command is designed for interactive use only" bytecomp-fn))
            ;; if the form comes out the same way it went in, that's
            ;; because it was malformed, and we couldn't unfold it.
            (not (eq form (setq form (byte-compile-unfold-lambda form)))))
-      (byte-compile-form form for-effect)
-      (setq for-effect nil))
+      (byte-compile-form form byte-compile--for-effect)
+      (setq byte-compile--for-effect nil))
      ((byte-compile-normal-call form)))
-    (if for-effect
+    (if byte-compile--for-effect
         (byte-compile-discard))))
 
 (defun byte-compile-normal-call (form)
@@ -3037,7 +3051,7 @@ That command is designed for interactive use only" bytecomp-fn))
     (byte-compile-callargs-warn form))
   (if byte-compile-generate-call-tree
       (byte-compile-annotate-call-tree form))
-  (when (and for-effect (eq (car form) 'mapcar)
+  (when (and byte-compile--for-effect (eq (car form) 'mapcar)
              (byte-compile-warning-enabled-p 'mapcar))
     (byte-compile-set-symbol-position 'mapcar)
     (byte-compile-warn
@@ -3119,18 +3133,19 @@ If BINDING is non-nil, VAR is being bound."
        (car (setq byte-compile-constants
                  (cons (list ,const) byte-compile-constants)))))
 
-;; Use this when the value of a form is a constant.  This obeys for-effect.
+;; Use this when the value of a form is a constant.
+;; This obeys byte-compile--for-effect.
 (defun byte-compile-constant (const)
-  (if for-effect
-      (setq for-effect nil)
+  (if byte-compile--for-effect
+      (setq byte-compile--for-effect nil)
     (when (symbolp const)
       (byte-compile-set-symbol-position const))
     (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
 
 ;; Use this for a constant that is not the value of its containing form.
-;; This ignores for-effect.
+;; This ignores byte-compile--for-effect.
 (defun byte-compile-push-constant (const)
-  (let ((for-effect nil))
+  (let ((byte-compile--for-effect nil))
     (inline (byte-compile-constant const))))
 \f
 ;; Compile those primitive ordinary functions
@@ -3335,7 +3350,8 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
   (byte-compile-constant nil))
 
 (defun byte-compile-discard (&optional num preserve-tos)
-  "Output byte codes to discard the NUM entries at the top of the stack (NUM defaults to 1).
+  "Output byte codes to discard the NUM entries at the top of the stack.
+NUM defaults to 1.
 If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were
 popped before discarding the num values, and then pushed back again after
 discarding."
@@ -3357,7 +3373,7 @@ discarding."
       (setq num (1- num)))))
 
 (defun byte-compile-stack-ref (stack-pos)
-  "Output byte codes to push the value at position STACK-POS in the stack, on the top of the stack."
+  "Output byte codes to push the value at stack position STACK-POS."
   (let ((dist (- byte-compile-depth (1+ stack-pos))))
     (if (zerop dist)
         ;; A simple optimization
@@ -3366,7 +3382,7 @@ discarding."
       (byte-compile-out 'byte-stack-ref dist))))
 
 (defun byte-compile-stack-set (stack-pos)
-  "Output byte codes to store the top-of-stack value at position STACK-POS in the stack."
+  "Output byte codes to store the TOS value at stack position STACK-POS."
   (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos))))
 
 (byte-defop-compiler-1 internal-make-closure byte-compile-make-closure)
@@ -3375,7 +3391,7 @@ discarding."
 (defconst byte-compile--env-var (make-symbol "env"))
 
 (defun byte-compile-make-closure (form)
-  (if for-effect (setq for-effect nil)
+  (if byte-compile--for-effect (setq byte-compile--for-effect nil)
     (let* ((vars (nth 1 form))
            (env (nth 2 form))
            (body (nthcdr 3 form))
@@ -3389,7 +3405,7 @@ discarding."
     
 
 (defun byte-compile-get-closed-var (form)
-  (if for-effect (setq for-effect nil)
+  (if byte-compile--for-effect (setq byte-compile--for-effect nil)
     (byte-compile-out 'byte-constant ;; byte-closed-var
                       (nth 1 form))))
 
@@ -3597,13 +3613,13 @@ discarding."
     (if bytecomp-args
        (while bytecomp-args
          (byte-compile-form (car (cdr bytecomp-args)))
-         (or for-effect (cdr (cdr bytecomp-args))
+         (or byte-compile--for-effect (cdr (cdr bytecomp-args))
              (byte-compile-out 'byte-dup 0))
          (byte-compile-variable-set (car bytecomp-args))
          (setq bytecomp-args (cdr (cdr bytecomp-args))))
       ;; (setq), with no arguments.
-      (byte-compile-form nil for-effect))
-    (setq for-effect nil)))
+      (byte-compile-form nil byte-compile--for-effect))
+    (setq byte-compile--for-effect nil)))
 
 (defun byte-compile-setq-default (form)
   (setq form (cdr form))
@@ -3637,19 +3653,19 @@ discarding."
 \f
 ;;; control structures
 
-(defun byte-compile-body (bytecomp-body &optional for-effect-arg)
+(defun byte-compile-body (bytecomp-body &optional for-effect)
   (while (cdr bytecomp-body)
     (byte-compile-form (car bytecomp-body) t)
     (setq bytecomp-body (cdr bytecomp-body)))
-  (byte-compile-form (car bytecomp-body) for-effect-arg))
+  (byte-compile-form (car bytecomp-body) for-effect))
 
 (defsubst byte-compile-body-do-effect (bytecomp-body)
-  (byte-compile-body bytecomp-body for-effect)
-  (setq for-effect nil))
+  (byte-compile-body bytecomp-body byte-compile--for-effect)
+  (setq byte-compile--for-effect nil))
 
 (defsubst byte-compile-form-do-effect (form)
-  (byte-compile-form form for-effect)
-  (setq for-effect nil))
+  (byte-compile-form form byte-compile--for-effect)
+  (setq byte-compile--for-effect nil))
 
 (byte-defop-compiler-1 inline byte-compile-progn)
 (byte-defop-compiler-1 progn)
@@ -3729,9 +3745,9 @@ that suppresses all warnings during execution of BODY."
          (byte-compile-bound-variables
            (append bound-list byte-compile-bound-variables)))
      (unwind-protect
-        ;; If things not being bound at all is ok, so must them being obsolete.
-        ;; Note that we add to the existing lists since Tramp (ab)uses
-        ;; this feature.
+        ;; If things not being bound at all is ok, so must them being
+        ;; obsolete.  Note that we add to the existing lists since Tramp
+        ;; (ab)uses this feature.
         (let ((byte-compile-not-obsolete-vars
                (append byte-compile-not-obsolete-vars bound-list))
               (byte-compile-not-obsolete-funcs
@@ -3753,20 +3769,20 @@ that suppresses all warnings during execution of BODY."
     (if (null (nthcdr 3 form))
        ;; No else-forms
        (progn
-         (byte-compile-goto-if nil for-effect donetag)
+         (byte-compile-goto-if nil byte-compile--for-effect donetag)
          (byte-compile-maybe-guarded clause
-           (byte-compile-form (nth 2 form) for-effect))
+           (byte-compile-form (nth 2 form) byte-compile--for-effect))
          (byte-compile-out-tag donetag))
       (let ((elsetag (byte-compile-make-tag)))
        (byte-compile-goto 'byte-goto-if-nil elsetag)
        (byte-compile-maybe-guarded clause
-         (byte-compile-form (nth 2 form) for-effect))
+         (byte-compile-form (nth 2 form) byte-compile--for-effect))
        (byte-compile-goto 'byte-goto donetag)
        (byte-compile-out-tag elsetag)
        (byte-compile-maybe-guarded (list 'not clause)
-         (byte-compile-body (cdr (cdr (cdr form))) for-effect))
+         (byte-compile-body (cdr (cdr (cdr form))) byte-compile--for-effect))
        (byte-compile-out-tag donetag))))
-  (setq for-effect nil))
+  (setq byte-compile--for-effect nil))
 
 (defun byte-compile-cond (clauses)
   (let ((donetag (byte-compile-make-tag))
@@ -3783,18 +3799,18 @@ that suppresses all warnings during execution of BODY."
             (byte-compile-form (car clause))
             (if (null (cdr clause))
                 ;; First clause is a singleton.
-                (byte-compile-goto-if t for-effect donetag)
+                (byte-compile-goto-if t byte-compile--for-effect donetag)
               (setq nexttag (byte-compile-make-tag))
               (byte-compile-goto 'byte-goto-if-nil nexttag)
               (byte-compile-maybe-guarded (car clause)
-                (byte-compile-body (cdr clause) for-effect))
+                (byte-compile-body (cdr clause) byte-compile--for-effect))
               (byte-compile-goto 'byte-goto donetag)
               (byte-compile-out-tag nexttag)))))
     ;; Last clause
     (let ((guard (car clause)))
       (and (cdr clause) (not (eq guard t))
           (progn (byte-compile-form guard)
-                 (byte-compile-goto-if nil for-effect donetag)
+                 (byte-compile-goto-if nil byte-compile--for-effect donetag)
                  (setq clause (cdr clause))))
       (byte-compile-maybe-guarded guard
        (byte-compile-body-do-effect clause)))
@@ -3813,7 +3829,7 @@ that suppresses all warnings during execution of BODY."
   (if (cdr rest)
       (progn
        (byte-compile-form (car rest))
-       (byte-compile-goto-if nil for-effect failtag)
+       (byte-compile-goto-if nil byte-compile--for-effect failtag)
        (byte-compile-maybe-guarded (car rest)
          (byte-compile-and-recursion (cdr rest) failtag)))
     (byte-compile-form-do-effect (car rest))
@@ -3832,7 +3848,7 @@ that suppresses all warnings during execution of BODY."
   (if (cdr rest)
       (progn
        (byte-compile-form (car rest))
-       (byte-compile-goto-if t for-effect wintag)
+       (byte-compile-goto-if t byte-compile--for-effect wintag)
        (byte-compile-maybe-guarded (list 'not (car rest))
          (byte-compile-or-recursion (cdr rest) wintag)))
     (byte-compile-form-do-effect (car rest))
@@ -3843,11 +3859,11 @@ that suppresses all warnings during execution of BODY."
        (looptag (byte-compile-make-tag)))
     (byte-compile-out-tag looptag)
     (byte-compile-form (car (cdr form)))
-    (byte-compile-goto-if nil for-effect endtag)
+    (byte-compile-goto-if nil byte-compile--for-effect endtag)
     (byte-compile-body (cdr (cdr form)) t)
     (byte-compile-goto 'byte-goto looptag)
     (byte-compile-out-tag endtag)
-    (setq for-effect nil)))
+    (setq byte-compile--for-effect nil)))
 
 (defun byte-compile-funcall (form)
   (mapc 'byte-compile-form (cdr form))
@@ -4008,7 +4024,7 @@ binding slots have been popped."
      (byte-compile-form `(list 'funcall ,f)))
     (body
      (byte-compile-push-constant
-      (byte-compile-top-level (cons 'progn body) for-effect))))
+      (byte-compile-top-level (cons 'progn body) byte-compile--for-effect))))
   (byte-compile-out 'byte-catch 0))
 
 (defun byte-compile-unwind-protect (form)
@@ -4044,7 +4060,7 @@ binding slots have been popped."
     (if fun-bodies
         (byte-compile-form `(list 'funcall ,(nth 2 form)))
       (byte-compile-push-constant
-       (byte-compile-top-level (nth 2 form) for-effect)))
+       (byte-compile-top-level (nth 2 form) byte-compile--for-effect)))
     (let ((compiled-clauses
            (mapcar
             (lambda (clause)
@@ -4072,7 +4088,7 @@ binding slots have been popped."
                     `(list ',condition (list 'funcall ,(cadr clause) ',var))
                   (cons condition
                         (byte-compile-top-level-body
-                         (cdr clause) for-effect)))))
+                         (cdr clause) byte-compile--for-effect)))))
             (cdr (cdr (cdr form))))))
       (if fun-bodies
           (byte-compile-form `(list ,@compiled-clauses))
@@ -4113,7 +4129,7 @@ binding slots have been popped."
       (byte-compile-set-symbol-position (car form))
     (byte-compile-set-symbol-position 'defun)
     (error "defun name must be a symbol, not %s" (car form)))
-  (let ((for-effect nil))
+  (let ((byte-compile--for-effect nil))
     (byte-compile-push-constant 'defalias)
     (byte-compile-push-constant (nth 1 form))
     (byte-compile-closure (cdr (cdr form)) t))
@@ -4410,22 +4426,22 @@ invoked interactively."
     (if byte-compile-call-tree-sort
        (setq byte-compile-call-tree
              (sort byte-compile-call-tree
-                   (cond ((eq byte-compile-call-tree-sort 'callers)
-                          (function (lambda (x y) (< (length (nth 1 x))
-                                                     (length (nth 1 y))))))
-                         ((eq byte-compile-call-tree-sort 'calls)
-                          (function (lambda (x y) (< (length (nth 2 x))
-                                                     (length (nth 2 y))))))
-                         ((eq byte-compile-call-tree-sort 'calls+callers)
-                          (function (lambda (x y) (< (+ (length (nth 1 x))
-                                                        (length (nth 2 x)))
-                                                     (+ (length (nth 1 y))
-                                                        (length (nth 2 y)))))))
-                         ((eq byte-compile-call-tree-sort 'name)
-                          (function (lambda (x y) (string< (car x)
-                                                           (car y)))))
-                         (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
-                                   byte-compile-call-tree-sort))))))
+                   (case byte-compile-call-tree-sort
+                      (callers
+                       (lambda (x y) (< (length (nth 1 x))
+                                   (length (nth 1 y)))))
+                      (calls
+                       (lambda (x y) (< (length (nth 2 x))
+                                   (length (nth 2 y)))))
+                      (calls+callers
+                       (lambda (x y) (< (+ (length (nth 1 x))
+                                      (length (nth 2 x)))
+                                   (+ (length (nth 1 y))
+                                      (length (nth 2 y))))))
+                      (name
+                       (lambda (x y) (string< (car x) (car y))))
+                      (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
+                                byte-compile-call-tree-sort))))))
     (message "Generating call tree...")
     (let ((rest byte-compile-call-tree)
          (b (current-buffer))
@@ -4533,7 +4549,8 @@ Each file is processed even if an error occurred previously.
 For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
 If NOFORCE is non-nil, don't recompile a file that seems to be
 already up-to-date."
-  ;; command-line-args-left is what is left of the command line (from startup.el)
+  ;; command-line-args-left is what is left of the command line, from
+  ;; startup.el.
   (defvar command-line-args-left)      ;Avoid 'free variable' warning
   (if (not noninteractive)
       (error "`batch-byte-compile' is to be used only with -batch"))
@@ -4558,7 +4575,8 @@ already up-to-date."
        ;; Specific file argument
        (if (or (not noforce)
                (let* ((bytecomp-source (car command-line-args-left))
-                      (bytecomp-dest (byte-compile-dest-file bytecomp-source)))
+                      (bytecomp-dest (byte-compile-dest-file
+                                       bytecomp-source)))
                  (or (not (file-exists-p bytecomp-dest))
                      (file-newer-than-file-p bytecomp-source bytecomp-dest))))
            (if (null (batch-byte-compile-file (car command-line-args-left)))
index 5be84c15d89268fd6823246233d3bf399c6467c6..2229be0de586b38a83a1e88e8db91c7c9cc2461a 100644 (file)
@@ -67,7 +67,6 @@
 
 ;; TODO:
 ;; - byte-optimize-form should be applied before cconv.
-;; - maybe unify byte-optimize and compiler-macros.
 ;; - canonize code in macro-expand so we don't have to handle (let (var) body)
 ;;   and other oddities.
 ;; - new byte codes for unwind-protect, catch, and condition-case so that
index 55ca90597d11c82fa73db70987478c153a23304e..f0a075ace37b954ca30ed95fb9406453259d0f35 100644 (file)
@@ -183,7 +183,9 @@ Assumes the caller has bound `macroexpand-all-environment'."
                    (cons (macroexpand-all-1
                           (list 'function f))
                          (macroexpand-all-forms args)))))
-      ;; Macro expand compiler macros.
+      ;; Macro expand compiler macros.  This cannot be delayed to
+      ;; byte-optimize-form because the output of the compiler-macro can
+      ;; use macros.
       ;; FIXME: Don't depend on CL.
       (`(,(pred (lambda (fun)
                   (and (symbolp fun)
@@ -191,7 +193,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
                            'cl-byte-compile-compiler-macro)
                        (functionp 'compiler-macroexpand))))
          . ,_)
-       (let ((newform (compiler-macroexpand form)))
+       (let ((newform (with-no-warnings (compiler-macroexpand form))))
          (if (eq form newform)
              (macroexpand-all-forms form 1)
            (macroexpand-all-1 newform))))
index 0e3d54408fd27e3e9e1fc3054dcc179f65330120..088410172e643aeeda0c29a98feb5ef68ae237b5 100644 (file)
@@ -66,6 +66,15 @@ AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \
        $(lisp)/cedet/semantic/loaddefs.el $(lisp)/cedet/ede/loaddefs.el \
        $(lisp)/cedet/srecode/loaddefs.el
 
+# Value of max-lisp-eval-depth when compiling initially.
+# During bootstrapping the byte-compiler is run interpreted when compiling
+# itself, and uses more stack than usual.
+#
+BIG_STACK_DEPTH = 1200
+BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
+
+BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
+
 # Files to compile before others during a bootstrap.  This is done to
 # speed up the bootstrap process.  The CC files are compiled first
 # because CC mode tweaks the compilation process, and requiring
@@ -75,6 +84,9 @@ AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \
 COMPILE_FIRST = \
        $(lisp)/emacs-lisp/byte-opt.el \
        $(lisp)/emacs-lisp/bytecomp.el \
+       $(lisp)/emacs-lisp/pcase.elc \
+       $(lisp)/emacs-lisp/macroexp.elc \
+       $(lisp)/emacs-lisp/cconv.elc \
        $(lisp)/subr.el \
        $(lisp)/progmodes/cc-mode.el \
        $(lisp)/progmodes/cc-vars.el
@@ -287,7 +299,7 @@ TAGS-LISP-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsf
 .SUFFIXES: .elc .el
 
 .el.elc:
-       -$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $<
+       -$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $<
 
 # Compile all Lisp files, but don't recompile those that are up to
 # 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
 compile-CMD:
 #      -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g
        for %%f in ($(COMPILE_FIRST)) do \
-         $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done %%f
+         $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f
        for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do \
-         $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
+         $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
 
 compile-SH:
 #      for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done
        for el in $(COMPILE_FIRST); do \
          echo Compiling $$el; \
-         $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done $$el; \
+         $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \
        done
        for dir in $(lisp) $(WINS); do \
          for el in $$dir/*.el; do \
            if test -f $$el; \
            then \
              echo Compiling $$el; \
-             $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done $$el; \
+             $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \
            fi \
          done; \
        done
@@ -335,31 +347,31 @@ compile-always: $(lisp)/subdirs.el compile-always-$(SHELLTYPE) doit
 
 compile-always-CMD:
 #      -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g
-       for %%f in ($(COMPILE_FIRST)) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f
-       for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f/%%g
+       for %%f in ($(COMPILE_FIRST)) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f
+       for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f/%%g
 
 compile-always-SH:
 #      for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done
        for el in $(COMPILE_FIRST); do \
          echo Compiling $$el; \
-         $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \
+         $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
        done
        for dir in $(lisp) $(WINS); do \
          for el in $$dir/*.el; do \
            echo Compiling $$el; \
-           $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \
+           $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
          done; \
        done
 
 compile-calc: compile-calc-$(SHELLTYPE)
 
 compile-calc-CMD:
-       for %%f in ($(lisp)/calc/*.el) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f
+       for %%f in ($(lisp)/calc/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f
 
 compile-calc-SH:
        for el in $(lisp)/calc/*.el; do \
          echo Compiling $$el; \
-         $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \
+         $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
        done
 
 # Backup compiled Lisp files in elc.tar.gz.  If that file already
index f84812570bfea6a8151bb1971c45be8a66b2a6b3..7a191f0cc9a0ce5c91fa86267b9e08edd14db621 100644 (file)
@@ -28,8 +28,7 @@
 
 ;;; Code:
 
-;; This is for lexical-let in apply-partially.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl))       ;For define-minor-mode.
 
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
@@ -6605,38 +6604,25 @@ saving the value of `buffer-invisibility-spec' and setting it to nil."
         buffer-invisibility-spec)
     (setq buffer-invisibility-spec nil)))
 \f
-;; Partial application of functions (similar to "currying").
-;; This function is here rather than in subr.el because it uses CL.
-;; (defalias 'apply-partially #'curry)
-(defun apply-partially (fun &rest args)
-  "Return a function that is a partial application of FUN to ARGS.
-ARGS is a list of the first N arguments to pass to FUN.
-The result is a new function which does the same as FUN, except that
-the first N arguments are fixed at the values with which this function
-was called."
-  (lexical-let ((fun fun) (args1 args))
-    (lambda (&rest args2) (apply fun (append args1 args2)))))
-\f
 ;; Minibuffer prompt stuff.
 
-;(defun minibuffer-prompt-modification (start end)
-;  (error "You cannot modify the prompt"))
-;
-;
-;(defun minibuffer-prompt-insertion (start end)
-;  (let ((inhibit-modification-hooks t))
-;    (delete-region start end)
-;    ;; Discard undo information for the text insertion itself
-;    ;; and for the text deletion.above.
-;    (when (consp buffer-undo-list)
-;      (setq buffer-undo-list (cddr buffer-undo-list)))
-;    (message "You cannot modify the prompt")))
-;
-;
-;(setq minibuffer-prompt-properties
-;  (list 'modification-hooks '(minibuffer-prompt-modification)
-;      'insert-in-front-hooks '(minibuffer-prompt-insertion)))
-;
+;;(defun minibuffer-prompt-modification (start end)
+;;  (error "You cannot modify the prompt"))
+;;
+;;
+;;(defun minibuffer-prompt-insertion (start end)
+;;  (let ((inhibit-modification-hooks t))
+;;    (delete-region start end)
+;;    ;; Discard undo information for the text insertion itself
+;;    ;; and for the text deletion.above.
+;;    (when (consp buffer-undo-list)
+;;      (setq buffer-undo-list (cddr buffer-undo-list)))
+;;    (message "You cannot modify the prompt")))
+;;
+;;
+;;(setq minibuffer-prompt-properties
+;;  (list 'modification-hooks '(minibuffer-prompt-modification)
+;;     'insert-in-front-hooks '(minibuffer-prompt-insertion)))
 
 \f
 ;;;; Problematic external packages.
index b6f095136ff245d7bcf58e37dbc435d6cd624db9..5faaa2130a2cfb8c8257c997573c42b823ffe08f 100644 (file)
@@ -116,6 +116,17 @@ BODY should be a list of Lisp expressions.
   ;; depend on backquote.el.
   (list 'function (cons 'lambda cdr)))
 
+;; Partial application of functions (similar to "currying").
+;; This function is here rather than in subr.el because it uses CL.
+(defun apply-partially (fun &rest args)
+  "Return a function that is a partial application of FUN to ARGS.
+ARGS is a list of the first N arguments to pass to FUN.
+The result is a new function which does the same as FUN, except that
+the first N arguments are fixed at the values with which this function
+was called."
+  `(closure () lambda (&rest args)
+            (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args)))
+
 (if (null (featurep 'cl))
     (progn
   ;; 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'."
     (unless elt
       (setq elt (list regexp-or-feature))
       (push elt after-load-alist))
+    ;; Make sure `form' is evalled in the current lexical/dynamic code.
+    (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding)))
     (when (symbolp regexp-or-feature)
       ;; For features, the after-load-alist elements get run when `provide' is
       ;; called rather than at the end of the file.  So add an indirection to