From ee15aa46e3fb29e609bd7c431e8f2676f6573d57 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 15 Nov 2011 23:38:40 +0100 Subject: [PATCH] set names of functions defined at the toplevel from `eval' * module/ice-9/eval.scm (primitive-eval): Set the name of toplevel-defined functions. --- module/ice-9/eval.scm | 5 ++++- test-suite/tests/procprop.test | 7 ++++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index 62e36ed66..c0fa64c90 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -425,7 +425,10 @@ (memoize-variable-access! exp #f)))) (('define (name . x)) - (define! name (eval x env))) + (let ((x (eval x env))) + (if (and (procedure? x) (not (procedure-property x 'name))) + (set-procedure-property! x 'name name)) + (define! name x))) (('toplevel-set! (var-or-sym . x)) (variable-set! diff --git a/test-suite/tests/procprop.test b/test-suite/tests/procprop.test index 838f7a427..25dd4c293 100644 --- a/test-suite/tests/procprop.test +++ b/test-suite/tests/procprop.test @@ -26,7 +26,12 @@ (eq? 'display (procedure-name display))) (pass-if "gsubr" - (eq? 'hashq-ref (procedure-name hashq-ref)))) + (eq? 'hashq-ref (procedure-name hashq-ref))) + + (pass-if "from eval" + (eq? 'foobar (procedure-name + (eval '(begin (define (foobar) #t) foobar) + (current-module)))))) (with-test-prefix "procedure-arity"