From f702426780475309bdd33ef896d28dd33484246b Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Sat, 14 Nov 2020 17:38:05 +0100
Subject: [PATCH] Add `comp-constraint-to-type-spec' and better handle boolean
 type spec

	* lisp/emacs-lisp/comp.el (comp-constraint-to-type-spec): New
	function splitting out code from comp-ret-type-spec + better
	handle boolean type specifier.
	(comp-ret-type-spec): Rework to leverage
	`comp-constraint-to-type-spec'.
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add a
	testcase.
---
 lisp/emacs-lisp/comp.el | 66 ++++++++++++++++++++++++-----------------
 test/src/comp-tests.el  |  6 +++-
 2 files changed, 43 insertions(+), 29 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index d75a0547823..da144e4a24f 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -639,6 +639,41 @@ Return the corresponding `comp-constraint' or `comp-constraint-f'."
     h)
   "Hash table function -> `comp-constraint'")
 
+(defun comp-constraint-to-type-spec (mvar)
+  "Given MVAR return its type specifier."
+  (let ((valset (comp-mvar-valset mvar))
+        (typeset (comp-mvar-typeset mvar))
+        (range (comp-mvar-range mvar)))
+
+    (when valset
+      (when (memq nil valset)
+        (if (memq t valset)
+            (progn
+              ;; t and nil are values, convert into `boolean'.
+              (push 'boolean typeset)
+              (setf valset (remove t (remove nil valset))))
+          ;; Only nil is a value, convert it into a `null' type specifier.
+          (setf valset (remove nil valset))
+          (push 'null typeset))))
+
+    ;; Form proper integer type specifiers.
+    (setf range (cl-loop for (l . h) in range
+                             for low = (if (integerp l) l '*)
+                             for high = (if (integerp h) h '*)
+                             collect `(integer ,low , high))
+          valset (cl-remove-duplicates valset))
+
+    ;; Form the final type specifier.
+    (let ((res (append typeset
+                       (when valset
+                         `((member ,@valset)))
+                       range)))
+      (if (> (length res) 1)
+          `(or ,@res)
+        (if (memq (car-safe res) '(member integer))
+            res
+          (car res))))))
+
 (defun comp-set-op-p (op)
   "Assignment predicate for OP."
   (when (memq op comp-limple-sets) t))
@@ -2934,34 +2969,9 @@ Set it into the `ret-type-specifier' slot."
                                do (pcase insn
                                     (`(return ,mvar)
                                      (push `(,mvar . nil) res))))
-                           finally (cl-return res))))
-         (res-valset (comp-mvar-valset res-mvar))
-         (res-typeset (comp-mvar-typeset res-mvar))
-         (res-range (comp-mvar-range res-mvar)))
-    ;; If nil is a value convert it into a `null' type specifier.
-    (when res-valset
-      (when (memq nil res-valset)
-        (setf res-valset (remove nil res-valset))
-        (push 'null res-typeset)))
-
-    ;; Form proper integer type specifiers.
-    (setf res-range (cl-loop for (l . h) in res-range
-                             for low = (if (integerp l) l '*)
-                             for high = (if (integerp h) h '*)
-                             collect `(integer ,low , high))
-          res-valset (cl-remove-duplicates res-valset))
-
-    ;; Form the final type specifier.
-    (let ((res (append res-typeset
-                       (when res-valset
-                         `((member ,@res-valset)))
-                       res-range)))
-      (setf (comp-func-ret-type-specifier func)
-            (if (> (length res) 1)
-                `(or ,@res)
-              (if (memq (car-safe res) '(member integer))
-                  res
-                (car res)))))))
+                           finally (cl-return res)))))
+    (setf (comp-func-ret-type-specifier func)
+          (comp-constraint-to-type-spec res-mvar))))
 
 (defun comp-finalize-container (cont)
   "Finalize data container CONT."
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index a293a490d95..d377b089932 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -880,7 +880,11 @@ Return a list of results."
          (when x
            (setf y x))
          y))
-     t)))
+     t)
+
+    ((defun comp-tests-ret-type-spec-f (x y)
+       (eq x y))
+     boolean)))
 
 (comp-deftest ret-type-spec ()
   "Some derived return type specifier tests."
-- 
2.39.5