mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 04:21:24 +00:00
Use declared function types for native-comp propagation
* lisp/emacs-lisp/comp.el (comp--intern-func-in-ctxt): Recover declared function types from `function-type' properties. (comp--declared-arg-type-gen): New function. (comp--emit-declared-arg-type-assumption): New function. (comp--emit-narg-prologue, comp--limplify-function): Propagate declared parameter types at speed 2 and above. * test/src/comp-tests.el (comp-tests-check-ret-type-spec): Preserve `function-type' properties across tests and accept an optional speed. (comp-tests-speed-1-declared-param-type): New test. (comp-tests-type-spec-tests): Add declared parameter type tests. * etc/NEWS: Document it. * etc/TODO: Remove declared function parameter entry.
This commit is contained in:
Andrea Corallo
parent
f15ad18a14
commit
fe121ef586
4 changed files with 85 additions and 22 deletions
6
etc/NEWS
6
etc/NEWS
|
|
@ -3879,6 +3879,12 @@ coding mistakes. For example,
|
|||
|
||||
may return either nil or t.
|
||||
|
||||
---
|
||||
** Native compilation now uses declared function parameter types more.
|
||||
At native compilation speed 2 and above, declared function types are
|
||||
used for type propagation, value prediction, and optimization within
|
||||
function bodies.
|
||||
|
||||
** Nested backquotes are not supported any more in Pcase patterns.
|
||||
|
||||
---
|
||||
|
|
|
|||
6
etc/TODO
6
etc/TODO
|
|
@ -1010,12 +1010,6 @@ libgccjit. Two simple first candidates are probably 'maybe_quit' and
|
|||
|
||||
*** Features to be improved or missing
|
||||
|
||||
**** Make use of function type declaration
|
||||
|
||||
The native compiler should make use of function type declarations (when
|
||||
available) to propagate parameter types inside the function for better
|
||||
value/type predictions.
|
||||
|
||||
**** Fix portable dumping so that you can redump without using -batch
|
||||
|
||||
***** Redumps and native compiler "preloaded" sub-folder.
|
||||
|
|
|
|||
|
|
@ -843,7 +843,9 @@ clashes."
|
|||
(comp-func-frame-size func) (comp--byte-frame-size byte-func)
|
||||
(comp-func-speed func) (comp--spill-speed name)
|
||||
(comp-func-safety func) (comp--spill-safety name)
|
||||
(comp-func-declared-type func) (comp--spill-decl-spec name 'function-type)
|
||||
(comp-func-declared-type func)
|
||||
(or (comp--spill-decl-spec name 'function-type)
|
||||
(and name (function-get name 'function-type)))
|
||||
(comp-func-pure func) (comp--spill-decl-spec name 'pure))
|
||||
|
||||
;; Store the c-name to have it retrievable from
|
||||
|
|
@ -1516,17 +1518,46 @@ and the annotation emission."
|
|||
(incf (comp--sp) (- arg))
|
||||
(comp--copy-slot (+ arg (comp--sp)))))))
|
||||
|
||||
(defun comp--emit-narg-prologue (minarg nonrest rest)
|
||||
(defun comp--declared-arg-type-gen (func)
|
||||
"Return a generator over FUNC declared argument types."
|
||||
(when-let* (((>= (comp-func-speed func) 2))
|
||||
(declared-type (comp-func-declared-type func))
|
||||
(cstr-f (comp-type-spec-to-cstr declared-type)))
|
||||
(cl-assert (comp-cstr-f-p cstr-f))
|
||||
(comp--lambda-list-gen (comp-cstr-f-args cstr-f))))
|
||||
|
||||
(defun comp--emit-declared-arg-type-assumption (mvar declared-arg-type-gen
|
||||
&optional optional)
|
||||
"Emit a declared argument type assumption for MVAR.
|
||||
When OPTIONAL is non-nil, account for omitted optional arguments by
|
||||
allowing nil as well."
|
||||
(when-let* ((declared-arg-type-gen declared-arg-type-gen)
|
||||
(cstr (funcall declared-arg-type-gen)))
|
||||
(when (comp-cstr-p cstr)
|
||||
(when optional
|
||||
(setf cstr (comp--cstr-union-make cstr (comp--value-to-cstr nil))))
|
||||
(unless (equal cstr comp-cstr-t)
|
||||
(let ((target (make--comp-mvar :slot (comp-mvar-slot mvar))))
|
||||
(comp--emit `(assume ,target (and ,target ,cstr))))))))
|
||||
|
||||
(defun comp--emit-narg-prologue (minarg nonrest rest
|
||||
&optional declared-arg-type-gen)
|
||||
"Emit the prologue for a narg function."
|
||||
(cl-loop for i below minarg
|
||||
do (comp--emit `(set-args-to-local ,(comp--slot-n i)))
|
||||
for target = (comp--slot-n i)
|
||||
do (comp--emit `(set-args-to-local ,target))
|
||||
(comp--emit-declared-arg-type-assumption
|
||||
target declared-arg-type-gen)
|
||||
(comp--emit '(inc-args)))
|
||||
(cl-loop for i from minarg below nonrest
|
||||
for bb = (intern (format "entry_%s" i))
|
||||
for fallback = (intern (format "entry_fallback_%s" i))
|
||||
do (comp--emit `(cond-jump-narg-leq ,i ,fallback ,bb))
|
||||
(comp--make-curr-block bb (comp--sp))
|
||||
(comp--emit `(set-args-to-local ,(comp--slot-n i)))
|
||||
(let ((target (comp--slot-n i)))
|
||||
(comp--emit `(set-args-to-local ,target))
|
||||
(comp--emit-declared-arg-type-assumption
|
||||
target declared-arg-type-gen))
|
||||
(comp--emit '(inc-args))
|
||||
finally (comp--emit '(jump entry_rest_args)))
|
||||
(when (/= minarg nonrest)
|
||||
|
|
@ -1752,14 +1783,20 @@ into the C code forwarding the compilation unit."
|
|||
(symbol-name (comp-func-name func))))
|
||||
;; Dynamic functions have parameters bound by the trampoline.
|
||||
(when (comp-func-l-p func)
|
||||
(let ((args (comp-func-l-args func)))
|
||||
(let ((args (comp-func-l-args func))
|
||||
(declared-arg-type-gen (comp--declared-arg-type-gen func)))
|
||||
(if (comp-args-p args)
|
||||
(cl-loop for i below (comp-args-max args)
|
||||
do (incf (comp--sp))
|
||||
(comp--emit `(set-par-to-local ,(comp--slot) ,i)))
|
||||
(let ((target (comp--slot)))
|
||||
(comp--emit `(set-par-to-local ,target ,i))
|
||||
(comp--emit-declared-arg-type-assumption
|
||||
target declared-arg-type-gen
|
||||
(>= i (comp-args-base-min args)))))
|
||||
(comp--emit-narg-prologue (comp-args-base-min args)
|
||||
(comp-nargs-nonrest args)
|
||||
(comp-nargs-rest args)))))
|
||||
(comp-nargs-rest args)
|
||||
declared-arg-type-gen))))
|
||||
(comp--emit '(jump bb_0))
|
||||
;; Body
|
||||
(comp--bb-maybe-add 0 (comp--sp))
|
||||
|
|
|
|||
|
|
@ -940,15 +940,31 @@ Return a list of results."
|
|||
(comp-tests--types-equal (nth 2 t1) (nth 2 t2))))
|
||||
(t (comp-tests--type-lists-equal (cdr t1) (cdr t2)))))))
|
||||
|
||||
(defun comp-tests-check-ret-type-spec (func-form ret-type)
|
||||
(defun comp-tests-check-ret-type-spec (func-form ret-type &optional speed)
|
||||
(let ((lexical-binding t)
|
||||
(native-comp-speed 2)
|
||||
(f-name (cl-second func-form)))
|
||||
(eval func-form t)
|
||||
(native-compile f-name)
|
||||
(should (comp-tests--types-equal
|
||||
(cl-third (subr-type (symbol-function f-name)))
|
||||
ret-type))))
|
||||
(native-comp-speed (or speed 2))
|
||||
(f-name (cl-second func-form))
|
||||
(old-function-type nil))
|
||||
(when (symbolp f-name)
|
||||
(setq old-function-type (function-get f-name 'function-type)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(eval func-form t)
|
||||
(native-compile f-name)
|
||||
(should (comp-tests--types-equal
|
||||
(cl-third (subr-type (symbol-function f-name)))
|
||||
ret-type)))
|
||||
(when (symbolp f-name)
|
||||
(function-put f-name 'function-type old-function-type)))))
|
||||
|
||||
(comp-deftest speed-1-declared-param-type ()
|
||||
(let ((comp-ctxt (make-comp-cstr-ctxt)))
|
||||
(comp-tests-check-ret-type-spec
|
||||
'(defun comp-tests-ret-type-spec-f (x)
|
||||
(declare (ftype (function (string) t)))
|
||||
x)
|
||||
't
|
||||
1)))
|
||||
|
||||
(cl-eval-when (compile eval load)
|
||||
(cl-defstruct comp-foo a b)
|
||||
|
|
@ -1526,7 +1542,17 @@ Return a list of results."
|
|||
((defun comp-tests-ret-type-spec-f (x)
|
||||
(print (comp-foo-p x))
|
||||
(comp-foo-p x))
|
||||
'boolean)))
|
||||
'boolean)
|
||||
;; 82
|
||||
((defun comp-tests-ret-type-spec-f (x)
|
||||
(declare (ftype (function (string) t)))
|
||||
x)
|
||||
'string)
|
||||
;; 83
|
||||
((defun comp-tests-ret-type-spec-f (&optional x)
|
||||
(declare (ftype (function (&optional string) t)))
|
||||
x)
|
||||
'(or null string))))
|
||||
|
||||
(defun comp-tests-define-type-spec-test (number x)
|
||||
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue