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

Fix psyntax bugs that would cause bad source annotations

Browse source 
* module/ice-9/psyntax.scm (rebuild-macro-output): Fix two bugs that
  would cause bogus source properties to be added to vectors and
  macro-introduced syntax objects.  These bugs were masked by the
  limitation that only pairs can be decorated with source properties.
  Due to a typo, each vector in the macro output was decorated using the
  vector itself as its source.  Due to accidental variable capture, each
  syntax-object introduced by the macro had its expression decorated
  with its own wrap-subst.

* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Mark H Weaver 2012-02-15 00:17:18 -05:00
parent db24306887
commit 30398e94f9
2 changed files with 6585 additions and 6563 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because it is too large Load diff

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

@ -1385,25 +1385,25 @@
s)) s))
((syntax-object? x) ((syntax-object? x)
(let ((w (syntax-object-wrap x))) (let ((w (syntax-object-wrap x)))
(let ((ms (wrap-marks w)) (s (wrap-subst w))) (let ((ms (wrap-marks w)) (ss (wrap-subst w)))
(if (and (pair? ms) (eq? (car ms) the-anti-mark)) (if (and (pair? ms) (eq? (car ms) the-anti-mark))
;; output is from original text ;; output is from original text
(make-syntax-object (make-syntax-object
(syntax-object-expression x) (syntax-object-expression x)
(make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s))) (make-wrap (cdr ms) (if rib (cons rib (cdr ss)) (cdr ss)))
(syntax-object-module x)) (syntax-object-module x))
;; output introduced by macro ;; output introduced by macro
(make-syntax-object (make-syntax-object
(decorate-source (syntax-object-expression x) s) (decorate-source (syntax-object-expression x) s)
(make-wrap (cons m ms) (make-wrap (cons m ms)
(if rib (if rib
(cons rib (cons 'shift s)) (cons rib (cons 'shift ss))
(cons 'shift s))) (cons 'shift ss)))
(syntax-object-module x)))))) (syntax-object-module x))))))
((vector? x) ((vector? x)
(let* ((n (vector-length x)) (let* ((n (vector-length x))
(v (decorate-source (make-vector n) x))) (v (decorate-source (make-vector n) s)))
(do ((i 0 (fx+ i 1))) (do ((i 0 (fx+ i 1)))
((fx= i n) v) ((fx= i n) v)
(vector-set! v i (vector-set! v i