mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

fix problem naming internal definitions

Browse source 
* module/ice-9/psyntax.scm (chi-body): Fix a problem introduced in
  dc1eed52f7, that internal syntax definitions were included in the id
  lis along with value definitions. Only showed up on a second bootstrap.
  Psyntax, how I love thee.

* module/ice-9/psyntax-pp.scm
This commit is contained in:
Andy Wingo 2009-05-22 19:26:58 +02:00
parent 55ae815b62
commit 39a2eca2ce
2 changed files with 18 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because one or more lines are too long

12
module/ice-9/psyntax.scm
View file

@ -1356,7 +1356,8 @@
(ribcage (make-empty-ribcage)) (ribcage (make-empty-ribcage))
(w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w))))) (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w)))))
(let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body)) (let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body))
(ids '()) (labels '()) (vars '()) (vals '()) (bindings '())) (ids '()) (labels '())
(var-ids '()) (vars '()) (vals '()) (bindings '()))
(if (null? body) (if (null? body)
(syntax-violation #f "no expressions in body" outer-form) (syntax-violation #f "no expressions in body" outer-form)
(let ((e (cdar body)) (er (caar body))) (let ((e (cdar body)) (er (caar body)))
@ -1370,6 +1371,7 @@
(extend-ribcage! ribcage id label) (extend-ribcage! ribcage id label)
(parse (cdr body) (parse (cdr body)
(cons id ids) (cons label labels) (cons id ids) (cons label labels)
(cons id var-ids)
(cons var vars) (cons (cons er (wrap e w mod)) vals) (cons var vars) (cons (cons er (wrap e w mod)) vals)
(cons (make-binding 'lexical var) bindings))))) (cons (make-binding 'lexical var) bindings)))))
((define-syntax-form) ((define-syntax-form)
@ -1377,7 +1379,7 @@
(extend-ribcage! ribcage id label) (extend-ribcage! ribcage id label)
(parse (cdr body) (parse (cdr body)
(cons id ids) (cons label labels) (cons id ids) (cons label labels)
vars vals var-ids vars vals
(cons (make-binding 'macro (cons er (wrap e w mod))) (cons (make-binding 'macro (cons er (wrap e w mod)))
bindings)))) bindings))))
((begin-form) ((begin-form)
@ -1388,7 +1390,7 @@
(cdr body) (cdr body)
(cons (cons er (wrap (car forms) w mod)) (cons (cons er (wrap (car forms) w mod))
(f (cdr forms))))) (f (cdr forms)))))
ids labels vars vals bindings)))) ids labels var-ids vars vals bindings))))
((local-syntax-form) ((local-syntax-form)
(chi-local-syntax value e er w s mod (chi-local-syntax value e er w s mod
(lambda (forms er w s mod) (lambda (forms er w s mod)
@ -1397,7 +1399,7 @@
(cdr body) (cdr body)
(cons (cons er (wrap (car forms) w mod)) (cons (cons er (wrap (car forms) w mod))
(f (cdr forms))))) (f (cdr forms)))))
ids labels vars vals bindings)))) ids labels var-ids vars vals bindings))))
(else ; found a non-definition (else ; found a non-definition
(if (null? ids) (if (null? ids)
(build-sequence no-source (build-sequence no-source
@ -1427,7 +1429,7 @@
(loop (cdr bs) er-cache r-cache))))) (loop (cdr bs) er-cache r-cache)))))
(set-cdr! r (extend-env labels bindings (cdr r))) (set-cdr! r (extend-env labels bindings (cdr r)))
(build-letrec no-source (build-letrec no-source
(map syntax->datum ids) (map syntax->datum var-ids)
vars vars
(map (lambda (x) (map (lambda (x)
(chi (cdr x) (car x) empty-wrap mod)) (chi (cdr x) (car x) empty-wrap mod))