conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

- 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:
Abdulaziz Ghuloum 2009-05-30 09:47:56 +03:00
parent f13876d385
commit ac0e583310
4 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lib/ikarus/include.ss
View File

@ -17,37 +17,48 @@
(library (ikarus include)
(export include include/lexical-context)
(import (except (ikarus) include))
(import (ikarus))
(define-syntax include/lexical-context/form
(lambda (x)
(syntax-case x ()
[(_ filename id form who)
(let* ([filename^
(let* ([filename
(let ([x (syntax->datum #'filename)])
(if (string? x)
(if (and (string? x) (not (string=? x "")))
(if (char=? (string-ref x 0) #\/)
x
(syntax-violation #f "file name is not a string"
(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)))]
[content
(with-exception-handler
(lambda (x)
(raise-continuable
(condition
(make-who-condition #'who)
(make-who-condition (syntax->datum #'who))
x)))
(lambda ()
(with-input-from-file filename^
(with-input-from-file filename
(lambda ()
(let loop ()
(let ([x (read)])
(let ([x (read-annotated)])
(if (eof-object? x)
'()
(cons (datum->syntax #'id x)
(loop)))))))))])
#`(stale-when
(or (not (file-exists? filename))
(> (file-mtime filename) #,(file-mtime filename^)))
(or (not (file-exists? #,filename))
(> (file-mtime #,filename) #,(file-mtime filename)))
#,@content))])))
(define-syntax include/lexical-context

1
scheme/Makefile.am
View File

@ -119,6 +119,7 @@ MAINTAINERCLEANFILES=last-revision
ikarus.boot: $(EXTRA_DIST) ikarus.config.ss
IKARUS_SRC_DIR=$(srcdir) \
IKARUS_BUILD_DIR=$(builddir) \
IKARUS_FASL_DIRECTORY='' \
IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
--r6rs-script $(srcdir)/makefile.ss

1
scheme/Makefile.in
View File

@ -454,6 +454,7 @@ ikarus.config.ss: Makefile last-revision ../config.h
ikarus.boot: $(EXTRA_DIST) ikarus.config.ss
IKARUS_SRC_DIR=$(srcdir) \
IKARUS_BUILD_DIR=$(builddir) \
IKARUS_FASL_DIRECTORY='' \
IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \
../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \
--r6rs-script $(srcdir)/makefile.ss

2
scheme/last-revision
View File

@ -1 +1 @@
1799
1800