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.

1 files changed, 63 insertions, 19 deletions

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 21c8abad038..48687d92021 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -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