diff --git a/scheme/Makefile.am b/scheme/Makefile.am index 055b7a7..8257e94 100644 --- a/scheme/Makefile.am +++ b/scheme/Makefile.am @@ -23,7 +23,8 @@ EXTRA_DIST=ikarus.boot.prebuilt ikarus.enumerations.ss \ psyntax.compat.ss psyntax.config.ss psyntax.expander.ss \ psyntax.internal.ss psyntax.library-manager.ss \ unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss \ - ikarus.io.ss ikarus.time-and-date.ss + ikarus.io.ss ikarus.time-and-date.ss \ + ikarus.separate-compilation.ss all: $(nodist_pkglib_DATA) diff --git a/scheme/Makefile.in b/scheme/Makefile.in index 9106662..cc76fc0 100644 --- a/scheme/Makefile.in +++ b/scheme/Makefile.in @@ -177,7 +177,8 @@ EXTRA_DIST = ikarus.boot.prebuilt ikarus.enumerations.ss \ psyntax.compat.ss psyntax.config.ss psyntax.expander.ss \ psyntax.internal.ss psyntax.library-manager.ss \ unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss \ - ikarus.io.ss ikarus.time-and-date.ss + ikarus.io.ss ikarus.time-and-date.ss \ + ikarus.separate-compilation.ss revno = "$(shell sed 's/ .*//' ../.bzr/branch/last-revision 2>/dev/null)" CLEANFILES = $(nodist_pkglib_DATA) ikarus.config.ss diff --git a/scheme/ikarus.compiler.ss b/scheme/ikarus.compiler.ss index 7778128..b59b446 100644 --- a/scheme/ikarus.compiler.ss +++ b/scheme/ikarus.compiler.ss @@ -744,6 +744,8 @@ body) |# +(define scc-letrec (make-parameter #t)) + (define (optimize-letrec/scc x) (define who 'optimize-letrec/scc) (module (get-sccs-in-order) @@ -2946,7 +2948,6 @@ [else (printf " ~s\n" x)])) -(define scc-letrec (make-parameter #t)) (define (compile-core-expr->code p) (let* ([p (recordize p)] diff --git a/scheme/ikarus.separate-compilation.ss b/scheme/ikarus.separate-compilation.ss new file mode 100644 index 0000000..62c2c6f --- /dev/null +++ b/scheme/ikarus.separate-compilation.ss @@ -0,0 +1,18 @@ + +(library (ikarus separate-compilation) + (export compile-library-to-port) + (import + (except (ikarus) compile-library-to-port) + (only (ikarus.compiler) compile-core-expr-to-port) + (only (psyntax library-manager) current-library-expander)) + + (define (compile-library-to-port x p) + (let-values (((id name ver imp* vis* inv* + invoke-code visit-code export-subst export-env) + ((current-library-expander) x))) + (printf "id=~s name=~s ver=~s imp*=~s vis*=~s inv*=~s\n" + id name ver imp* vis* inv*) + (fasl-write (list id name ver imp* vis* inv* export-subst export-env) p) + (compile-core-expr-to-port visit-code p) + (compile-core-expr-to-port invoke-code p)))) + diff --git a/scheme/last-revision b/scheme/last-revision index 88382e8..bbeb054 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1389 +1390 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index cd76166..c360fca 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -88,6 +88,8 @@ "psyntax.config.ss" "psyntax.builders.ss" "psyntax.expander.ss" + + "ikarus.separate-compilation.ss" "ikarus.load.ss" "ikarus.pretty-print.ss" "ikarus.cafe.ss" @@ -1397,6 +1399,7 @@ [scc-letrec i] [optimize-cp i] [optimize-level i] + [compile-library-to-port i] )) (define (macro-identifier? x) diff --git a/scheme/psyntax.library-manager.ss b/scheme/psyntax.library-manager.ss index 1223110..a6bc78d 100644 --- a/scheme/psyntax.library-manager.ss +++ b/scheme/psyntax.library-manager.ss @@ -154,13 +154,23 @@ f (assertion-violation 'file-locator "not a procedure" f))))) - (define library-locator + (define (library-precompiled? x) #f) + + (define (load-precompiled-library x) + (error 'load-precompiled-library "not implemented")) + + (define library-loader (make-parameter (lambda (x) (let ((file-name ((file-locator) x))) - (and (string? file-name) - (with-input-from-file file-name - read-annotated)))) + (cond + [(not file-name) + (assertion-violation #f "cannot file library" x)] + [(library-precompiled? file-name) + (load-precompiled-library file-name)] + [else + ((current-library-expander) + (with-input-from-file file-name read-annotated))]))) (lambda (f) (if (procedure? f) f @@ -186,16 +196,13 @@ "circular attempt to import library was detected" name)) (parameterize ((external-pending-libraries (cons name (external-pending-libraries)))) - (let ((lib-expr ((library-locator) name))) - (unless lib-expr - (assertion-violation #f "cannot find library" name)) - ((current-library-expander) lib-expr) - (or (find-library-by - (lambda (x) (equal? (library-name x) name))) - (assertion-violation #f - "handling external library did not yield the correct library" - name))))) - + ((library-loader) name) + (or (find-library-by + (lambda (x) (equal? (library-name x) name))) + (assertion-violation #f + "handling external library did not yield the correct library" + name)))) + (define (find-library-by-name name) (or (find-library-by (lambda (x) (equal? (library-name x) name)))