From f9db80dcbf929bf99e78e83a140aec3d22374477 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Tue, 5 May 2020 19:40:41 +0200
Subject: [PATCH] cmp: for LAMBDA use an associated function-block-name

That makes lambda with a declaration si:function-block-name behave
consistently with ext:lambda-block (and in eval-macros
ext:lambda-block expands to have this declaration too to behave in
turn consistently with how the compiler treats ext:lambda-block).
---
 src/cmp/cmpspecial.lsp | 10 +++++++---
 src/lsp/evalmacros.lsp |  8 +++++---
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/src/cmp/cmpspecial.lsp b/src/cmp/cmpspecial.lsp
index 7dc2f3d10..82d2441c2 100644
--- a/src/cmp/cmpspecial.lsp
+++ b/src/cmp/cmpspecial.lsp
@@ -85,9 +85,13 @@
            (cmpck (endp (cdr fun))
                   "The lambda expression ~s is illegal." fun)
            (let (name body)
-             (if (eq (first fun) 'EXT::LAMBDA)
-                 (setf name (gensym) body (rest fun))
-                 (setf name (second fun) body (cddr fun)))
+             (if (eq (first fun) 'lambda)
+                 (let ((decl (si::process-declarations (cddr fun))))
+                   (setf name (or (function-block-name-declaration decl)
+                                  (gensym "LAMBDA"))
+                         body (rest fun)))
+                 (setf name (second fun)
+                       body (cddr fun)))
              (c1expr `(flet ((,name ,@body)) #',name))))
           (t (cmperr "The function ~s is illegal." fun)))))
 
diff --git a/src/lsp/evalmacros.lsp b/src/lsp/evalmacros.lsp
index 1e17bab1b..98b2453b6 100644
--- a/src/lsp/evalmacros.lsp
+++ b/src/lsp/evalmacros.lsp
@@ -162,9 +162,11 @@ terminated by a non-local exit."
 (defmacro lambda-block (name lambda-list &rest lambda-body)
   (multiple-value-bind (decl body doc)
       (si::process-declarations lambda-body)
-    (when decl (setq decl (list (cons 'declare decl))))
-    `(lambda ,lambda-list ,@doc ,@decl
-      (block ,(si::function-block-name name) ,@body))))
+    (let ((decl (and decl (list (cons 'declare decl))))
+          (block-name (si:function-block-name name)))
+      `(lambda ,lambda-list ,@doc ,@decl
+         (declare (si::function-block-name ,block-name))
+         (block ,block-name ,@body)))))
 
 ; assignment