From eeae91063575f1a8fdf9e24d80f668748999a6b6 Mon Sep 17 00:00:00 2001
From: cxxxr <g23tlm@gmail.com>
Date: Sun, 17 Dec 2023 16:52:34 +0900
Subject: [PATCH] micros/walker: fix walker for sb-int:named-lambda

---
 contrib/walker/walker.lisp | 39 +++++++++++++++++++++++---------------
 1 file changed, 24 insertions(+), 15 deletions(-)

diff --git a/contrib/walker/walker.lisp b/contrib/walker/walker.lisp
index 5b25f3e..17581fd 100644
--- a/contrib/walker/walker.lisp
+++ b/contrib/walker/walker.lisp
@@ -526,23 +526,32 @@
                            :path path)
             env)))
 
+(defun walk-lambda-list-and-body (walker lambda-list body env path)
+  (multiple-value-bind (body declare-forms documentation)
+      (parse-body body :documentation t)
+    (let ((declaration-spec (parse-declaration-specifiers declare-forms)))
+      (multiple-value-bind (lambda-list env)
+          (walk-lambda-list walker
+                            lambda-list
+                            env
+                            (cons 1 path)
+                            :declaration-spec declaration-spec)
+        (make-instance 'lambda-form
+                       :documentation documentation
+                       :lambda-list lambda-list
+                       :body (walk-forms walker body env path (+ 2 (length declare-forms)))
+                       :path (cons 0 path))))))
+
 (defmethod walk-lambda-form ((walker walker) form env path)
   (assert-type (first form) '(member lambda #+sbcl sb-int:named-lambda))
-  (with-walker-bindings (lambda-list &body body) (rest form)
-    (multiple-value-bind (body declare-forms documentation)
-        (parse-body body :documentation t)
-      (let ((declaration-spec (parse-declaration-specifiers declare-forms)))
-        (multiple-value-bind (lambda-list env)
-            (walk-lambda-list walker
-                              lambda-list
-                              env
-                              (cons 1 path)
-                              :declaration-spec declaration-spec)
-          (make-instance 'lambda-form
-                         :documentation documentation
-                         :lambda-list lambda-list
-                         :body (walk-forms walker body env path (+ 2 (length declare-forms)))
-                         :path (cons 0 path)))))))
+  (ecase (first form)
+    ((lambda)
+     (with-walker-bindings (lambda-list &body body) (rest form)
+       (walk-lambda-list-and-body walker lambda-list body env path)))
+    ((sb-int:named-lambda)
+     (with-walker-bindings (name lambda-list &body body) (rest form)
+       (declare (ignore name)) ; TODO
+       (walk-lambda-list-and-body walker lambda-list body env path)))))
 
 (defmethod walk-form ((walker walker) (name (eql 'function)) form env path)
   (with-walker-bindings (thing) (rest form)