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

Name anonymous let- or letrec-bound procedures

Browse source 
* module/language/scheme/compile-ghil.scm (let, letrec): Give names to
  procedures of the form (let ((foo (lambda ....)))).
This commit is contained in:
Andy Wingo 2009-02-02 23:36:14 +01:00
parent e311f5fa04
commit e94ecc68c2
1 changed files with 7 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

9
module/language/scheme/compile-ghil.scm
View file

@ -248,7 +248,9 @@
;; (let ((SYM VAL) ...) BODY...) ;; (let ((SYM VAL) ...) BODY...)
((,bindings . ,body) (guard (valid-bindings? bindings)) ((,bindings . ,body) (guard (valid-bindings? bindings))
(let ((vals (map retrans (map cadr bindings)))) (let ((vals (map (lambda (b)
(maybe-name-value! (retrans (cadr b)) (car b)))
bindings)))
(call-with-ghil-bindings e (map car bindings) (call-with-ghil-bindings e (map car bindings)
(lambda (vars) (lambda (vars)
(make-ghil-bind e l vars vals (trans-body e l body))))))) (make-ghil-bind e l vars vals (trans-body e l body)))))))
@ -265,7 +267,10 @@
((,bindings . ,body) (guard (valid-bindings? bindings)) ((,bindings . ,body) (guard (valid-bindings? bindings))
(call-with-ghil-bindings e (map car bindings) (call-with-ghil-bindings e (map car bindings)
(lambda (vars) (lambda (vars)
(let ((vals (map retrans (map cadr bindings)))) (let ((vals (map (lambda (b)
(maybe-name-value!
(retrans (cadr b)) (car b)))
bindings)))
(make-ghil-bind e l vars vals (trans-body e l body))))))) (make-ghil-bind e l vars vals (trans-body e l body)))))))
(define-scheme-translator cond (define-scheme-translator cond