From 85cb075b1bda405967641e53be5178585cbc2216 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 4 Jun 2023 10:58:32 +0200 Subject: [PATCH 01/10] * lisp/emacs-lisp/comp.el (comp-known-type-specifiers): Tweak framep. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2ea405728a3..43669e5ce5f 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -412,7 +412,7 @@ Useful to hook into pass checkers.") (frame-root-window (function (&optional (or frame window)) window)) (frame-selected-window (function (&optional (or frame window)) window)) (frame-visible-p (function (frame) (or boolean (member icon)))) - (framep (function (t) (or boolean (member x w32 ns pc pgtk haiku)))) + (framep (function (t) (or boolean symbol))) (fround (function (float) float)) (ftruncate (function (float) float)) (get (function (symbol symbol) t)) From fe91af936d8e0ea976fc29771ccd6b8fa10293c5 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 4 Jun 2023 12:19:09 +0200 Subject: [PATCH 02/10] * lisp/emacs-lisp/comp.el: Improve 85cb075b1bd. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 43669e5ce5f..0b5682e23b1 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -412,7 +412,7 @@ Useful to hook into pass checkers.") (frame-root-window (function (&optional (or frame window)) window)) (frame-selected-window (function (&optional (or frame window)) window)) (frame-visible-p (function (frame) (or boolean (member icon)))) - (framep (function (t) (or boolean symbol))) + (framep (function (t) symbol)) (fround (function (float) float)) (ftruncate (function (float) float)) (get (function (symbol symbol) t)) From ac1532a7c9a32bb84893f7eb291171e01b99068c Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 4 Jun 2023 11:07:38 +0200 Subject: [PATCH 03/10] * lisp/emacs-lisp/comp.el (comp-known-type-specifiers): Fix line lengths --- lisp/emacs-lisp/comp.el | 44 ++++++++++++++++++++++++++++++----------- 1 file changed, 33 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0b5682e23b1..da551ae2fd9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -307,7 +307,8 @@ Useful to hook into pass checkers.") (bignump (function (t) boolean)) (bobp (function () boolean)) (bolp (function () boolean)) - (bool-vector-count-consecutive (function (bool-vector boolean integer) fixnum)) + (bool-vector-count-consecutive + (function (bool-vector boolean integer) fixnum)) (bool-vector-count-population (function (bool-vector) fixnum)) (bool-vector-not (function (bool-vector &optional bool-vector) bool-vector)) (bool-vector-p (function (t) boolean)) @@ -317,10 +318,12 @@ Useful to hook into pass checkers.") (buffer-file-name (function (&optional buffer) (or string null))) (buffer-list (function (&optional frame) list)) (buffer-local-variables (function (&optional buffer) list)) - (buffer-modified-p (function (&optional buffer) (or boolean (member autosaved)))) + (buffer-modified-p + (function (&optional buffer) (or boolean (member autosaved)))) (buffer-size (function (&optional buffer) integer)) (buffer-string (function () string)) - (buffer-substring (function ((or integer marker) (or integer marker)) string)) + (buffer-substring + (function ((or integer marker) (or integer marker)) string)) (bufferp (function (t) boolean)) (byte-code-function-p (function (t) boolean)) (capitalize (function (or integer string) (or integer string))) @@ -340,17 +343,27 @@ Useful to hook into pass checkers.") (characterp (function (t &optional t) boolean)) (charsetp (function (t) boolean)) (commandp (function (t &optional t) boolean)) - (compare-strings (function (string (or integer marker null) (or integer marker null) string (or integer marker null) (or integer marker null) &optional t) (or (member t) fixnum))) + (compare-strings + (function (string (or integer marker null) (or integer marker null) string + (or integer marker null) (or integer marker null) + &optional t) + (or (member t) fixnum))) (concat (function (&rest sequence) string)) (cons (function (t t) cons)) (consp (function (t) boolean)) - (coordinates-in-window-p (function (cons window) (or cons null (member bottom-divider right-divider mode-line header-line tab-line left-fringe right-fringe vertical-line left-margin right-margin)))) + (coordinates-in-window-p + (function (cons window) + (or cons null + (member bottom-divider right-divider mode-line header-line + tab-line left-fringe right-fringe vertical-line + left-margin right-margin)))) (copy-alist (function (list) list)) (copy-marker (function (&optional (or integer marker) boolean) marker)) (copy-sequence (function (sequence) sequence)) (copysign (function (float float) float)) (cos (function (number) float)) - (count-lines (function ((or integer marker) (or integer marker) &optional t) integer)) + (count-lines + (function ((or integer marker) (or integer marker) &optional t) integer)) (current-buffer (function () buffer)) (current-global-map (function () cons)) (current-indentation (function () integer)) @@ -372,7 +385,8 @@ Useful to hook into pass checkers.") (default-boundp (function (symbol) boolean)) (default-value (function (symbol) t)) (degrees-to-radians (function (number) float)) - (documentation (function ((or function symbol subr) &optional t) (or null string))) + (documentation + (function ((or function symbol subr) &optional t) (or null string))) (downcase (function ((or fixnum string)) (or fixnum string))) (elt (function (sequence integer) t)) (encode-char (function (fixnum symbol) (or fixnum null))) @@ -417,7 +431,9 @@ Useful to hook into pass checkers.") (ftruncate (function (float) float)) (get (function (symbol symbol) t)) (get-buffer (function ((or buffer string)) (or buffer null))) - (get-buffer-window (function (&optional (or buffer string) (or symbol (integer 0 0))) (or null window))) + (get-buffer-window + (function (&optional (or buffer string) (or symbol (integer 0 0))) + (or null window))) (get-file-buffer (function (string) (or null buffer))) (get-largest-window (function (&optional t t t) (or window null))) (get-lru-window (function (&optional t t t) (or window null))) @@ -462,7 +478,10 @@ Useful to hook into pass checkers.") (logxor (function (&rest (or integer marker)) integer)) ;; (lsh (function ((integer ,most-negative-fixnum *) integer) integer)) ? (lsh (function (integer integer) integer)) - (make-byte-code (function ((or fixnum list) string vector integer &optional string t &rest t) vector)) + (make-byte-code + (function ((or fixnum list) string vector integer &optional string t + &rest t) + vector)) (make-list (function (integer t) list)) (make-marker (function () marker)) (make-string (function (integer fixnum &optional t) string)) @@ -480,7 +499,9 @@ Useful to hook into pass checkers.") (min (function ((or number marker) &rest (or number marker)) number)) (minibuffer-selected-window (function () (or window null))) (minibuffer-window (function (&optional frame) window)) - (mod (function ((or number marker) (or number marker)) (or (integer 0 *) (float 0 *)))) + (mod + (function ((or number marker) (or number marker)) + (or (integer 0 *) (float 0 *)))) (mouse-movement-p (function (t) boolean)) (multibyte-char-to-unibyte (function (fixnum) fixnum)) (natnump (function (t) boolean)) @@ -544,7 +565,8 @@ Useful to hook into pass checkers.") (string= (function ((or string symbol) (or string symbol)) boolean)) (stringp (function (t) boolean)) (subrp (function (t) boolean)) - (substring (function ((or string vector) &optional integer integer) (or string vector))) + (substring + (function ((or string vector) &optional integer integer) (or string vector))) (sxhash (function (t) integer)) (sxhash-eq (function (t) integer)) (sxhash-eql (function (t) integer)) From 9ed24bfb04f5a878689e09914f1c4b28105ac85e Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 4 Jun 2023 11:26:22 +0200 Subject: [PATCH 04/10] * Have `comp-cstr-to-type-spec' handle comp-cstr-f as well * lisp/emacs-lisp/comp-cstr.el (comp--simple-cstr-to-type-spec): New function. (comp-cstr-to-type-spec): Make use of. --- lisp/emacs-lisp/comp-cstr.el | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 416ca7f11b0..c5b96a6b629 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -1181,8 +1181,8 @@ FN non-nil indicates we are parsing a function lambda list." :ret (comp-type-spec-to-cstr ret))) (_ (error "Invalid type specifier")))) -(defun comp-cstr-to-type-spec (cstr) - "Given CSTR return its type specifier." +(defun comp--simple-cstr-to-type-spec (cstr) + "Given a non comp-cstr-f CSTR return its type specifier." (let ((valset (comp-cstr-valset cstr)) (typeset (comp-cstr-typeset cstr)) (range (comp-cstr-range cstr)) @@ -1236,6 +1236,20 @@ FN non-nil indicates we are parsing a function lambda list." `(not ,final) final)))) +(defun comp-cstr-to-type-spec (cstr) + "Given CSTR return its type specifier." + (cl-etypecase cstr + (comp-cstr-f + `(function + ,(mapcar (lambda (x) + (cl-etypecase x + (comp-cstr (comp-cstr-to-type-spec x)) + (symbol x))) + (comp-cstr-f-args cstr)) + ,(comp--simple-cstr-to-type-spec (comp-cstr-f-ret cstr)))) + (comp-cstr + (comp--simple-cstr-to-type-spec cstr)))) + (provide 'comp-cstr) ;;; comp-cstr.el ends here From 53dc1f3fe0aa9b932e6413007e7a6d39c00f1721 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 30 May 2023 15:30:11 +0200 Subject: [PATCH 05/10] Print know function types in C-h f * lisp/emacs-lisp/comp.el (comp-known-type-specifiers): Improve comment. (comp-funciton-type-spec): New function. * lisp/help-fns.el (help-fns--signature): Update to make use of `comp-funciton-type-spec'. --- lisp/emacs-lisp/comp.el | 28 ++++++++++++++++++++++++---- lisp/help-fns.el | 12 ++++++++---- 2 files changed, 32 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index da551ae2fd9..86707dd3516 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -277,10 +277,10 @@ Useful to hook into pass checkers.") ;; FIXME this probably should not be here but... good for now. (defconst comp-known-type-specifiers `( - ;; Functions we can trust not to be or if redefined should expose - ;; the same type. Vast majority of these is either pure or - ;; primitive, the original list is the union of pure + - ;; side-effect-free-fns + side-effect-and-error-free-fns: + ;; Functions we can trust not to be redefined or if redefined + ;; should expose the same type. The vast majority of these is + ;; either pure or primitive, the original list is the union of + ;; pure + side-effect-free-fns + side-effect-and-error-free-fns: (% (function ((or number marker) (or number marker)) number)) (* (function (&rest (or number marker)) number)) (+ (function (&rest (or number marker)) number)) @@ -4447,6 +4447,26 @@ of (commands) to run simultaneously." (delete-directory subdir)))))) (message "Cache cleared")) +;;;###autoload +(defun comp-funciton-type-spec (function) + "Given FUNCTION gives its type specifier. +Return a cons with its car being the function specifier and its +cdr being a symbol. + +If the symbol is `inferred' the type specifier is automatically +inferred from the code itself by the native compiler, if it is +`know' the type specifier comes from +`comp-known-type-specifiers'." + (let ((kind 'know) + type-spec ) + (when-let ((res (gethash function comp-known-func-cstr-h))) + (setf type-spec (comp-cstr-to-type-spec res))) + (unless type-spec + (setf kind 'inferred + type-spec (subr-type (symbol-function function)))) + (when type-spec + (cons type-spec kind)))) + (provide 'comp) ;; LocalWords: limplified limplification limplify Limple LIMPLE libgccjit elc eln diff --git a/lisp/help-fns.el b/lisp/help-fns.el index c4e09e48bea..dcf265ea170 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -711,10 +711,14 @@ the C sources, too." (unless (and (symbolp function) (get function 'reader-construct)) (insert high-usage "\n") - (when (and (featurep 'native-compile) - (subr-native-elisp-p (symbol-function function)) - (subr-type (symbol-function function))) - (insert (format "\nInferred type: %s\n" (subr-type (symbol-function function)))))) + (when-let* ((res (comp-funciton-type-spec function)) + (type-spec (car res)) + (kind (cdr res))) + (insert (format + (if (eq kind 'inferred) + "\nInferred type: %s\n" + "\nType: %s\n") + type-spec)))) (fill-region fill-begin (point)) high-doc))))) From 508005b3cf91b03736adc6f6edfc1cebe22be0df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 4 Jun 2023 14:09:39 +0200 Subject: [PATCH 06/10] ; * lisp/emacs-lisp/comp.el (comp-funciton-type-spec): typo --- lisp/emacs-lisp/comp.el | 2 +- lisp/help-fns.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 86707dd3516..e516c8b5eb9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4448,7 +4448,7 @@ of (commands) to run simultaneously." (message "Cache cleared")) ;;;###autoload -(defun comp-funciton-type-spec (function) +(defun comp-function-type-spec (function) "Given FUNCTION gives its type specifier. Return a cons with its car being the function specifier and its cdr being a symbol. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index dcf265ea170..b9388b45397 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -711,7 +711,7 @@ the C sources, too." (unless (and (symbolp function) (get function 'reader-construct)) (insert high-usage "\n") - (when-let* ((res (comp-funciton-type-spec function)) + (when-let* ((res (comp-function-type-spec function)) (type-spec (car res)) (kind (cdr res))) (insert (format From 3f9e0281ad2776e3973a3cceda4b16c9925f6673 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 4 Jun 2023 15:28:25 +0300 Subject: [PATCH 07/10] ; Minor doc copyedits in comp.el * lisp/emacs-lisp/comp.el (comp-known-type-specifiers): Fix commentary. (comp-function-type-spec): Doc fix. --- lisp/emacs-lisp/comp.el | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e516c8b5eb9..696ed8d21f9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -277,9 +277,9 @@ Useful to hook into pass checkers.") ;; FIXME this probably should not be here but... good for now. (defconst comp-known-type-specifiers `( - ;; Functions we can trust not to be redefined or if redefined - ;; should expose the same type. The vast majority of these is - ;; either pure or primitive, the original list is the union of + ;; Functions we can trust not to be redefined, or, if redefined, + ;; to expose the same type. The vast majority of these are + ;; either pure or primitive; the original list is the union of ;; pure + side-effect-free-fns + side-effect-and-error-free-fns: (% (function ((or number marker) (or number marker)) number)) (* (function (&rest (or number marker)) number)) @@ -4449,14 +4449,13 @@ of (commands) to run simultaneously." ;;;###autoload (defun comp-function-type-spec (function) - "Given FUNCTION gives its type specifier. -Return a cons with its car being the function specifier and its -cdr being a symbol. + "Return the type specifier of FUNCTION. -If the symbol is `inferred' the type specifier is automatically -inferred from the code itself by the native compiler, if it is -`know' the type specifier comes from -`comp-known-type-specifiers'." +This function returns a cons cell whose car is the function +specifier, and cdr is a symbol, either `inferred' or `know'. +If the symbol is `inferred', the type specifier is automatically +inferred from the code itself by the native compiler; if it is +`know', the type specifier comes from `comp-known-type-specifiers'." (let ((kind 'know) type-spec ) (when-let ((res (gethash function comp-known-func-cstr-h))) From b5f171f98f46ac309e1678b7d1b5ea93f8b4a34d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 4 Jun 2023 16:25:14 +0200 Subject: [PATCH 08/10] * lisp/emacs-lisp/comp.el (comp-function-type-spec): Improve. --- lisp/emacs-lisp/comp.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 696ed8d21f9..b65da148787 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4460,9 +4460,11 @@ inferred from the code itself by the native compiler; if it is type-spec ) (when-let ((res (gethash function comp-known-func-cstr-h))) (setf type-spec (comp-cstr-to-type-spec res))) - (unless type-spec - (setf kind 'inferred - type-spec (subr-type (symbol-function function)))) + (let ((f (symbol-function function))) + (when (and (null type-spec) + (subr-native-elisp-p f)) + (setf kind 'inferred + type-spec (subr-type f)))) (when type-spec (cons type-spec kind)))) From 5d3d84066fa66b0f16505ee6e77c8c383277869f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 4 Jun 2023 16:43:13 +0200 Subject: [PATCH 09/10] * lisp/emacs-lisp/comp-cstr.el (cl-macs): Require it. --- lisp/emacs-lisp/comp-cstr.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index c5b96a6b629..e0db82604f2 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -36,6 +36,7 @@ ;;; Code: (require 'cl-lib) +(require 'cl-macs) (defconst comp--typeof-builtin-types (mapcar (lambda (x) (append x '(t))) From 6058b4559d4b7d42bbcb6da787a95334aa8994ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 4 Jun 2023 15:58:44 +0200 Subject: [PATCH 10/10] Better internal-make-closure optimisation * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Optimise closed-over values in closure creation like any other, which can lead to stack variables being eliminated. --- lisp/emacs-lisp/byte-opt.el | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 562f21aa751..f64674d5a6c 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -447,16 +447,10 @@ for speeding up processing.") . ,(byte-optimize-body exps for-effect))) ;; Needed as long as we run byte-optimize-form after cconv. - (`(internal-make-closure . ,_) - (and (not for-effect) - (progn - ;; Look up free vars and mark them to be kept, so that they - ;; won't be optimized away. - (dolist (var (caddr form)) - (let ((lexvar (assq var byte-optimize--lexvars))) - (when lexvar - (setcar (cdr lexvar) t)))) - form))) + (`(internal-make-closure ,vars ,env . ,rest) + (if for-effect + `(progn ,@(byte-optimize-body env t)) + `(,fn ,vars ,(mapcar #'byte-optimize-form env) . ,rest))) (`((lambda . ,_) . ,_) (let ((newform (macroexp--unfold-lambda form)))