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

Regenerate psyntax-pp.scm.

Browse source 
* module/ice-9/psyntax-pp.scm: Regenerate.  This should have been done
  in commit 84f5a82517 (`include' relative
  paths relative to including file).
This commit is contained in:
Mark H Weaver 2013-01-23 17:25:18 -05:00
parent a3df9ad9e6
commit e70b663c24
1 changed files with 27 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2964,33 +2964,37 @@
'macro 'macro
(lambda (x) (lambda (x)
(letrec* (letrec*
((read-file ((absolute-path? (lambda (path) (string-prefix? "/" path)))
(lambda (fn k) (read-file
(let ((p (open-input-file fn))) (lambda (fn dir k)
(let ((p (open-input-file (if (absolute-path? fn) fn (in-vicinity dir fn)))))
(let f ((x (read p)) (result '())) (let f ((x (read p)) (result '()))
(if (eof-object? x) (if (eof-object? x)
(begin (close-input-port p) (reverse result)) (begin (close-input-port p) (reverse result))
(f (read p) (cons (datum->syntax k x) result)))))))) (f (read p) (cons (datum->syntax k x) result))))))))
(let ((tmp-1 x)) (let ((src (syntax-source x)))
(let ((tmp ($sc-dispatch tmp-1 '(any any)))) (let ((file (if src (assq-ref src 'filename) #f)))
(if tmp (let ((dir (if (string? file) (dirname file) #f)))
(apply (lambda (k filename) (let ((tmp-1 x))
(let ((fn (syntax->datum filename))) (let ((tmp ($sc-dispatch tmp-1 '(any any))))
(let ((tmp-1 (read-file fn filename))) (if tmp
(let ((tmp ($sc-dispatch tmp-1 'each-any))) (apply (lambda (k filename)
(if tmp (let ((fn (syntax->datum filename)))
(apply (lambda (exp) (let ((tmp-1 (read-file fn dir filename)))
(cons '#(syntax-object begin ((top)) (hygiene guile)) exp)) (let ((tmp ($sc-dispatch tmp-1 'each-any)))
tmp) (if tmp
(syntax-violation (apply (lambda (exp)
#f (cons '#(syntax-object begin ((top)) (hygiene guile)) exp))
"source expression failed to match any pattern" tmp)
tmp-1)))))) (syntax-violation
tmp) #f
(syntax-violation "source expression failed to match any pattern"
#f tmp-1))))))
"source expression failed to match any pattern" tmp)
tmp-1)))))))) (syntax-violation
#f
"source expression failed to match any pattern"
tmp-1)))))))))))
(define include-from-path (define include-from-path
(make-syntax-transformer (make-syntax-transformer