diff --git a/lib/Makefile.am b/lib/Makefile.am index ff2cd45..7bf7eee 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -1,5 +1,5 @@ libikarusdir=$(pkglibdir)/ikarus -dist_libikarus_DATA=ikarus/foreign.ss ikarus/ipc.ss +dist_libikarus_DATA=ikarus/foreign.ss ikarus/ipc.ss ikarus/include.ss libCocoadir=$(pkglibdir)/Cocoa dist_libCocoa_DATA=Cocoa/helpers.ss diff --git a/lib/Makefile.in b/lib/Makefile.in index 2343ab0..6fc100d 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -162,7 +162,7 @@ top_build_prefix = @top_build_prefix@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ libikarusdir = $(pkglibdir)/ikarus -dist_libikarus_DATA = ikarus/foreign.ss ikarus/ipc.ss +dist_libikarus_DATA = ikarus/foreign.ss ikarus/ipc.ss ikarus/include.ss libCocoadir = $(pkglibdir)/Cocoa dist_libCocoa_DATA = Cocoa/helpers.ss dist_pkglib_DATA = match.ss gl.ss glut.ss \ diff --git a/lib/ikarus/include.ss b/lib/ikarus/include.ss new file mode 100644 index 0000000..51d1207 --- /dev/null +++ b/lib/ikarus/include.ss @@ -0,0 +1,66 @@ +;;; Ikarus Scheme -- A compiler for R6RS Scheme. +;;; Copyright (C) 2009 Abdulaziz Ghuloum +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License version 3 as +;;; published by the Free Software Foundation. +;;; +;;; This program is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see . + + + +(library (ikarus include) + (export include include/lexical-context) + (import (except (ikarus) include)) + + (define-syntax include/lexical-context/form + (lambda (x) + (syntax-case x () + [(_ filename id form who) + (let* ([filename^ + (let ([x (syntax->datum #'filename)]) + (if (string? x) + x + (syntax-violation #f "file name is not a string" + #'form #'filename)))] + [content + (with-exception-handler + (lambda (x) + (raise-continuable + (condition + (make-who-condition #'who) + x))) + (lambda () + (with-input-from-file filename^ + (lambda () + (let loop () + (let ([x (read)]) + (if (eof-object? x) + '() + (cons (datum->syntax #'id x) + (loop)))))))))]) + #`(stale-when + (or (not (file-exists? filename)) + (> (file-mtime filename) #,(file-mtime filename^))) + #,@content))]))) + + (define-syntax include/lexical-context + (lambda (x) + (syntax-case x () + [(kwd filename id) + (if (identifier? #'id) + #`(include/lexical-context/form filename id #,x kwd) + (syntax-violation #f "not an identifier" x #'id))]))) + + (define-syntax include + (lambda (x) + (syntax-case x () + [(kwd filename) + #`(include/lexical-context/form filename kwd #,x kwd)])))) + diff --git a/scheme/Makefile.am b/scheme/Makefile.am index c1de8fc..6228170 100644 --- a/scheme/Makefile.am +++ b/scheme/Makefile.am @@ -119,7 +119,7 @@ MAINTAINERCLEANFILES=last-revision ikarus.boot: $(EXTRA_DIST) ikarus.config.ss IKARUS_SRC_DIR=$(srcdir) \ IKARUS_BUILD_DIR=$(builddir) \ - IKARUS_LIBRARY_PATH=$(srcdir) \ + IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \ ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \ --r6rs-script $(srcdir)/makefile.ss diff --git a/scheme/Makefile.in b/scheme/Makefile.in index 841ac0d..4843224 100644 --- a/scheme/Makefile.in +++ b/scheme/Makefile.in @@ -454,7 +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_LIBRARY_PATH=$(srcdir) \ + IKARUS_LIBRARY_PATH=$(srcdir):$(srcdir)/../lib \ ../src/ikarus -b $(srcdir)/ikarus.boot.$(sizeofvoidp).prebuilt \ --r6rs-script $(srcdir)/makefile.ss diff --git a/scheme/ikarus.boot.4.prebuilt b/scheme/ikarus.boot.4.prebuilt index 1617e50..d2d841a 100644 Binary files a/scheme/ikarus.boot.4.prebuilt and b/scheme/ikarus.boot.4.prebuilt differ diff --git a/scheme/ikarus.boot.8.prebuilt b/scheme/ikarus.boot.8.prebuilt index a203a85..872f91b 100644 Binary files a/scheme/ikarus.boot.8.prebuilt and b/scheme/ikarus.boot.8.prebuilt differ diff --git a/scheme/ikarus.compiler.ss b/scheme/ikarus.compiler.ss index d2da20c..ad7e21c 100644 --- a/scheme/ikarus.compiler.ss +++ b/scheme/ikarus.compiler.ss @@ -1846,6 +1846,7 @@ (begin ;;; DEFINITIONS (module (wordsize) + (import (ikarus include)) (include "ikarus.config.ss")) (define wordshift (case wordsize diff --git a/scheme/ikarus.fasl.write.ss b/scheme/ikarus.fasl.write.ss index 6608b10..e404da8 100644 --- a/scheme/ikarus.fasl.write.ss +++ b/scheme/ikarus.fasl.write.ss @@ -31,6 +31,7 @@ (except (ikarus) fasl-write write-byte)) (module (wordsize) + (import (ikarus include)) (include "ikarus.config.ss")) ;;; (define-syntax fxshift diff --git a/scheme/ikarus.include-src.ss b/scheme/ikarus.include-src.ss index b23f06a..89c4cf8 100644 --- a/scheme/ikarus.include-src.ss +++ b/scheme/ikarus.include-src.ss @@ -15,7 +15,7 @@ (library (ikarus.include-src) (export include-src) - (import (ikarus)) + (import (ikarus) (ikarus include)) (define-syntax include-src (lambda (x) (syntax-case x () @@ -25,4 +25,4 @@ (or (getenv "IKARUS_SRC_DIR") ".") "/" (syntax->datum #'filename))]) - #'(include-into ctxt filename))])))) + #'(include/lexical-context filename ctxt))])))) diff --git a/scheme/ikarus.intel-assembler.ss b/scheme/ikarus.intel-assembler.ss index c44fa44..6509455 100644 --- a/scheme/ikarus.intel-assembler.ss +++ b/scheme/ikarus.intel-assembler.ss @@ -25,6 +25,7 @@ (module (wordsize) + (import (ikarus include)) (include "ikarus.config.ss")) (define fold diff --git a/scheme/ikarus.main.ss b/scheme/ikarus.main.ss index 8ef3fec..77f90e6 100644 --- a/scheme/ikarus.main.ss +++ b/scheme/ikarus.main.ss @@ -20,7 +20,7 @@ (library (ikarus startup) (export print-greeting init-library-path host-info split-path) - (import (except (ikarus) host-info)) + (import (except (ikarus) host-info) (ikarus include)) (include "ikarus.config.ss") (define (host-info) target) diff --git a/scheme/last-revision b/scheme/last-revision index 93752ca..a562b57 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1798 +1799 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index a5ad372..a0bbc4e 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -144,8 +144,6 @@ [let*-values (macro . let*-values)] [define-struct (macro . define-struct)] [case (macro . case)] - [include (macro . include)] - [include-into (macro . include-into)] [syntax-rules (macro . syntax-rules)] [quasiquote (macro . quasiquote)] [quasisyntax (macro . quasisyntax)] @@ -295,8 +293,6 @@ [type-descriptor i] [parameterize i parameters] [define-struct i] - [include i] - [include-into i] [stale-when i] [time i] [trace-lambda i] diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss index 40dfc28..76715d8 100644 --- a/scheme/psyntax.expander.ss +++ b/scheme/psyntax.expander.ss @@ -1542,35 +1542,6 @@ ((e e* ...) `(if ,e (begin . ,e*) ,(f (car cls*) (cdr cls*)))) (_ (stx-error stx "invalid last clause"))))))))))) - (begin ; module (include-macro include-into-macro) - ; no module to keep portable! - ; dump everything in top-level, sure. - (define (do-include stx id filename) - (let ((filename (stx->datum filename))) - (unless (and (string? filename) (id? id)) - (stx-error stx)) - (cons - (bless 'begin) - (with-input-from-file filename - (lambda () - (let f ((ls '())) - (let ((x (read-annotated))) - (cond - ((eof-object? x) (reverse ls)) - (else - (f (cons (datum->stx id x) ls))))))))))) - (define include-macro - (lambda (e) - (syntax-match e () - ((id filename) - (do-include e id filename))))) - (define include-into-macro - (lambda (e) - (syntax-match e () - ((_ id filename) - (do-include e id filename)))))) - - (define syntax-rules-macro (lambda (e) (syntax-match e () @@ -2611,7 +2582,6 @@ (case x ((define-record-type) define-record-type-macro) ((define-struct) define-struct-macro) - ((include) include-macro) ((cond) cond-macro) ((let) let-macro) ((do) do-macro) @@ -2642,7 +2612,6 @@ ((trace-letrec-syntax) trace-letrec-syntax-macro) ((define-condition-type) define-condition-type-macro) ((parameterize) parameterize-macro) - ((include-into) include-into-macro) ((eol-style) (lambda (x) (symbol-macro x '(none lf cr crlf nel crnel ls))))