From d9806be1448a15fd4f27dbba56286432962706cb Mon Sep 17 00:00:00 2001
From: BT Templeton <bpt@hcoop.net>
Date: Thu, 14 Jul 2011 04:09:12 -0400
Subject: [PATCH] record elisp function names

* language/elisp/compile-tree-il.scm (compile-lambda): Add a `meta'
  argument for the procedure's properties.

  (compile-function, compile-defmacro, compile-defun): Update
  accordingly, passing a `name' property to `compile-lambda' where
  possible.
---
 module/language/elisp/compile-tree-il.scm | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 2c020bb90..d8deaadd1 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -422,7 +422,7 @@
 ;;; binding for them (the lexical target variable is already there,
 ;;; namely the real lambda argument from TreeIL).
 
-(define (compile-lambda loc args body)
+(define (compile-lambda loc meta args body)
   (if (not (list? args))
       (report-error loc "expected list for argument-list" args))
   (receive (required optional rest lexical dynamic)
@@ -476,7 +476,7 @@
           (lambda ()
             (make-lambda
              loc
-             '()
+             meta
              (make-lambda-case
               #f
               required
@@ -765,7 +765,7 @@
 (defspecial function (loc args)
   (pmatch args
     (((lambda ,args . ,body))
-     (compile-lambda loc args body))
+     (compile-lambda loc '() args body))
     ((,sym) (guard (symbol? sym))
      (reference-variable loc sym function-slot))))
 
@@ -786,7 +786,10 @@
                      loc
                      (make-module-ref loc '(guile) 'cons #t)
                      (list (make-const loc 'macro)
-                           (compile-lambda loc args body))))
+                           (compile-lambda loc
+                                           `((name . ,name))
+                                           args
+                                           body))))
                    (make-const loc name)))))
            (compile (ensuring-globals loc bindings-data tree-il)
                     #:from 'tree-il
@@ -803,6 +806,7 @@
                                              name
                                              function-slot
                                              (compile-lambda loc
+                                                             `((name . ,name))
                                                              args
                                                              body))
                               (make-const loc name)))))))