feature/native-comp 3f00d66 5/5: Fix missing negation handling in a bunch of predicates

[Andrea Corallo]

branch: feature/native-comp
commit 3f00d666e9674ba18f1ded490a27ac2868a32a88
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    Fix missing negation handling in a bunch of predicates
    
        * lisp/emacs-lisp/comp.el (comp-mvar-fixnum-p)
        (comp-mvar-symbol-p, comp-mvar-cons-p): Consider neg slot.
        * test/src/comp-tests.el (comp-test-not-cons): New test.
        * test/src/comp-test-funcs.el (comp-test-not-cons-f): New
        function.
---
 lisp/emacs-lisp/comp.el     | 21 +++++++++++++--------
 test/src/comp-test-funcs.el |  6 ++++++
 test/src/comp-tests.el      |  3 +++
 3 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index b885ff8..bf26625 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -538,6 +538,8 @@ CFG is mutated by a pass.")
                  (integerp high)
                  (= low high))))))))
 
+;; FIXME move these into cstr?
+
 (defun comp-mvar-value (mvar)
   "Return the constant value of MVAR.
 `comp-mvar-value-vld-p' *must* be satisfied before calling
@@ -556,18 +558,20 @@ CFG is mutated by a pass.")
 
 (defun comp-mvar-fixnum-p (mvar)
   "Return t if MVAR is certainly a fixnum."
-  (when-let (range (comp-mvar-range mvar))
-    (let* ((low (caar range))
-           (high (cdar (last range))))
-      (unless (or (eq low '-)
-                  (< low most-negative-fixnum)
-                  (eq high '+)
-                  (> high most-positive-fixnum))
-        t))))
+  (when (null (comp-mvar-neg mvar))
+    (when-let (range (comp-mvar-range mvar))
+      (let* ((low (caar range))
+             (high (cdar (last range))))
+        (unless (or (eq low '-)
+                    (< low most-negative-fixnum)
+                    (eq high '+)
+                    (> high most-positive-fixnum))
+          t)))))
 
 (defun comp-mvar-symbol-p (mvar)
   "Return t if MVAR is certainly a symbol."
   (and (null (comp-mvar-range mvar))
+       (null (comp-mvar-neg mvar))
        (or (and (null (comp-mvar-valset mvar))
                 (equal (comp-mvar-typeset mvar) '(symbol)))
            (and (or (null (comp-mvar-typeset mvar))
@@ -578,6 +582,7 @@ CFG is mutated by a pass.")
   "Return t if MVAR is certainly a cons."
   (and (null (comp-mvar-valset mvar))
        (null (comp-mvar-range mvar))
+       (null (comp-mvar-neg mvar))
        (equal (comp-mvar-typeset mvar) '(cons))))
 
 (defun comp-mvar-type-hint-match-p (mvar type-hint)
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index 7731e65..49e8076 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -449,6 +449,12 @@
          (setq x (1+ x)))))
     res))
 
+(defun comp-test-not-cons-f (x)
+  ;; Reduced from `cl-copy-list'.
+  (if (consp x)
+      (print x)
+    (car x)))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 240af10..4546ecc 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -479,6 +479,9 @@ 
https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html.";
   "Check cond-rw does not break target blocks with multiple predecessor."
   (should (null (comp-test-cond-rw-1-2-f))))
 
+(comp-deftest comp-test-not-cons ()
+  (should-not (comp-test-not-cons-f nil)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;