mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

set names of functions defined at the toplevel from `eval'

Browse source 
* module/ice-9/eval.scm (primitive-eval): Set the name of
  toplevel-defined functions.
This commit is contained in:
Andy Wingo 2011-11-15 23:38:40 +01:00
parent f3cf9421cb
commit ee15aa46e3
2 changed files with 10 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

5
module/ice-9/eval.scm
View file

@ -425,7 +425,10 @@
(memoize-variable-access! exp #f)))) (memoize-variable-access! exp #f))))
(('define (name . x)) (('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)) (('toplevel-set! (var-or-sym . x))
(variable-set! (variable-set!

7
test-suite/tests/procprop.test
View file

@ -26,7 +26,12 @@
(eq? 'display (procedure-name display))) (eq? 'display (procedure-name display)))
(pass-if "gsubr" (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" (with-test-prefix "procedure-arity"