[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 6f0ebe11aaf: Merge remote-tracking branch 'origin/master
From: |
Po Lu |
Subject: |
feature/android 6f0ebe11aaf: Merge remote-tracking branch 'origin/master' into feature/android |
Date: |
Sun, 4 Jun 2023 20:48:45 -0400 (EDT) |
branch: feature/android
commit 6f0ebe11aaf9b2e54df14147cd2f62b048ffec9a
Merge: 835ac18a76a 6058b4559d4
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
lisp/emacs-lisp/byte-opt.el | 14 +++------
lisp/emacs-lisp/comp-cstr.el | 19 +++++++++--
lisp/emacs-lisp/comp.el | 75 ++++++++++++++++++++++++++++++++++----------
lisp/help-fns.el | 12 ++++---
4 files changed, 88 insertions(+), 32 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)))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 416ca7f11b0..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)))
@@ -1181,8 +1182,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 +1237,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
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 2ea405728a3..b65da148787 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,
+ ;; 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))
(+ (function (&rest (or number marker)) number))
@@ -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)))
@@ -412,12 +426,14 @@ 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) symbol))
(fround (function (float) float))
(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))
@@ -4425,6 +4447,27 @@ of (commands) to run simultaneously."
(delete-directory subdir))))))
(message "Cache cleared"))
+;;;###autoload
+(defun comp-function-type-spec (function)
+ "Return the type specifier of FUNCTION.
+
+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)))
+ (setf type-spec (comp-cstr-to-type-spec res)))
+ (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))))
+
(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..b9388b45397 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-function-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)))))