(define (foo ...) ...) actually gives the lambda a name

* module/language/scheme/translate.scm (primitive-syntax-table): In forms
  like (define x y) where y is a lambda, and the lambda has no name yet,
  set the lambda's name in its metadata.

diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm
index 2e8ce9b..87a6130 100644 (file)
--- a/module/language/scheme/translate.scm
+++ b/module/language/scheme/translate.scm
@@ -147,7 +147,7 @@
     ((,name ,val) (guard (symbol? name)
                          (ghil-toplevel-env? (ghil-env-parent e)))
      (make-ghil-define e l (ghil-define (ghil-env-parent e) name)
-                       (retrans val)))
+                       (maybe-name-value! (retrans val) name)))
     ;; (define (NAME FORMALS...) BODY...)
     (((,name . ,formals) . ,body) (guard (symbol? name))
      ;; -> (define NAME (lambda FORMALS BODY...))
@@ -362,6 +362,14 @@
          (values `((documentation . ,(car body))) (cdr body)))
         (else (values '() body))))
 
+(define (maybe-name-value! val name)
+  (cond
+   ((ghil-lambda? val)
+    (if (not (assq-ref (ghil-lambda-meta val) 'name))
+        (set! (ghil-lambda-meta val)
+              (acons 'name name (ghil-lambda-meta val))))))
+  val)
+
 (define (location x)
   (and (pair? x)
        (let ((props (source-properties x)))