mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
Make use of Lisp function declarations
* lisp/emacs-lisp/comp.el (comp-primitive-func-cstr-h): Rename. (comp--get-function-cstr): Define new function. (comp--add-call-cstr, comp--fwprop-call): Update. * lisp/emacs-lisp/comp-common.el (comp-function-type-spec): Update. * lisp/help-fns.el (help-fns--signature): Mention when a type is declared. * lisp/emacs-lisp/comp.el (comp-primitive-func-cstr-h): Rename.
This commit is contained in:
parent
1c7b809983
commit
d8c941df7d
@ -532,22 +532,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 )
|
||||
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-known-type-specifiers' or the function type declaration
|
||||
itself."
|
||||
(let ((kind 'declared)
|
||||
type-spec)
|
||||
(when-let ((res (assoc function comp-known-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 'declared-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 'declared-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.
|
||||
|
@ -734,7 +734,7 @@ the C sources, too."
|
||||
(insert (format
|
||||
(if (eq kind 'inferred)
|
||||
"\nInferred type: %s\n"
|
||||
"\nType: %s\n")
|
||||
"\nDeclared type: %s\n")
|
||||
type-spec))))
|
||||
(fill-region fill-begin (point))
|
||||
high-doc)))))
|
||||
|
Loading…
Reference in New Issue
Block a user