[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-54-ge70b663

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=e70b663c24420093f98ce6147178be5ef92655ba

The branch, stable-2.0 has been updated
       via  e70b663c24420093f98ce6147178be5ef92655ba (commit)
      from  a3df9ad9e6be7d5fbc566a10bc9ba035a2e38f31 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit e70b663c24420093f98ce6147178be5ef92655ba
Author: Mark H Weaver <address@hidden>
Date:   Wed Jan 23 17:25:18 2013 -0500

    Regenerate psyntax-pp.scm.
    
    * module/ice-9/psyntax-pp.scm: Regenerate.  This should have been done
      in commit 84f5a8251710c7d2a01590aa083d9dd409a56279 (`include' relative
      paths relative to including file).

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/psyntax-pp.scm |   50 +++++++++++++++++++++++-------------------
 1 files changed, 27 insertions(+), 23 deletions(-)

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


hooks/post-receive
-- 
GNU Guile