From 96d25d0c2026834e33c7a50518e292cb49588ef7 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Tue, 8 Oct 2024 14:41:35 +0200 Subject: [PATCH] Fix bootstrap --- lisp/bind-key.el | 16 ++--- lisp/dired.el | 6 +- lisp/emacs-lisp/byte-opt.el | 114 ------------------------------------ lisp/emacs-lisp/macroexp.el | 114 ++++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/syntax.el | 2 +- 5 files changed, 126 insertions(+), 126 deletions(-) diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 0fdaba30e0a..9f31b1d03a8 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -193,16 +193,16 @@ can safely be called at any time." (,keyvar ,(if (stringp key-name) (read-kbd-macro key-name) `(if (vectorp ,namevar) ,namevar (read-kbd-macro ,namevar)))) - (,kmapvar ,(cond - ((byte-compile-nilconstp keymap) 'global-map) - (t `(or (if (and ,keymap (symbolp ,keymap)) + (,kmapvar ,(if keymap + `(or (if (and ,keymap (symbolp ,keymap)) (symbol-value ,keymap) ,keymap) - global-map)))) + global-map) + 'global-map)) (,kdescvar (cons (if (stringp ,namevar) ,namevar (key-description ,namevar)) (if (symbolp ,keymap) ,keymap (quote ,keymap)))) (,bindingvar (lookup-key ,kmapvar ,keyvar))) - (require 'bind-key) ; ensure `personal-keybindings' is in scope + (require 'bind-key) ; ensure `personal-keybindings' is in scope (let ((entry (assoc ,kdescvar personal-keybindings)) (details (list ,command (unless (numberp ,bindingvar) @@ -212,9 +212,9 @@ can safely be called at any time." (add-to-list 'personal-keybindings (cons ,kdescvar details)))) ,(if predicate `(define-key ,kmapvar ,keyvar - '(menu-item "" nil :filter (lambda (&optional _) - (when ,predicate - ,command)))) + '(menu-item "" nil :filter (lambda (&optional _) + (when ,predicate + ,command)))) `(define-key ,kmapvar ,keyvar ,command))))) ;;;###autoload diff --git a/lisp/dired.el b/lisp/dired.el index f197411bf05..30a1b68ec29 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -973,7 +973,7 @@ marked file, return (t FILENAME) instead of (FILENAME)." (dired-repeat-over-lines ,arg (lambda () - ,@(unless (byte-compile-nilconstp show-progress) + ,@(when show-progress `((if ,show-progress (sit-for 0)))) (setq results (cons ,body results)))) (when (< ,arg 0) @@ -993,7 +993,7 @@ marked file, return (t FILENAME) instead of (FILENAME)." found (not (null next-position))) (while next-position (goto-char next-position) - ,@(unless (byte-compile-nilconstp show-progress) + ,@(when show-progress `((if ,show-progress (sit-for 0)))) (setq results (cons ,body results)) ;; move after last match @@ -1002,7 +1002,7 @@ marked file, return (t FILENAME) instead of (FILENAME)." (set-marker next-position nil) (setq next-position (and (re-search-forward regexp nil t) (point-marker))))) - ,@(unless (byte-compile-nilconstp distinguish-one-marked) + ,@(when distinguish-one-marked `((if (and ,distinguish-one-marked (= (length results) 1)) (setq results (cons t results))))) (if found diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 363fa0e667f..0e02ed8c736 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -774,120 +774,6 @@ If this function returns nil, then FORM never returns." t)))) form) -(defun byte-compile-trueconstp (form) - "Return non-nil if FORM always evaluates to a non-nil value." - (setq form (byte-opt--bool-value-form form)) - (cond ((consp form) - (let ((head (car form))) - ;; FIXME: Lots of other expressions are statically non-nil. - (cond ((memq head '(quote function)) (cadr form)) - ((eq head 'list) (cdr form)) - ((memq head - ;; FIXME: Replace this list with a function property? - '( lambda internal-make-closure - length safe-length cons - string unibyte-string make-string concat - format format-message - substring substring-no-properties string-replace - replace-regexp-in-string symbol-name make-symbol - compare-strings string-distance - mapconcat - vector make-vector vconcat make-record record - regexp-quote regexp-opt - buffer-string buffer-substring - buffer-substring-no-properties - current-buffer buffer-size get-buffer-create - point point-min point-max buffer-end count-lines - following-char preceding-char get-byte max-char - region-beginning region-end - line-beginning-position line-end-position - pos-bol pos-eol - + - * / % 1+ 1- min max abs mod expt logb - logand logior logxor lognot ash logcount - floor ceiling round truncate - sqrt sin cos tan asin acos atan exp log copysign - ffloor fceiling fround ftruncate float - ldexp frexp - number-to-string string-to-number - int-to-string char-to-string - prin1-to-string read-from-string - byte-to-string string-to-vector string-to-char - capitalize upcase downcase - propertize - string-as-multibyte string-as-unibyte - string-to-multibyte string-to-unibyte - string-make-multibyte string-make-unibyte - string-width char-width - make-hash-table hash-table-count - unibyte-char-to-multibyte multibyte-char-to-unibyte - sxhash sxhash-equal sxhash-eq sxhash-eql - sxhash-equal-including-properties - make-marker copy-marker point-marker mark-marker - set-marker - kbd key-description - skip-chars-forward skip-chars-backward - skip-syntax-forward skip-syntax-backward - current-column current-indentation - char-syntax syntax-class-to-char - parse-partial-sexp goto-char forward-line - next-window previous-window minibuffer-window - selected-frame selected-window - standard-case-table standard-syntax-table - syntax-table - frame-first-window frame-root-window - frame-selected-window - always)) - t) - ((eq head 'if) - (and (byte-compile-trueconstp (nth 2 form)) - (byte-compile-trueconstp (car (last (cdddr form)))))) - ((memq head '(not null)) - (byte-compile-nilconstp (cadr form))) - ((eq head 'or) - (and (cdr form) - (byte-compile-trueconstp (car (last (cdr form))))))))) - ((not (symbolp form))) - ((eq form t)) - ((keywordp form)))) - -(defun byte-compile-nilconstp (form) - "Return non-nil if FORM always evaluates to a nil value." - (setq form (byte-opt--bool-value-form form)) - (or (not form) ; assume (quote nil) always being normalized to nil - (and (consp form) - (let ((head (car form))) - (cond ((memq head - ;; Some forms that are statically nil. - ;; FIXME: Replace with a function property? - '( while ignore - insert insert-and-inherit insert-before-markers - insert-before-markers-and-inherit - insert-char insert-byte insert-buffer-substring - delete-region delete-char - widen narrow-to-region transpose-regions - forward-char backward-char - beginning-of-line end-of-line - erase-buffer buffer-swap-text - delete-overlay delete-all-overlays - remhash - maphash - map-charset-chars map-char-table - mapbacktrace - mapatoms - ding beep sleep-for - json-insert - set-match-data - )) - t) - ((eq head 'if) - (and (byte-compile-nilconstp (nth 2 form)) - (byte-compile-nilconstp (car (last (cdddr form)))))) - ((memq head '(not null)) - (byte-compile-trueconstp (cadr form))) - ((eq head 'and) - (and (cdr form) - (byte-compile-nilconstp (car (last (cdr form))))))))))) - ;; If the function is being called with constant integer args, ;; evaluate as much as possible at compile-time. This optimizer ;; assumes that the function is associative, like min or max. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e96aaa9bf3e..3b0b3093781 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -837,6 +837,120 @@ test of free variables in the following ways: (error "Eager macro-expansion failure: %S" err) form))))) +(defun byte-compile-trueconstp (form) + "Return non-nil if FORM always evaluates to a non-nil value." + (setq form (byte-opt--bool-value-form form)) + (cond ((consp form) + (let ((head (car form))) + ;; FIXME: Lots of other expressions are statically non-nil. + (cond ((memq head '(quote function)) (cadr form)) + ((eq head 'list) (cdr form)) + ((memq head + ;; FIXME: Replace this list with a function property? + '( lambda internal-make-closure + length safe-length cons + string unibyte-string make-string concat + format format-message + substring substring-no-properties string-replace + replace-regexp-in-string symbol-name make-symbol + compare-strings string-distance + mapconcat + vector make-vector vconcat make-record record + regexp-quote regexp-opt + buffer-string buffer-substring + buffer-substring-no-properties + current-buffer buffer-size get-buffer-create + point point-min point-max buffer-end count-lines + following-char preceding-char get-byte max-char + region-beginning region-end + line-beginning-position line-end-position + pos-bol pos-eol + + - * / % 1+ 1- min max abs mod expt logb + logand logior logxor lognot ash logcount + floor ceiling round truncate + sqrt sin cos tan asin acos atan exp log copysign + ffloor fceiling fround ftruncate float + ldexp frexp + number-to-string string-to-number + int-to-string char-to-string + prin1-to-string read-from-string + byte-to-string string-to-vector string-to-char + capitalize upcase downcase + propertize + string-as-multibyte string-as-unibyte + string-to-multibyte string-to-unibyte + string-make-multibyte string-make-unibyte + string-width char-width + make-hash-table hash-table-count + unibyte-char-to-multibyte multibyte-char-to-unibyte + sxhash sxhash-equal sxhash-eq sxhash-eql + sxhash-equal-including-properties + make-marker copy-marker point-marker mark-marker + set-marker + kbd key-description + skip-chars-forward skip-chars-backward + skip-syntax-forward skip-syntax-backward + current-column current-indentation + char-syntax syntax-class-to-char + parse-partial-sexp goto-char forward-line + next-window previous-window minibuffer-window + selected-frame selected-window + standard-case-table standard-syntax-table + syntax-table + frame-first-window frame-root-window + frame-selected-window + always)) + t) + ((eq head 'if) + (and (byte-compile-trueconstp (nth 2 form)) + (byte-compile-trueconstp (car (last (cdddr form)))))) + ((memq head '(not null)) + (byte-compile-nilconstp (cadr form))) + ((eq head 'or) + (and (cdr form) + (byte-compile-trueconstp (car (last (cdr form))))))))) + ((not (symbolp form))) + ((eq form t)) + ((keywordp form)))) + +(defun byte-compile-nilconstp (form) + "Return non-nil if FORM always evaluates to a nil value." + (setq form (byte-opt--bool-value-form form)) + (or (not form) ; assume (quote nil) always being normalized to nil + (and (consp form) + (let ((head (car form))) + (cond ((memq head + ;; Some forms that are statically nil. + ;; FIXME: Replace with a function property? + '( while ignore + insert insert-and-inherit insert-before-markers + insert-before-markers-and-inherit + insert-char insert-byte insert-buffer-substring + delete-region delete-char + widen narrow-to-region transpose-regions + forward-char backward-char + beginning-of-line end-of-line + erase-buffer buffer-swap-text + delete-overlay delete-all-overlays + remhash + maphash + map-charset-chars map-char-table + mapbacktrace + mapatoms + ding beep sleep-for + json-insert + set-match-data + )) + t) + ((eq head 'if) + (and (byte-compile-nilconstp (nth 2 form)) + (byte-compile-nilconstp (car (last (cdddr form)))))) + ((memq head '(not null)) + (byte-compile-trueconstp (cadr form))) + ((eq head 'and) + (and (cdr form) + (byte-compile-nilconstp (car (last (cdr form))))))))))) + ;; ¡¡¡ Big Ugly Hack !!! ;; src/bootstrap-emacs is mostly used to compile .el files, so it needs ;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 478dd0ade02..dae2e786909 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -333,7 +333,7 @@ all RULES in total." (me (match-end ,gn))) ,(macroexp-let2 nil syntax (nth 1 action) `(progn - ,@(unless (byte-compile-nilconstp syntax) + ,@(when syntax `((when ,syntax (put-text-property mb me 'syntax-table ,syntax)))) -- 2.39.5