Comp: Fix limplification pass (bug#62537)

* test/src/comp-resources/comp-test-funcs.el (comp-test-62537-1-f)
(comp-test-62537-2-f): New functions.

* lisp/emacs-lisp/comp.el (comp-jump-table-optimizable): Make it
stricter add a comment.

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 841b0ebf29d3f18a642d971d310ff1644b78bb25..025d21631bb38068c97923e868e07853161c2aaf 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1712,6 +1712,10 @@ Return value is the fall-through block name."
 
 (defun comp-jump-table-optimizable (jmp-table)
   "Return t if JMP-TABLE can be optimized out."
+  ;; Identify LAP sequences like:
+  ;; (byte-constant #s(hash-table size 3 test eq rehash-size 1.5 rehash-threshold 0.8125 purecopy t data (created 126 deleted 126 changed 126)) . 24)
+  ;; (byte-switch)
+  ;; (TAG 126 . 10)
   (cl-loop
    with labels = (cl-loop for target-label being each hash-value of jmp-table
                           collect target-label)
@@ -1719,7 +1723,10 @@ Return value is the fall-through block name."
    for l in (cdr-safe labels)
    unless (= l x)
      return nil
-   finally return t))
+   finally return (pcase (nth (1+ (comp-limplify-pc comp-pass))
+                              (comp-func-lap comp-func))
+                    (`(TAG ,label . ,_label-sp)
+                     (= label l)))))
 
 (defun comp-emit-switch (var last-insn)
   "Emit a Limple for a lap jump table given VAR and LAST-INSN."

diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el
index fff881dd595b0a9b05c9dec84e6340f7bb4fff5a..73da7182a54408d5ae1791a9e5e9b09a5b1e7064 100644 (file)
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -518,6 +518,19 @@
 (defun comp-test-48029-nonascii-žžž-f (arg)
   (when arg t))
 
+(defun comp-test-62537-1-f ())
+
+(defun comp-test-62537-2-f ()
+  (when (let ((val (comp-test-62537-1-f)))
+         (cond
+          ((eq val 'x)
+           t)
+          ((eq val 'y)
+           'y)))
+    (comp-test-62537-1-f))
+  t)
+
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;