Nativecomp don't materialize non-materializable objects (bug#78606)

The native compiler should not try to generate in rendered code
immediate floats produced by the constrain on the '=' operator.

* test/src/comp-tests.el (comp-test-78606-1): Add test.
* test/src/comp-resources/comp-test-funcs.el (comp-test-78606-1-f): New
function.
* src/comp.c (emit_mvar_rval): Check if an immediate is materializable.
* lisp/emacs-lisp/comp.el (comp-ctxt): Add 'non-materializable-objs-h'
slot.
(comp--fwprop-insn): Update call.
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-=): Add parameter.

lisp/emacs-lisp/comp-cstr.el

@@ -986,8 +986,10 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
     (and (comp-cstr-cl-tag-p cstr)
          (intern (match-string 1 (symbol-name (car (valset cstr))))))))
 
-(defun comp-cstr-= (dst op1 op2)
-  "Constraint OP1 being = OP2 setting the result into DST."
+(defun comp-cstr-= (dst op1 op2 nm-objs-h)
+  "Constraint OP1 being = OP2 setting the result into DST.
+NM-OBJS-H is an hash with all the immediates generated at compile time
+which should not be rendered into compiled code."
   (with-comp-cstr-accessors
     (cl-flet ((relax-cstr (cstr)
                 (setf cstr (copy-sequence cstr))
@@ -1015,8 +1017,11 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
                  else
                    do (cl-pushnew 'float (typeset cstr))
                       (cl-return cstr)
-                 finally (setf (valset cstr)
-                               (append vals-to-add (valset cstr))))
+                 finally
+                   (mapc (lambda (x) (puthash x t nm-objs-h))
+                         vals-to-add)
+                   (setf (valset cstr)
+                         (append vals-to-add (valset cstr))))
                 (when (memql 0.0 (valset cstr))
                   (cl-pushnew -0.0 (valset cstr)))
                 (when (memql -0.0 (valset cstr))

lisp/emacs-lisp/comp.el

@@ -398,6 +398,9 @@ Needed to replace immediate byte-compiled lambdas with the compiled reference.")
              :documentation "Standard data relocated in use by functions.")
   (d-ephemeral (make-comp-data-container) :type comp-data-container
                :documentation "Relocated data not necessary after load.")
+  (non-materializable-objs-h (make-hash-table :test #'equal) :type hash-table
+               :documentation "Objects produced by the propagation engine which can't be materialized.
+Typically floating points (which are not cons-hashed).")
   (with-late-load nil :type boolean
                   :documentation "When non-nil support late load."))
 
@@ -2730,7 +2733,8 @@ Fold the call in case."
        (<=
         (comp-cstr-<= lval (car operands) (cadr operands)))
        (=
-        (comp-cstr-= lval (car operands) (cadr operands)))))
+        (comp-cstr-= lval (car operands) (cadr operands)
+                     (comp-ctxt-non-materializable-objs-h comp-ctxt)))))
     (`(setimm ,lval ,v)
      (setf (comp-cstr-imm lval) v))
     (`(phi ,lval . ,rest)

src/comp.c

@@ -1972,27 +1972,32 @@ emit_mvar_rval (Lisp_Object mvar)
   if (!NILP (const_vld))
     {
       Lisp_Object value = CALLNI (comp-cstr-imm, mvar);
-      if (comp.debug > 1)
+      if (NILP (Fgethash (value,
+			  CALLNI (comp-ctxt-non-materializable-objs-h, Vcomp_ctxt),
+			  Qnil)))
 	{
-	  Lisp_Object func =
-	    Fgethash (value,
-		      CALLNI (comp-ctxt-byte-func-to-func-h, Vcomp_ctxt),
-		      Qnil);
+	  if (comp.debug > 1)
+	    {
+	      Lisp_Object func =
+		Fgethash (value,
+			  CALLNI (comp-ctxt-byte-func-to-func-h, Vcomp_ctxt),
+			  Qnil);
 
-	  emit_comment (
-	    SSDATA (
-	      Fprin1_to_string (
-		NILP (func) ? value : CALLNI (comp-func-c-name, func),
-		Qnil, Qnil)));
+	      emit_comment (
+	        SSDATA (
+		  Fprin1_to_string (
+		    NILP (func) ? value : CALLNI (comp-func-c-name, func),
+		    Qnil, Qnil)));
+	    }
+	  if (FIXNUMP (value))
+	    {
+	      /* We can still emit directly objects that are self-contained in a
+		 word (read fixnums).  */
+	      return emit_rvalue_from_lisp_obj (value);
+	    }
+	  /* Other const objects are fetched from the reloc array.  */
+	  return emit_lisp_obj_rval (value);
 	}
-      if (FIXNUMP (value))
-	{
-	  /* We can still emit directly objects that are self-contained in a
-	     word (read fixnums).  */
-          return emit_rvalue_from_lisp_obj (value);
-	}
-      /* Other const objects are fetched from the reloc array.  */
-      return emit_lisp_obj_rval (value);
     }
 
   return gcc_jit_lvalue_as_rvalue (emit_mvar_lval (mvar));

test/src/comp-resources/comp-test-funcs.el

@@ -582,6 +582,12 @@
 (defun comp-test-76573-1-f ()
   (record 'undeclared-type))
 
+(defun comp-test-78606-1-f (x)
+  (and (= x 1)
+       (if (eql x 1)
+           1
+         x)))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

test/src/comp-tests.el

@@ -596,6 +596,11 @@ dedicated byte-op code."
   "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2024-09/msg00794.html>"
   (should (eq (comp-test-73270-1-f (make-comp-test-73270-child4)) 'child4)))
 
+(comp-deftest comp-test-78606-1 ()
+  "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2025-05/msg01270.html>"
+  (should (let ((x 1.0))
+            (eq (comp-test-78606-1-f x) x))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;