diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt index 6e3ce3d..cf94c07 100644 Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ diff --git a/scheme/ikarus.main.ss b/scheme/ikarus.main.ss index 32da13a..b531b36 100644 --- a/scheme/ikarus.main.ss +++ b/scheme/ikarus.main.ss @@ -54,9 +54,12 @@ (cons "." (append (split (getenv "IKARUS_LIBRARY_PATH")) - (list ikarus-lib-dir))))) - - ) + (list ikarus-lib-dir)))) + (library-extensions + (append + (map (lambda (x) (string-append ".ikarus" x)) + (library-extensions)) + (library-extensions))))) ;;; Finally, we're ready to evaluate the files and enter the cafe. diff --git a/scheme/last-revision b/scheme/last-revision index 438db35..c233251 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1291 +1292 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index d656e06..41377b9 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -397,6 +397,7 @@ [waitpid i] [installed-libraries i] [library-path i] + [library-extensions i] [current-primitive-locations $boot] [boot-library-expand $boot] [current-library-collection $boot] diff --git a/scheme/psyntax.library-manager.ss b/scheme/psyntax.library-manager.ss index 894f620..e0c5cb0 100644 --- a/scheme/psyntax.library-manager.ss +++ b/scheme/psyntax.library-manager.ss @@ -23,7 +23,7 @@ visit-library library-name library-version library-exists? find-library-by-name install-library library-spec invoke-library extend-library-subst! extend-library-env! current-library-expander - current-library-collection library-path) + current-library-collection library-path library-extensions) (import (rnrs) (psyntax compat) (rnrs r5rs)) (define (make-collection) @@ -79,6 +79,15 @@ (map (lambda (x) x) x) (assertion-violation 'library-path "not a list of strings" x))))) + (define library-extensions + (make-parameter + '(".sls" ".ss" ".scm") + (lambda (x) + (if (and (list? x) (for-all string? x)) + (map (lambda (x) x) x) + (assertion-violation 'library-extensions + "not a list of strings" x))))) + (define (library-name->file-name x) (let-values (((p extract) (open-string-output-port))) (define (display-hex n) @@ -90,35 +99,35 @@ (- n 10))) p)))) (let f ((ls x)) - (cond - ((null? ls) (display ".ss" p)) - (else - (display "/" p) - (for-each - (lambda (c) - (cond - ((or (char<=? #\a c #\z) - (char<=? #\A c #\Z) - (char<=? #\0 c #\9) - (memv c '(#\- #\. #\_ #\~))) - (display c p)) - (else - (display "%" p) - (let ((n (char->integer c))) - (display-hex (quotient n 16)) - (display-hex (remainder n 16)))))) - (string->list - (symbol->string (car ls)))) - (f (cdr ls))))) + (unless (null? ls) + (display "/" p) + (for-each + (lambda (c) + (cond + ((or (char<=? #\a c #\z) + (char<=? #\A c #\Z) + (char<=? #\0 c #\9) + (memv c '(#\- #\. #\_ #\~))) + (display c p)) + (else + (display "%" p) + (let ((n (char->integer c))) + (display-hex (quotient n 16)) + (display-hex (remainder n 16)))))) + (string->list + (symbol->string (car ls)))) + (f (cdr ls)))) (extract))) (define file-locator (make-parameter (lambda (x) (let ((str (library-name->file-name x))) - (let f ((ls (library-path)) (failed-list '())) + (let f ((ls (library-path)) + (exts (library-extensions)) + (failed-list '())) (cond - ((null? ls) + ((null? ls) (let () (define-condition-type &library-resolution &condition make-library-resolution-condition @@ -133,11 +142,13 @@ "cannot locate library in library-path") (make-library-resolution-condition x (reverse failed-list)))))) + ((null? exts) + (f (cdr ls) (library-extensions) failed-list)) (else - (let ((name (string-append (car ls) str))) + (let ((name (string-append (car ls) str (car exts)))) (if (file-exists? name) name - (f (cdr ls) (cons name failed-list))))))))) + (f ls (cdr exts) (cons name failed-list))))))))) (lambda (f) (if (procedure? f) f