From 2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Mar 2011 22:32:43 -0500 Subject: [PATCH] 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. --- lisp/ChangeLog | 26 ++++ lisp/Makefile.in | 11 +- lisp/emacs-lisp/byte-opt.el | 33 ++-- lisp/emacs-lisp/bytecomp.el | 298 +++++++++++++++++++----------------- lisp/emacs-lisp/cconv.el | 1 - lisp/emacs-lisp/macroexp.el | 6 +- lisp/makefile.w32-in | 34 ++-- lisp/simple.el | 50 +++--- lisp/subr.el | 13 ++ 9 files changed, 264 insertions(+), 208 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0b432eb46d9..01571b80124 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,29 @@ +2011-03-12 Stefan Monnier + + * 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 * 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 \ 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. 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 @@ ;; ((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))) @@ -378,9 +378,7 @@ ;;; 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 @@ -388,8 +386,7 @@ ;; 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 @@ -482,8 +479,8 @@ (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. @@ -498,7 +495,8 @@ (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) @@ -537,8 +535,8 @@ ;; 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) @@ -589,19 +587,18 @@ (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 @@ -618,7 +615,7 @@ (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. 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 @@ ;;; 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 <> or (progn <> 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)))) ;; 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." ;;; 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))) 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 @@ ;; 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 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'." (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)))) 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 \ $(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 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 @@ ;;; 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))) -;; 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))))) - ;; 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))) ;;;; 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. ;; 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 -- 2.39.5