feature/native-comp 6286945 6/6: Normalize cstrs for cache hint effectiveness and test stability

[Andrea Corallo]

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

    Normalize cstrs for cache hint effectiveness and test stability
    
        * lisp/emacs-lisp/comp-cstr.el (comp-normalize-valset)
        (comp-union-valsets, comp-intersection-valsets)
        (comp-normalize-typeset): New functions.
        (comp-union-typesets, comp-intersect-typesets)
        (comp-cstr-union-homogeneous-no-range, comp-cstr-union-1-no-mem):
        Update to return normalized results.
        * test/lisp/emacs-lisp/comp-cstr-tests.el
        (comp-cstr-typespec-tests-alist): Normalize expected type specifiers.
---
 lisp/emacs-lisp/comp-cstr.el            | 57 ++++++++++++++++++++++++---------
 test/lisp/emacs-lisp/comp-cstr-tests.el | 12 +++----
 2 files changed, 48 insertions(+), 21 deletions(-)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 7a55b88..6991c93 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -142,8 +142,33 @@ Return them as multiple value."
    finally (cl-return (cl-values positives negatives))))
 
 
+;;; Value handling.
+
+(defun comp-normalize-valset (valset)
+  "Sort VALSET and return it."
+  (cl-sort valset (lambda (x y)
+                    ;; We might want to use `sxhash-eql' for speed but
+                    ;; this is safer to keep tests stable.
+                    (< (sxhash-equal x)
+                       (sxhash-equal y)))))
+
+(defun comp-union-valsets (&rest valsets)
+  "Union values present into VALSETS."
+  (comp-normalize-valset (cl-reduce #'cl-union valsets)))
+
+(defun comp-intersection-valsets (&rest valsets)
+  "Union values present into VALSETS."
+  (comp-normalize-valset (cl-reduce #'cl-intersection valsets)))
+
+
 ;;; Type handling.
 
+(defun comp-normalize-typeset (typeset)
+  "Sort TYPESET and return it."
+  (cl-sort typeset (lambda (x y)
+                     (string-lessp (symbol-name x)
+                                   (symbol-name y)))))
+
 (defun comp-supertypes (type)
   "Return a list of pairs (supertype . hierarchy-level) for TYPE."
   (cl-loop
@@ -196,8 +221,8 @@ Return them as multiple value."
                       do (setf last x)
                     finally (when last
                               (push last res)))
-                ;; TODO sort.
-                finally (cl-return (cl-remove-duplicates res)))
+                finally (cl-return (comp-normalize-typeset
+                                    (cl-remove-duplicates res))))
                (comp-cstr-ctxt-union-typesets-mem comp-ctxt))))
 
 (defun comp-intersect-typesets (&rest typesets)
@@ -211,7 +236,7 @@ Return them as multiple value."
               ((eq st x) (list y))
               ((eq st y) (list x)))))
          ty)
-      ty)))
+      (comp-normalize-typeset ty))))
 
 
 ;;; Integer range handling
@@ -324,17 +349,18 @@ All SRCS constraints must be homogeneously negated or 
non-negated."
 
   ;; Value propagation.
   (setf (comp-cstr-valset dst)
-        (cl-loop
-         with values = (mapcar #'comp-cstr-valset srcs)
-         ;; TODO sort.
-         for v in (cl-remove-duplicates (apply #'append values)
-                                        :test #'equal)
-         ;; We propagate only values those types are not already
-         ;; into typeset.
-         when (cl-notany (lambda (x)
-                           (comp-subtype-p (type-of v) x))
-                         (comp-cstr-typeset dst))
-         collect v))
+        (comp-normalize-valset
+         (cl-loop
+          with values = (mapcar #'comp-cstr-valset srcs)
+          ;; TODO sort.
+          for v in (cl-remove-duplicates (apply #'append values)
+                                         :test #'equal)
+          ;; We propagate only values those types are not already
+          ;; into typeset.
+          when (cl-notany (lambda (x)
+                            (comp-subtype-p (type-of v) x))
+                          (comp-cstr-typeset dst))
+          collect v)))
 
   dst)
 
@@ -413,7 +439,8 @@ DST is returned."
           ;; Value propagation.
           (cond
            ((and (valset pos) (valset neg)
-                 (equal (cl-union (valset pos) (valset neg)) (valset pos)))
+                 (equal (comp-union-valsets (valset pos) (valset neg))
+                        (valset pos)))
             ;; Pos is a superset of neg.
             (give-up))
            (t
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el 
b/test/lisp/emacs-lisp/comp-cstr-tests.el
index 0c1d27e..392669f 100644
--- a/test/lisp/emacs-lisp/comp-cstr-tests.el
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -45,23 +45,23 @@
     ;; 2
     ((or string array) . array)
     ;; 3
-    ((or symbol number) . (or symbol number))
+    ((or symbol number) . (or number symbol))
     ;; 4
-    ((or cons atom) . (or cons atom)) ;; SBCL return T
+    ((or cons atom) . (or atom cons)) ;; SBCL return T
     ;; 5
     ((or integer number) . number)
     ;; 6
-    ((or (or integer symbol) number) . (or symbol number))
+    ((or (or integer symbol) number) . (or number symbol))
     ;; 7
-    ((or (or integer symbol) (or number list)) . (or list symbol number))
+    ((or (or integer symbol) (or number list)) . (or list number symbol))
     ;; 8
     ((or (or integer number) nil) . number)
     ;; 9
     ((member foo) . (member foo))
     ;; 10
-    ((member foo bar) . (member foo bar))
+    ((member foo bar) . (member bar foo))
     ;; 11
-    ((or (member foo) (member bar)) . (member foo bar))
+    ((or (member foo) (member bar)) . (member bar foo))
     ;; 12
     ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
     ;; 13