Merge branch 'lisp-func-type-decls' into 'master'
This commit is contained in:
Andrea Corallo
commit
da8b06bd61
14 changed files with 147 additions and 76 deletions
|
|
@ -217,6 +217,11 @@ So far, FUNCTION can only be a symbol, not a lambda expression."
|
|||
(cadr elem)))
|
||||
val)))))
|
||||
|
||||
(defalias 'byte-run--set-function-type
|
||||
#'(lambda (f _args &rest val)
|
||||
(list 'function-put (list 'quote f)
|
||||
''function-type (list 'quote val))))
|
||||
|
||||
;; Add any new entries to info node `(elisp)Declare Form'.
|
||||
(defvar defun-declarations-alist
|
||||
(list
|
||||
|
|
@ -239,7 +244,8 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
|
|||
(list 'speed #'byte-run--set-speed)
|
||||
(list 'completion #'byte-run--set-completion)
|
||||
(list 'modes #'byte-run--set-modes)
|
||||
(list 'interactive-args #'byte-run--set-interactive-args))
|
||||
(list 'interactive-args #'byte-run--set-interactive-args)
|
||||
(list 'type #'byte-run--set-function-type))
|
||||
"List associating function properties to their macro expansion.
|
||||
Each element of the list takes the form (PROP FUN) where FUN is
|
||||
a function. For each (PROP . VALUES) in a function's declaration,
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@ Used to modify the compiler environment."
|
|||
:risky t
|
||||
:version "28.1")
|
||||
|
||||
(defconst comp-known-type-specifiers
|
||||
(defconst comp-primitive-type-specifiers
|
||||
`(
|
||||
;; Functions we can trust not to be redefined, or, if redefined,
|
||||
;; to expose the same type. The vast majority of these are
|
||||
|
|
@ -97,7 +97,6 @@ Used to modify the compiler environment."
|
|||
(assq (function (t list) list))
|
||||
(atan (function (number &optional number) float))
|
||||
(atom (function (t) boolean))
|
||||
(bignump (function (t) boolean))
|
||||
(bobp (function () boolean))
|
||||
(bolp (function () boolean))
|
||||
(bool-vector-count-consecutive
|
||||
|
|
@ -107,7 +106,6 @@ Used to modify the compiler environment."
|
|||
(bool-vector-p (function (t) boolean))
|
||||
(bool-vector-subsetp (function (bool-vector bool-vector) boolean))
|
||||
(boundp (function (symbol) boolean))
|
||||
(buffer-end (function ((or number marker)) integer))
|
||||
(buffer-file-name (function (&optional buffer) (or string null)))
|
||||
(buffer-list (function (&optional frame) list))
|
||||
(buffer-local-variables (function (&optional buffer) list))
|
||||
|
|
@ -157,8 +155,6 @@ Used to modify the compiler environment."
|
|||
(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))
|
||||
(current-buffer (function () buffer))
|
||||
(current-global-map (function () cons))
|
||||
(current-indentation (function () integer))
|
||||
|
|
@ -171,7 +167,6 @@ Used to modify the compiler environment."
|
|||
(current-time-zone (function (&optional (or number list)
|
||||
(or symbol string cons integer))
|
||||
cons))
|
||||
(custom-variable-p (function (symbol) t))
|
||||
(decode-char (function (cons t) (or fixnum null)))
|
||||
(decode-time (function (&optional (or number list)
|
||||
(or symbol string cons integer)
|
||||
|
|
@ -179,7 +174,6 @@ Used to modify the compiler environment."
|
|||
cons))
|
||||
(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)))
|
||||
(downcase (function ((or fixnum string)) (or fixnum string)))
|
||||
|
|
@ -192,7 +186,6 @@ Used to modify the compiler environment."
|
|||
(eql (function (t t) boolean))
|
||||
(equal (function (t t) boolean))
|
||||
(error-message-string (function (list) string))
|
||||
(eventp (function (t) boolean))
|
||||
(exp (function (number) float))
|
||||
(expt (function (number number) number))
|
||||
(fboundp (function (symbol) boolean))
|
||||
|
|
@ -207,7 +200,6 @@ Used to modify the compiler environment."
|
|||
(file-readable-p (function (string) boolean))
|
||||
(file-symlink-p (function (string) (or boolean string)))
|
||||
(file-writable-p (function (string) boolean))
|
||||
(fixnump (function (t) boolean))
|
||||
(float (function (number) float))
|
||||
(float-time (function (&optional (or number list)) float))
|
||||
(floatp (function (t) boolean))
|
||||
|
|
@ -230,18 +222,12 @@ Used to modify the compiler environment."
|
|||
(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)))
|
||||
(getenv (function (string &optional frame) (or null string)))
|
||||
(gethash (function (t hash-table &optional t) t))
|
||||
(hash-table-count (function (hash-table) integer))
|
||||
(hash-table-p (function (t) boolean))
|
||||
(identity (function (t) t))
|
||||
(ignore (function (&rest t) null))
|
||||
(int-to-string (function (number) string))
|
||||
(integer-or-marker-p (function (t) boolean))
|
||||
(integerp (function (t) boolean))
|
||||
(interactive-p (function () boolean))
|
||||
(intern-soft (function ((or string symbol) &optional (or obarray vector))
|
||||
symbol))
|
||||
(invocation-directory (function () string))
|
||||
|
|
@ -250,8 +236,6 @@ Used to modify the compiler environment."
|
|||
(keymap-parent (function (cons) (or cons null)))
|
||||
(keymapp (function (t) boolean))
|
||||
(keywordp (function (t) boolean))
|
||||
(last (function (list &optional integer) list))
|
||||
(lax-plist-get (function (list t) t))
|
||||
(ldexp (function (number integer) float))
|
||||
(length (function (t) (integer 0 *)))
|
||||
(length< (function (sequence fixnum) boolean))
|
||||
|
|
@ -265,7 +249,6 @@ Used to modify the compiler environment."
|
|||
(local-variable-p (function (symbol &optional buffer) boolean))
|
||||
(locale-info (function ((member codeset days months paper)) (or null string)))
|
||||
(log (function (number number) float))
|
||||
(log10 (function (number) float))
|
||||
(logand (function (&rest (or integer marker)) integer))
|
||||
(logb (function (number) integer))
|
||||
(logcount (function (integer) integer))
|
||||
|
|
@ -273,7 +256,6 @@ Used to modify the compiler environment."
|
|||
(lognot (function (integer) integer))
|
||||
(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)
|
||||
|
|
@ -282,14 +264,12 @@ Used to modify the compiler environment."
|
|||
(make-marker (function () marker))
|
||||
(make-string (function (integer fixnum &optional t) string))
|
||||
(make-symbol (function (string) symbol))
|
||||
(mark (function (&optional t) (or integer null)))
|
||||
(mark-marker (function () marker))
|
||||
(marker-buffer (function (marker) (or buffer null)))
|
||||
(markerp (function (t) boolean))
|
||||
(max (function ((or number marker) &rest (or number marker)) number))
|
||||
(max-char (function (&optional t) fixnum))
|
||||
(member (function (t list) list))
|
||||
(memory-limit (function () integer))
|
||||
(memq (function (t list) list))
|
||||
(memql (function (t list) list))
|
||||
(min (function ((or number marker) &rest (or number marker)) number))
|
||||
|
|
@ -298,7 +278,6 @@ Used to modify the compiler environment."
|
|||
(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))
|
||||
(next-window (function (&optional window t t) window))
|
||||
|
|
@ -310,9 +289,7 @@ Used to modify the compiler environment."
|
|||
(number-or-marker-p (function (t) boolean))
|
||||
(number-to-string (function (number) string))
|
||||
(numberp (function (t) boolean))
|
||||
(one-window-p (function (&optional t t) boolean))
|
||||
(overlayp (function (t) boolean))
|
||||
(parse-colon-path (function (string) list))
|
||||
(plist-get (function (list t &optional t) t))
|
||||
(plist-member (function (list t &optional t) list))
|
||||
(point (function () integer))
|
||||
|
|
@ -325,13 +302,11 @@ Used to modify the compiler environment."
|
|||
(processp (function (t) boolean))
|
||||
(proper-list-p (function (t) (or fixnum null)))
|
||||
(propertize (function (string &rest t) string))
|
||||
(radians-to-degrees (function (number) float))
|
||||
(rassoc (function (t list) list))
|
||||
(rassq (function (t list) list))
|
||||
(read-from-string (function (string &optional integer integer) cons))
|
||||
(recent-keys (function (&optional (or cons null)) vector))
|
||||
(recursion-depth (function () integer))
|
||||
(regexp-opt (function (list) string))
|
||||
(regexp-quote (function (string) string))
|
||||
(region-beginning (function () integer))
|
||||
(region-end (function () integer))
|
||||
|
|
@ -387,7 +362,6 @@ Used to modify the compiler environment."
|
|||
(upcase (function ((or fixnum string)) (or fixnum string)))
|
||||
(user-full-name (function (&optional integer) (or string null)))
|
||||
(user-login-name (function (&optional integer) (or string null)))
|
||||
(user-original-login-name (function (&optional integer) (or string null)))
|
||||
(user-real-login-name (function () string))
|
||||
(user-real-uid (function () integer))
|
||||
(user-uid (function () integer))
|
||||
|
|
@ -400,13 +374,8 @@ Used to modify the compiler environment."
|
|||
(window-live-p (function (t) boolean))
|
||||
(window-valid-p (function (t) boolean))
|
||||
(windowp (function (t) boolean))
|
||||
(zerop (function (number) boolean))
|
||||
;; Type hints
|
||||
(comp-hint-fixnum (function (t) fixnum))
|
||||
(comp-hint-cons (function (t) cons))
|
||||
;; Non returning functions
|
||||
(throw (function (t t) nil))
|
||||
(error (function (string &rest t) nil))
|
||||
(signal (function (symbol t) nil)))
|
||||
"Alist used for type propagation.")
|
||||
|
||||
|
|
@ -532,22 +501,27 @@ Account for `native-comp-eln-load-path' and `comp-native-version-dir'."
|
|||
(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 (assoc function comp-known-type-specifiers)))
|
||||
This function returns a cons cell whose car is the function specifier,
|
||||
and cdr is a symbol, either `inferred' or `declared'. If the symbol is
|
||||
`inferred', the type specifier is automatically inferred from the code
|
||||
itself by the native compiler; if it is `declared', the type specifier
|
||||
comes from `comp-primitive-type-specifiers' or the function type declaration
|
||||
itself."
|
||||
(let ((kind 'declared)
|
||||
type-spec)
|
||||
(when-let ((res (assoc function comp-primitive-type-specifiers)))
|
||||
;; Declared primitive
|
||||
(setf type-spec (cadr res)))
|
||||
(let ((f (and (symbolp function)
|
||||
(symbol-function function))))
|
||||
(when (and f
|
||||
(null type-spec)
|
||||
(subr-native-elisp-p f))
|
||||
(setf kind 'inferred
|
||||
type-spec (subr-type f))))
|
||||
(when (and f (null type-spec))
|
||||
(if-let ((delc-type (function-get function 'function-type)))
|
||||
;; Declared Lisp function
|
||||
(setf type-spec (car delc-type))
|
||||
(when (subr-native-elisp-p f)
|
||||
;; Native compiled inferred
|
||||
(setf kind 'inferred
|
||||
type-spec (subr-type f))))))
|
||||
(when type-spec
|
||||
(cons type-spec kind))))
|
||||
|
||||
|
|
|
|||
|
|
@ -179,16 +179,24 @@ For internal use by the test suite only.")
|
|||
Each function in FUNCTIONS is run after PASS.
|
||||
Useful to hook into pass checkers.")
|
||||
|
||||
(defconst comp-known-func-cstr-h
|
||||
(defconst comp-primitive-func-cstr-h
|
||||
(cl-loop
|
||||
with comp-ctxt = (make-comp-cstr-ctxt)
|
||||
with h = (make-hash-table :test #'eq)
|
||||
for (f type-spec) in comp-known-type-specifiers
|
||||
for (f type-spec) in comp-primitive-type-specifiers
|
||||
for cstr = (comp-type-spec-to-cstr type-spec)
|
||||
do (puthash f cstr h)
|
||||
finally return h)
|
||||
"Hash table function -> `comp-constraint'.")
|
||||
|
||||
(defun comp--get-function-cstr (function)
|
||||
"Given FUNCTION return the corresponding `comp-constraint'."
|
||||
(when (symbolp function)
|
||||
(let ((f (symbol-function function)))
|
||||
(or (gethash f comp-primitive-func-cstr-h)
|
||||
(when-let ((res (function-get function 'function-type)))
|
||||
(comp-type-spec-to-cstr (car res)))))))
|
||||
|
||||
;; Keep it in sync with the `cl-deftype-satisfies' property set in
|
||||
;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the
|
||||
;; relation type <-> predicate is not bijective (bug#45576).
|
||||
|
|
@ -2102,10 +2110,10 @@ TARGET-BB-SYM is the symbol name of the target block."
|
|||
(when-let ((match
|
||||
(pcase insn
|
||||
(`(set ,lhs (,(pred comp--call-op-p) ,f . ,args))
|
||||
(when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
|
||||
(when-let ((cstr-f (comp--get-function-cstr f)))
|
||||
(cl-values f cstr-f lhs args)))
|
||||
(`(,(pred comp--call-op-p) ,f . ,args)
|
||||
(when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
|
||||
(when-let ((cstr-f (comp--get-function-cstr f)))
|
||||
(cl-values f cstr-f nil args))))))
|
||||
(cl-multiple-value-bind (f cstr-f lhs args) match
|
||||
(cl-loop
|
||||
|
|
@ -2642,7 +2650,7 @@ Fold the call in case."
|
|||
(comp-cstr-imm-vld-p (car args)))
|
||||
(setf f (comp-cstr-imm (car args))
|
||||
args (cdr args)))
|
||||
(when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
|
||||
(when-let ((cstr-f (comp--get-function-cstr f)))
|
||||
(let ((cstr (comp-cstr-f-ret cstr-f)))
|
||||
(when (comp-cstr-empty-p cstr)
|
||||
;; Store it to be rewritten as non local exit.
|
||||
|
|
@ -3301,11 +3309,13 @@ Prepare every function for final compilation and drive the C back-end."
|
|||
;; are assumed just to be true. Use with extreme caution...
|
||||
|
||||
(defun comp-hint-fixnum (x)
|
||||
(declare (gv-setter (lambda (val) `(setf ,x ,val))))
|
||||
(declare (type (function (t) fixnum))
|
||||
(gv-setter (lambda (val) `(setf ,x ,val))))
|
||||
x)
|
||||
|
||||
(defun comp-hint-cons (x)
|
||||
(declare (gv-setter (lambda (val) `(setf ,x ,val))))
|
||||
(declare (type (function (t) cons))
|
||||
(gv-setter (lambda (val) `(setf ,x ,val))))
|
||||
x)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -534,7 +534,8 @@ major mode's decisions about context.")
|
|||
"Return the \"far end\" position of the buffer, in direction ARG.
|
||||
If ARG is positive, that's the end of the buffer.
|
||||
Otherwise, that's the beginning of the buffer."
|
||||
(declare (side-effect-free error-free))
|
||||
(declare (type (function ((or number marker)) integer))
|
||||
(side-effect-free error-free))
|
||||
(if (> arg 0) (point-max) (point-min)))
|
||||
|
||||
(defun end-of-defun (&optional arg interactive)
|
||||
|
|
|
|||
|
|
@ -130,7 +130,8 @@ usually more efficient than that of a simplified version:
|
|||
(concat (car parens)
|
||||
(mapconcat \\='regexp-quote strings \"\\\\|\")
|
||||
(cdr parens))))"
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(declare (type (function (list &optional t) string))
|
||||
(pure t) (side-effect-free t))
|
||||
(save-match-data
|
||||
;; Recurse on the sorted list.
|
||||
(let* ((max-lisp-eval-depth 10000)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue