mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-26 23:20:29 -08:00
Add initial nativecomp typeset and range propagation support
This commit add an initial support for a better type propagation and integer range propagation. Each mvar can be now characterized by a set of types, a set of values and an integral range. * lisp/emacs-lisp/comp.el (comp-known-ret-types): Store into typeset and remove fixnum. (comp-known-ret-ranges, comp-type-predicates): New variables. (comp-ctxt): Remove supertype-memoize slot and add union-typesets-mem. (comp-mvar): Remove const-vld, constant, type slots. Add typeset, valset, range slots. (comp-mvar-value-vld-p, comp-mvar-value, comp-mvar-fixnum-p) (comp-mvar-symbol-p, comp-mvar-cons-p) (comp-mvar-type-hint-match-p, comp-func-ret-typeset) (comp-func-ret-range): New functions. (make-comp-mvar, make-comp-ssa-mvar): Update logic. (comp--typeof-types): New variable. (comp-supertypes, comp-common-supertype): Logic update. (comp-subtype-p, comp-union-typesets, comp-range-1+) (comp-range-1-, comp-range-<, comp-range-union) (comp-range-intersection): New functions. (comp-fwprop-prologue, comp-mvar-propagate) (comp-function-foldable-p, comp-function-call-maybe-fold) (comp-fwprop-insn, comp-call-optim-func, comp-finalize-relocs): Logic update. * src/comp.c (emit_mvar_rval, emit_call_with_type_hint) (emit_call2_with_type_hint): Logic update. * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Undo the add of fixnum and bignum as unnecessary. * test/src/comp-tests.el (comp-tests-mentioned-p-1, comp-tests-cond-rw-checker-val) (comp-tests-cond-rw-checker-type, cond-rw-1, cond-rw-2) (cond-rw-3, cond-rw-4, cond-rw-5): Update for new type interface. (range-simple-union, range-simple-intersection): New integer range tests. (union-types): New union type test.
This commit is contained in:
Andrea Corallo
parent
c3d0e2a09f
commit
e96cd4e82c
4 changed files with 347 additions and 112 deletions
|
|
@ -37,7 +37,7 @@
|
|||
(defconst comp-test-dyn-src
|
||||
(concat comp-test-directory "comp-test-funcs-dyn.el"))
|
||||
|
||||
(when (boundp 'comp-ctxt)
|
||||
(when (featurep 'nativecomp)
|
||||
(message "Compiling tests...")
|
||||
(load (native-compile comp-test-src))
|
||||
(load (native-compile comp-test-dyn-src)))
|
||||
|
|
@ -676,8 +676,8 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
|
|||
(cl-loop for y in insn
|
||||
when (cond
|
||||
((consp y) (comp-tests-mentioned-p x y))
|
||||
((and (comp-mvar-p y) (comp-mvar-const-vld y))
|
||||
(equal (comp-mvar-constant y) x))
|
||||
((and (comp-mvar-p y) (comp-mvar-value-vld-p y))
|
||||
(equal (comp-mvar-value y) x))
|
||||
(t (equal x y)))
|
||||
return t))
|
||||
|
||||
|
|
@ -804,8 +804,8 @@ Return a list of results."
|
|||
(lambda (insn)
|
||||
(pcase insn
|
||||
(`(return ,mvar)
|
||||
(and (comp-mvar-const-vld mvar)
|
||||
(= (comp-mvar-constant mvar) 123)))))))))
|
||||
(and (comp-mvar-value-vld-p mvar)
|
||||
(eql (comp-mvar-value mvar) 123)))))))))
|
||||
|
||||
(defvar comp-tests-cond-rw-expected-type nil
|
||||
"Type to expect in `comp-tests-cond-rw-checker-type'.")
|
||||
|
|
@ -819,7 +819,8 @@ Return a list of results."
|
|||
(lambda (insn)
|
||||
(pcase insn
|
||||
(`(return ,mvar)
|
||||
(eq (comp-mvar-type mvar) comp-tests-cond-rw-expected-type))))))))
|
||||
(equal (comp-mvar-typeset mvar)
|
||||
comp-tests-cond-rw-expected-type))))))))
|
||||
|
||||
(defvar comp-tests-cond-rw-0-var)
|
||||
(comp-deftest cond-rw-0 ()
|
||||
|
|
@ -839,40 +840,39 @@ Return a list of results."
|
|||
(comp-deftest cond-rw-1 ()
|
||||
"Test cond-rw pass allow us to propagate type+val under `eq' tests."
|
||||
(let ((lexical-binding t)
|
||||
(comp-tests-cond-rw-expected-type 'fixnum)
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type)
|
||||
(comp-final comp-tests-cond-rw-checker-val))))
|
||||
(comp-tests-cond-rw-expected-type '(integer))
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type
|
||||
comp-tests-cond-rw-checker-val))))
|
||||
(subr-native-elisp-p (native-compile '(lambda (x) (if (eq x 123) x t))))
|
||||
(subr-native-elisp-p (native-compile '(lambda (x) (if (eq 123 x) x t))))))
|
||||
|
||||
(comp-deftest cond-rw-2 ()
|
||||
"Test cond-rw pass allow us to propagate type+val under `=' tests."
|
||||
(let ((lexical-binding t)
|
||||
(comp-tests-cond-rw-expected-type 'fixnum)
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type)
|
||||
(comp-final comp-tests-cond-rw-checker-val))))
|
||||
(comp-tests-cond-rw-expected-type '(integer))
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type
|
||||
comp-tests-cond-rw-checker-val))))
|
||||
(subr-native-elisp-p (native-compile '(lambda (x) (if (= x 123) x t))))))
|
||||
|
||||
(comp-deftest cond-rw-3 ()
|
||||
"Test cond-rw pass allow us to propagate type+val under `eql' tests."
|
||||
(let ((lexical-binding t)
|
||||
(comp-tests-cond-rw-expected-type 'fixnum)
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type)
|
||||
(comp-final comp-tests-cond-rw-checker-val))))
|
||||
(comp-tests-cond-rw-expected-type '(integer))
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type
|
||||
comp-tests-cond-rw-checker-val))))
|
||||
(subr-native-elisp-p (native-compile '(lambda (x) (if (eql 123 x) x t))))))
|
||||
|
||||
(comp-deftest cond-rw-4 ()
|
||||
"Test cond-rw pass allow us to propagate type under `=' tests."
|
||||
(let ((lexical-binding t)
|
||||
(comp-tests-cond-rw-expected-type 'number)
|
||||
(comp-tests-cond-rw-expected-type '(number))
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type))))
|
||||
(subr-native-elisp-p (native-compile '(lambda (x y) (if (= x y) x t))))))
|
||||
|
||||
(comp-deftest cond-rw-5 ()
|
||||
"Test cond-rw pass allow us to propagate type under `=' tests."
|
||||
(let ((lexical-binding t)
|
||||
(comp-tests-cond-rw-checked-function #'comp-tests-cond-rw-4-f)
|
||||
(comp-tests-cond-rw-expected-type 'fixnum)
|
||||
(let ((comp-tests-cond-rw-checked-function #'comp-tests-cond-rw-4-f)
|
||||
(comp-tests-cond-rw-expected-type '(integer))
|
||||
(comp-post-pass-hooks '((comp-final comp-tests-cond-rw-checker-type))))
|
||||
(eval '(defun comp-tests-cond-rw-4-f (x y)
|
||||
(declare (speed 3))
|
||||
|
|
@ -883,4 +883,48 @@ Return a list of results."
|
|||
(native-compile #'comp-tests-cond-rw-4-f)
|
||||
(should (subr-native-elisp-p (symbol-function #'comp-tests-cond-rw-4-f)))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Range propagation tests. ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(comp-deftest range-simple-union ()
|
||||
(should (equal (comp-range-union '((-1 . 0)) '((3 . 4)))
|
||||
'((-1 . 0) (3 . 4))))
|
||||
(should (equal (comp-range-union '((-1 . 2)) '((3 . 4)))
|
||||
'((-1 . 4))))
|
||||
(should (equal (comp-range-union '((-1 . 3)) '((3 . 4)))
|
||||
'((-1 . 4))))
|
||||
(should (equal (comp-range-union '((-1 . 4)) '((3 . 4)))
|
||||
'((-1 . 4))))
|
||||
(should (equal (comp-range-union '((-1 . 5)) '((3 . 4)))
|
||||
'((-1 . 5))))
|
||||
(should (equal (comp-range-union '((-1 . 0)) '())
|
||||
'((-1 . 0)))))
|
||||
|
||||
(comp-deftest range-simple-intersection ()
|
||||
(should (equal (comp-range-intersection '((-1 . 0)) '((3 . 4)))
|
||||
'()))
|
||||
(should (equal (comp-range-intersection '((-1 . 2)) '((3 . 4)))
|
||||
'()))
|
||||
(should (equal (comp-range-intersection '((-1 . 3)) '((3 . 4)))
|
||||
'((3 . 3))))
|
||||
(should (equal (comp-range-intersection '((-1 . 4)) '((3 . 4)))
|
||||
'((3 . 4))))
|
||||
(should (equal (comp-range-intersection '((-1 . 5)) '((3 . 4)))
|
||||
'((3 . 4))))
|
||||
(should (equal (comp-range-intersection '((-1 . 0)) '())
|
||||
'())))
|
||||
|
||||
(comp-deftest union-types ()
|
||||
(let ((comp-ctxt (make-comp-ctxt)))
|
||||
(should (equal (comp-union-typesets '(integer) '(number))
|
||||
'(number)))
|
||||
(should (equal (comp-union-typesets '(integer symbol) '(number))
|
||||
'(symbol number)))
|
||||
(should (equal (comp-union-typesets '(integer symbol) '(number list))
|
||||
'(list symbol number)))
|
||||
(should (equal (comp-union-typesets '(integer symbol) '())
|
||||
'(symbol integer)))))
|
||||
|
||||
;;; comp-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue