Migrate and rename a bunch of functions from comp.el to comp-cstr.el

	* lisp/emacs-lisp/comp-cstr.el (comp-cstr-imm-vld-p)
	(comp-cstr-imm, comp-cstr-fixnum-p, comp-cstr-symbol-p)
	(comp-cstr-cons-p): Move and rename from 'comp.el'.
	* lisp/emacs-lisp/comp.el (comp-mvar-type-hint-match-p)
	(make-comp-mvar, comp-emit-assume, comp-fwprop-prologue)
	(comp-function-foldable-p, comp-function-call-maybe-fold)
	(comp-fwprop-call, comp-fwprop-insn, comp-call-optim-func)
	(comp-compute-function-type): Update for renamed functions.
	* src/comp.c (emit_mvar_rval): Likewise.
	* test/src/comp-tests.el (comp-tests-mentioned-p-1)
	(comp-tests-cond-rw-checker-val): Likewise.

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index c294c53b6b0d4bbe8b7748b55b1fe93474250108..89815f03b534aa0e9db6131519dffe0b741722ae 100644 (file)
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -789,6 +789,76 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
 \f
 ;;; Entry points.
 
+(defun comp-cstr-imm-vld-p (cstr)
+  "Return t if one and only one immediate value can be extracted from CSTR."
+  (with-comp-cstr-accessors
+    (when (and (null (typeset cstr))
+               (null (neg cstr)))
+      (let* ((v (valset cstr))
+             (r (range cstr))
+             (valset-len (length v))
+             (range-len (length r)))
+        (if (and (= valset-len 1)
+                 (= range-len 0))
+            t
+          (when (and (= valset-len 0)
+                     (= range-len 1))
+            (let* ((low (caar r))
+                   (high (cdar r)))
+              (and (integerp low)
+                   (integerp high)
+                   (= low high)))))))))
+
+(defun comp-cstr-imm (cstr)
+  "Return the immediate value of CSTR.
+`comp-cstr-imm-vld-p' *must* be satisfied before calling
+`comp-cstr-imm'."
+  (declare (gv-setter
+            (lambda (val)
+              `(with-comp-cstr-accessors
+                 (if (integerp ,val)
+                     (setf (typeset ,cstr) nil
+                           (range ,cstr) (list (cons ,val ,val)))
+                   (setf (typeset ,cstr) nil
+                         (valset ,cstr) (list ,val)))))))
+  (with-comp-cstr-accessors
+    (let ((v (valset cstr)))
+      (if (= (length v) 1)
+          (car v)
+        (caar (range cstr))))))
+
+(defun comp-cstr-fixnum-p (cstr)
+  "Return t if CSTR is certainly a fixnum."
+  (with-comp-cstr-accessors
+    (when (null (neg cstr))
+      (when-let (range (range cstr))
+        (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-cstr-symbol-p (cstr)
+  "Return t if CSTR is certainly a symbol."
+  (with-comp-cstr-accessors
+    (and (null (range cstr))
+         (null (neg cstr))
+         (or (and (null (valset cstr))
+                  (equal (typeset cstr) '(symbol)))
+             (and (or (null (typeset cstr))
+                      (equal (typeset cstr) '(symbol)))
+                  (cl-every #'symbolp (valset cstr)))))))
+
+(defsubst comp-cstr-cons-p (cstr)
+  "Return t if CSTR is certainly a cons."
+  (with-comp-cstr-accessors
+    (and (null (valset cstr))
+         (null (range cstr))
+         (null (neg cstr))
+         (equal (typeset cstr) '(cons)))))
+
 (defun comp-cstr-> (dst old-dst src)
   "Constraint DST being > than SRC.
 SRC can be either a comp-cstr or an integer."

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 09ae3834922eef64176f73a42569dd9a491fea2b..e71d4abbd535df5bdd3acab0625bef5df5098f4e 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -885,78 +885,12 @@ CFG is mutated by a pass.")
         :documentation "Slot number in the array if a number or
         'scratch' for scratch slot."))
 
-(defun comp-mvar-value-vld-p (mvar)
-  "Return t if one single value can be extracted by the MVAR constrains."
-  (when (and (null (comp-mvar-typeset mvar))
-             (null (comp-mvar-neg mvar)))
-    (let* ((v (comp-mvar-valset mvar))
-           (r (comp-mvar-range mvar))
-           (valset-len (length v))
-           (range-len (length r)))
-      (if (and (= valset-len 1)
-               (= range-len 0))
-          t
-        (when (and (= valset-len 0)
-                   (= range-len 1))
-          (let* ((low (caar r))
-                 (high (cdar r)))
-            (and (integerp low)
-                 (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
-`comp-mvar-const'."
-  (declare (gv-setter
-            (lambda (val)
-              `(if (integerp ,val)
-                   (setf (comp-mvar-typeset ,mvar) nil
-                         (comp-mvar-range ,mvar) (list (cons ,val ,val)))
-                 (setf (comp-mvar-typeset ,mvar) nil
-                       (comp-mvar-valset ,mvar) (list ,val))))))
-  (let ((v (comp-mvar-valset mvar)))
-    (if (= (length v) 1)
-        (car v)
-      (caar (comp-mvar-range mvar)))))
-
-(defun comp-mvar-fixnum-p (mvar)
-  "Return t if MVAR is certainly a fixnum."
-  (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))
-                    (equal (comp-mvar-typeset mvar) '(symbol)))
-                (cl-every #'symbolp (comp-mvar-valset mvar))))))
-
-(defsubst comp-mvar-cons-p (mvar)
-  "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)
   "Match MVAR against TYPE-HINT.
 In use by the backend."
   (cl-ecase type-hint
-    (cons (comp-mvar-cons-p mvar))
-    (fixnum (comp-mvar-fixnum-p mvar))))
+    (cons (comp-cstr-cons-p mvar))
+    (fixnum (comp-cstr-fixnum-p mvar))))
 
 \f
 
@@ -1501,7 +1435,7 @@ STACK-OFF is the index of the first slot frame involved."
   (let ((mvar (make--comp-mvar :slot slot)))
     (when const-vld
       (comp-add-const-to-relocs constant)
-      (setf (comp-mvar-value mvar) constant))
+      (setf (comp-cstr-imm mvar) constant))
     (when type
       (setf (comp-mvar-typeset mvar) (list type)))
     mvar))
@@ -2351,8 +2285,8 @@ The assume is emitted at the beginning of the block BB."
                      kind)))
          (push `(assume ,(make-comp-mvar :slot lhs-slot)
                         (,kind ,lhs
-                               ,(if-let* ((vld (comp-mvar-value-vld-p rhs))
-                                          (val (comp-mvar-value rhs))
+                               ,(if-let* ((vld (comp-cstr-imm-vld-p rhs))
+                                          (val (comp-cstr-imm rhs))
                                           (ok (integerp val)))
                                     val
                                   (make-comp-mvar :slot (comp-mvar-slot rhs)))))
@@ -3077,7 +3011,7 @@ Forward propagate immediate involed in assignments."
        for insn in (comp-block-insns b)
        do (pcase insn
             (`(setimm ,lval ,v)
-             (setf (comp-mvar-value lval) v))))))
+             (setf (comp-cstr-imm lval) v))))))
 
 (defun comp-mvar-propagate (lval rval)
   "Propagate into LVAL properties of RVAL."
@@ -3089,7 +3023,7 @@ Forward propagate immediate involed in assignments."
 (defun comp-function-foldable-p (f args)
   "Given function F called with ARGS return non-nil when optimizable."
   (and (comp-function-pure-p f)
-       (cl-every #'comp-mvar-value-vld-p args)))
+       (cl-every #'comp-cstr-imm-vld-p args)))
 
 (defun comp-function-call-maybe-fold (insn f args)
   "Given INSN when F is pure if all ARGS are known remove the function call.
@@ -3102,10 +3036,10 @@ Return non-nil if the function is folded successfully."
     (cond
      ((eq f 'symbol-value)
       (when-let* ((arg0 (car args))
-                  (const (comp-mvar-value-vld-p arg0))
-                  (ok-to-optim (member (comp-mvar-value arg0)
+                  (const (comp-cstr-imm-vld-p arg0))
+                  (ok-to-optim (member (comp-cstr-imm arg0)
                                        comp-symbol-values-optimizable)))
-        (rewrite-insn-as-setimm insn (symbol-value (comp-mvar-value
+        (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm
                                                     (car args))))))
      ((comp-function-foldable-p f args)
       (ignore-errors
@@ -3118,7 +3052,7 @@ Return non-nil if the function is folded successfully."
                       ;; and know to be pure.
                       (comp-func-byte-func f-in-ctxt)
                     f))
-               (value (comp-apply-in-env f (mapcar #'comp-mvar-value args))))
+               (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args))))
           (rewrite-insn-as-setimm insn value)))))))
 
 (defun comp-fwprop-call (insn lval f args)
@@ -3127,8 +3061,8 @@ F is the function being called with arguments ARGS.
 Fold the call in case."
   (unless (comp-function-call-maybe-fold insn f args)
     (when (and (eq 'funcall f)
-               (comp-mvar-value-vld-p (car args)))
-      (setf f (comp-mvar-value (car args))
+               (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)))
       (let ((cstr (comp-cstr-f-ret cstr-f)))
@@ -3176,7 +3110,7 @@ Fold the call in case."
        (<=
         (comp-cstr-<= lval (car operands) (cadr operands)))))
     (`(setimm ,lval ,v)
-     (setf (comp-mvar-value lval) v))
+     (setf (comp-cstr-imm lval) v))
     (`(phi ,lval . ,rest)
      (let* ((from-latch (cl-some
                          (lambda (x)
@@ -3337,11 +3271,11 @@ FUNCTION can be a function-name or byte compiled function."
         (pcase insn
           (`(set ,lval (callref funcall ,f . ,rest))
            (when-let ((new-form (comp-call-optim-form-call
-                                 (comp-mvar-value f) rest)))
+                                 (comp-cstr-imm f) rest)))
              (setf insn `(set ,lval ,new-form))))
           (`(callref funcall ,f . ,rest)
            (when-let ((new-form (comp-call-optim-form-call
-                                 (comp-mvar-value f) rest)))
+                                 (comp-cstr-imm f) rest)))
              (setf insn new-form)))))))
 
 (defun comp-call-optim (_)
@@ -3539,7 +3473,7 @@ Set it into the `type' slot."
                             ,(comp-cstr-to-type-spec res-mvar))))
       (comp-add-const-to-relocs type)
       ;; Fix it up.
-      (setf (comp-mvar-value (comp-func-type func)) type))))
+      (setf (comp-cstr-imm (comp-func-type func)) type))))
 
 (defun comp-finalize-container (cont)
   "Finalize data container CONT."

diff --git a/src/comp.c b/src/comp.c
index 1a89e4e62a442711a0d2335c08b949118c62b143..21d1c1a23cf0eea1a491b66593b3a1259376f9bb 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -1747,11 +1747,11 @@ emit_PURE_P (gcc_jit_rvalue *ptr)
 static gcc_jit_rvalue *
 emit_mvar_rval (Lisp_Object mvar)
 {
-  Lisp_Object const_vld = CALL1I (comp-mvar-value-vld-p, mvar);
+  Lisp_Object const_vld = CALL1I (comp-cstr-imm-vld-p, mvar);
 
   if (!NILP (const_vld))
     {
-      Lisp_Object value = CALL1I (comp-mvar-value, mvar);
+      Lisp_Object value = CALL1I (comp-cstr-imm, mvar);
       if (comp.debug > 1)
        {
          Lisp_Object func =

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index fa84ffbc0bf13a2142d15a0dd01af3be2e7adfd4..402ba7cd8b8ab42e673642cd94cce00d0cc50a79 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -739,8 +739,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-value-vld-p y))
-                  (equal (comp-mvar-value y) x))
+                 ((and (comp-mvar-p y) (comp-cstr-imm-vld-p y))
+                  (equal (comp-cstr-imm y) x))
                  (t (equal x y)))
              return t))
 
@@ -1313,8 +1313,8 @@ Return a list of results."
      (lambda (insn)
        (pcase insn
          (`(return ,mvar)
-          (and (comp-mvar-value-vld-p mvar)
-               (eql (comp-mvar-value mvar) 123)))))))))
+          (and (comp-cstr-imm-vld-p mvar)
+               (eql (comp-cstr-imm mvar) 123)))))))))
 
 (defvar comp-tests-cond-rw-expected-type nil
   "Type to expect in `comp-tests-cond-rw-checker-type'.")