From 85daa36c96487b5ba2a7a5bfeea6ae00909ca277 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Wed, 1 May 2024 22:38:09 +0300
Subject: [PATCH] map-leaf-refs: look through mv-bind.

---
 src/compiler/ir1util.lisp  | 41 +++++++++++++++++++++++++++--------------
 tests/compiler-2.pure.lisp | 15 ++++++++++++++-
 2 files changed, 41 insertions(+), 15 deletions(-)

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index f7e919545..2e1bd783c 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -3078,25 +3078,38 @@ is :ANY, the function name is not checked."
                   do (funcall function combination arg))))))))
 
 (defun map-leaf-refs (function leaf)
-  (let* ((seen-calls))
+  (let ((seen-calls))
     (labels ((recur (leaf)
                (dolist (ref (leaf-refs leaf))
                  (let* ((lvar (node-lvar ref))
                         (dest (and lvar
                                    (lvar-dest lvar))))
-                   (if (and (combination-p dest)
-                            (eq (combination-kind dest) :local))
-                       (let ((lambda (combination-lambda dest)))
-                         (when (cond ((functional-kind-eq lambda let))
-                                     ((memq dest seen-calls)
-                                      nil)
-                                     (t
-                                      (push dest seen-calls)))
-                           (loop for v in (lambda-vars lambda)
-                                 for arg in (combination-args dest)
-                                 when (eq arg lvar)
-                                 do (recur v))))
-                       (funcall function dest))))))
+                   (cond ((and (combination-p dest)
+                               (eq (combination-kind dest) :local))
+                          (let ((lambda (combination-lambda dest)))
+                            (when (cond ((functional-kind-eq lambda let))
+                                        ((memq dest seen-calls)
+                                         nil)
+                                        (t
+                                         (push dest seen-calls)))
+                              (loop for v in (lambda-vars lambda)
+                                    for arg in (combination-args dest)
+                                    when (eq arg lvar)
+                                    do (recur v)))))
+                         ((and (combination-p dest)
+                               (lvar-fun-is (combination-fun dest) '(values))
+                               (let ((mv (node-dest dest)))
+                                 (when (and (mv-combination-p mv)
+                                            (eq (basic-combination-kind mv) :local))
+                                   (let ((fun (combination-lambda mv)))
+                                     (when (and (functional-p fun)
+                                                (functional-kind-eq fun mv-let))
+                                       (let* ((arg (position lvar (combination-args dest)))
+                                              (var (and arg (nth arg (lambda-vars fun)))))
+                                         (recur var)
+                                         t)))))))
+                         (t
+                          (funcall function dest)))))))
       (recur leaf))))
 
 (defun propagate-lvar-annotations-to-refs (lvar var)
diff --git a/tests/compiler-2.pure.lisp b/tests/compiler-2.pure.lisp
index 6e9774289..dde6d4ea2 100644
--- a/tests/compiler-2.pure.lisp
+++ b/tests/compiler-2.pure.lisp
@@ -4414,4 +4414,17 @@
            (funcall d f)
            (sort x f)))
     ((nil #'funcall) (condition 'program-error))
-    ((nil #'list) nil)))
+    ((nil #'list) nil))
+  (checked-compile-and-assert
+      (:optimize :default)
+      `(lambda (x d f)
+         (multiple-value-bind (f key)
+             (if f
+                 (values f #'car)
+                 (values (lambda (x y)
+                           (< x y))
+                         #'cdr))
+           (funcall d f)
+           (sort x f :key key)))
+    ((nil #'funcall nil) (condition 'program-error))
+    ((nil #'list nil) nil)))
-- 
2.11.4.GIT