From 3d014e1bf48f661f0b229ddf735608ff0ba7cfe6 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Mon, 1 Mar 2021 19:39:00 +0100
Subject: Fix `eql' `equal' propagation of non hash consed values (bug#46843)

Extend assumes allowing the following form:

(assume dst (and-nhc src1 src2))

`and-nhc' assume operator allow for constraining correctly
intersections where non hash consed values are not propagated as
values but rather promoted to their types.

	* lisp/emacs-lisp/comp-cstr.el
	(comp-cstr-intersection-no-hashcons): New function.
	* lisp/emacs-lisp/comp.el (comp-emit-assume): Logic update to emit
	`and-nhc' operator (implemented in fwprop by
	`comp-cstr-intersection-no-hashcons').
	(comp-add-cond-cstrs): Map `eq' to `and' assume operator and
	`equal' `eql' into `and-nhc'.
	(comp-fwprop-insn): Update to handle `and-nhc'.
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add two
	tests covering `eql' and `equal' propagation of non hash consed
	values.
---
 lisp/emacs-lisp/comp-cstr.el | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'lisp/emacs-lisp/comp-cstr.el')

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index bd1e04fb0bb..d98ef681b58 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -968,6 +968,28 @@ DST is returned."
             (neg dst) (neg res))
       res)))
 
+(defun comp-cstr-intersection-no-hashcons (dst &rest srcs)
+  "Combine SRCS by intersection set operation setting the result in DST.
+Non hash consed values are not propagated as values but rather
+promoted to their types.
+DST is returned."
+  (with-comp-cstr-accessors
+    (apply #'comp-cstr-intersection dst srcs)
+    (let (strip-values strip-types)
+      (cl-loop for v in (valset dst)
+               unless (or (symbolp v)
+                          (fixnump v))
+                 do (push v strip-values)
+                    (push (type-of v) strip-types))
+      (when strip-values
+        (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
+              (valset dst) (cl-set-difference (valset dst) strip-values)))
+      (cl-loop for (l . h) in (range dst)
+               when (or (bignump l) (bignump h))
+                 do (setf (range dst) '((- . +)))
+                    (cl-return))
+      dst)))
+
 (defun comp-cstr-intersection-make (&rest srcs)
   "Combine SRCS by intersection set operation and return a new constraint."
   (apply #'comp-cstr-intersection (make-comp-cstr) srcs))
-- 
cgit v1.2.3