diff options
author | Andy Wingo <wingo@pobox.com> | 2011-11-15 23:38:40 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-11-15 23:41:51 +0100 |
commit | ee15aa46e3fb29e609bd7c431e8f2676f6573d57 (patch) | |
tree | 57374d33ec538ece9ca8cb6227ecb17463538c81 | |
parent | f3cf9421cb319e2cb9ffde4ec41cad7fdcafcebc (diff) | |
download | guile-ee15aa46e3fb29e609bd7c431e8f2676f6573d57.tar.gz |
set names of functions defined at the toplevel from `eval'
* module/ice-9/eval.scm (primitive-eval): Set the name of
toplevel-defined functions.
-rw-r--r-- | module/ice-9/eval.scm | 5 | ||||
-rw-r--r-- | 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" |