- include now resolves relative includes (where file name does not
start with "/") according to library-path. Absolute paths are not resolved.
This commit is contained in:
		
							parent
							
								
									f13876d385
								
							
						
					
					
						commit
						ac0e583310
					
				|  | @ -17,37 +17,48 @@ | ||||||
| 
 | 
 | ||||||
| (library (ikarus include) | (library (ikarus include) | ||||||
|   (export include include/lexical-context) |   (export include include/lexical-context) | ||||||
|   (import (except (ikarus) include)) |   (import (ikarus)) | ||||||
| 
 | 
 | ||||||
|   (define-syntax include/lexical-context/form |   (define-syntax include/lexical-context/form | ||||||
|     (lambda (x) |     (lambda (x) | ||||||
|       (syntax-case x () |       (syntax-case x () | ||||||
|         [(_ filename id form who) |         [(_ filename id form who) | ||||||
|          (let* ([filename^  |          (let* ([filename | ||||||
|                  (let ([x (syntax->datum #'filename)]) |                  (let ([x (syntax->datum #'filename)]) | ||||||
|                    (if (string? x) |                    (if (and (string? x) (not (string=? x ""))) | ||||||
|                        x |                        (if (char=? (string-ref x 0) #\/) | ||||||
|                        (syntax-violation #f "file name is not a string" |                            x | ||||||
|  |                            (let f ([ls (library-path)]) | ||||||
|  |                              (if (null? ls) | ||||||
|  |                                  (syntax-violation #f  | ||||||
|  |                                     "file does not exist in library path" | ||||||
|  |                                     #'form #'filename) | ||||||
|  |                                  (let ([x (string-append (car ls) "/" x)]) | ||||||
|  |                                    (if (file-exists? x) | ||||||
|  |                                        (file-real-path x) | ||||||
|  |                                        (f (cdr ls))))))) | ||||||
|  |                        (syntax-violation #f  | ||||||
|  |                           "file name must be a nonempty string" | ||||||
|                           #'form #'filename)))] |                           #'form #'filename)))] | ||||||
|                 [content  |                 [content  | ||||||
|                  (with-exception-handler |                  (with-exception-handler | ||||||
|                    (lambda (x) |                    (lambda (x) | ||||||
|                      (raise-continuable  |                      (raise-continuable  | ||||||
|                        (condition  |                        (condition  | ||||||
|                          (make-who-condition #'who) |                          (make-who-condition (syntax->datum #'who)) | ||||||
|                          x))) |                          x))) | ||||||
|                    (lambda ()  |                    (lambda ()  | ||||||
|                      (with-input-from-file filename^ |                      (with-input-from-file filename | ||||||
|                        (lambda () |                        (lambda () | ||||||
|                          (let loop () |                          (let loop () | ||||||
|                            (let ([x (read)]) |                            (let ([x (read-annotated)]) | ||||||
|                              (if (eof-object? x) |                              (if (eof-object? x) | ||||||
|                                  '() |                                  '() | ||||||
|                                  (cons (datum->syntax #'id x) |                                  (cons (datum->syntax #'id x) | ||||||
|                                    (loop)))))))))]) |                                    (loop)))))))))]) | ||||||
|            #`(stale-when |            #`(stale-when | ||||||
|                (or (not (file-exists? filename)) |                 (or (not (file-exists? #,filename)) | ||||||
|                    (> (file-mtime filename) #,(file-mtime filename^))) |                     (> (file-mtime #,filename) #,(file-mtime filename))) | ||||||
|                #,@content))]))) |                #,@content))]))) | ||||||
|    |    | ||||||
|   (define-syntax include/lexical-context |   (define-syntax include/lexical-context | ||||||
|  |  | ||||||
|  | @ -119,6 +119,7 @@ MAINTAINERCLEANFILES=last-revision | ||||||
| ikarus.boot: $(EXTRA_DIST) ikarus.config.ss  | ikarus.boot: $(EXTRA_DIST) ikarus.config.ss  | ||||||
| 	IKARUS_SRC_DIR=$(srcdir) \
 | 	IKARUS_SRC_DIR=$(srcdir) \
 | ||||||
|   IKARUS_BUILD_DIR=$(builddir) \
 |   IKARUS_BUILD_DIR=$(builddir) \
 | ||||||
|  |   IKARUS_FASL_DIRECTORY='' \
 | ||||||
|   IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
 |   IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
 | ||||||
|   ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
 |   ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
 | ||||||
|   --r6rs-script $(srcdir)/makefile.ss |   --r6rs-script $(srcdir)/makefile.ss | ||||||
|  |  | ||||||
|  | @ -454,6 +454,7 @@ ikarus.config.ss: Makefile last-revision ../config.h | ||||||
| ikarus.boot: $(EXTRA_DIST) ikarus.config.ss  | ikarus.boot: $(EXTRA_DIST) ikarus.config.ss  | ||||||
| 	IKARUS_SRC_DIR=$(srcdir) \
 | 	IKARUS_SRC_DIR=$(srcdir) \
 | ||||||
|   IKARUS_BUILD_DIR=$(builddir) \
 |   IKARUS_BUILD_DIR=$(builddir) \
 | ||||||
|  |   IKARUS_FASL_DIRECTORY='' \
 | ||||||
|   IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
 |   IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
 | ||||||
|   ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
 |   ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
 | ||||||
|   --r6rs-script $(srcdir)/makefile.ss |   --r6rs-script $(srcdir)/makefile.ss | ||||||
|  |  | ||||||
|  | @ -1 +1 @@ | ||||||
| 1799 | 1800 | ||||||
|  |  | ||||||
		Loading…
	
		Reference in New Issue
	
	 Abdulaziz Ghuloum
						Abdulaziz Ghuloum