diff options
Diffstat (limited to 'require.scm')
| -rw-r--r-- | require.scm | 79 |
1 files changed, 36 insertions, 43 deletions
diff --git a/require.scm b/require.scm index 31d922d..613038e 100644 --- a/require.scm +++ b/require.scm @@ -17,7 +17,7 @@ ;promotional, or sales literature without prior written consent in ;each case. ;@ -(define *slib-version* "3a4") +(define *slib-version* "3a5") ;;;; MODULES ;@ @@ -122,7 +122,7 @@ (else (bail expression)))) (feval expression)) ;@ -(define (provided? expression) +(define (slib:provided? expression) (define feature-list (cons (scheme-implementation-type) (cons (software-type) slib:features))) (define (provided? expression) @@ -133,7 +133,11 @@ (else #f)))))) (feature-eval expression provided?)) ;@ -(define (require feature) +(define (slib:provide feature) + (if (not (memq feature slib:features)) + (set! slib:features (cons feature slib:features)))) +;@ +(define (slib:require feature) (cond ((not feature) (set! *catalog* #f)) ((slib:provided? feature)) @@ -166,22 +170,14 @@ (else (slib:error "unknown package loader" path))) (if (list? path) (cdr path) (list (cdr path)))))))))) ;@ -(define (require-if feature? feature) +(define (slib:require-if feature? feature) (if (slib:provided? feature?) (slib:require feature))) -;@ -(define (provide feature) - (if (not (memq feature slib:features)) - (set! slib:features (cons feature slib:features)))) ;@ -(define slib:provide provide) -(define slib:provided? provided?) -(define slib:require require) -(define slib:require-if require-if) -;;; Legacy -(define require:provide provide) -(define require:provided? provided?) -(define require:require require) +(define provide slib:provide) +(define provided? slib:provided?) +(define require slib:require) +(define require-if slib:require-if) (let ((x (string->number "0.0"))) (if (and x (inexact? x)) (slib:provide 'inexact))) @@ -198,7 +194,7 @@ (slib:provide 'srfi-59) (do ((idx 0 (+ 1 idx)) (srfis (symbol->string 'srfi-))) - ((> idx 100)) + ((> idx 150)) (let ((srfi (string->symbol (string-append srfis (number->string idx))))) (if (slib:eval `(cond-expand (,srfi #t) (else #f))) (slib:provide srfi)))))) @@ -226,34 +222,31 @@ ((eof-object? o)) (evl o))))))) -(define report:print - (lambda args - (for-each (lambda (x) (write x) (display #\space)) args) - (newline))) +(define (report:print . args) + (for-each (lambda (x) (write x) (display #\space)) args) + (newline)) ;@ -(define slib:report - (let ((slib:report (lambda () (slib:report-version) (slib:report-locations)))) - (lambda args - (cond ((null? args) (slib:report)) - ((not (string? (car args))) - (slib:report-version) (slib:report-locations #t)) - ((slib:provided? 'transcript) - (transcript-on (car args)) - (slib:report) - (transcript-off)) - ((slib:provided? 'with-file) - (with-output-to-file (car args) slib:report)) - (else (slib:report)))))) +(define (slib:report . args) + (define rpt (lambda () (slib:report-version) (slib:report-locations))) + (cond ((null? args) (rpt)) + ((not (string? (car args))) + (slib:report-version) (slib:report-locations #t)) + ((slib:provided? 'transcript) + (transcript-on (car args)) + (rpt) + (transcript-off)) + ((slib:provided? 'with-file) + (with-output-to-file (car args) rpt)) + (else (rpt)))) ;@ -(define slib:report-version - (lambda () - (report:print - 'SLIB *slib-version* 'on (scheme-implementation-type) - (scheme-implementation-version) 'on (software-type)))) +(define (slib:report-version) + (report:print + 'SLIB *slib-version* 'on (scheme-implementation-type) + (scheme-implementation-version) 'on (software-type))) (define slib:report-locations - (let ((features slib:features)) + (let ((lfeatures slib:features)) ; Capture load-time value (lambda args (define sit (scheme-implementation-type)) (define siv (string->symbol (scheme-implementation-version))) @@ -261,12 +254,12 @@ (report:print '(LIBRARY-VICINITY) 'is (library-vicinity)) (report:print '(SCHEME-FILE-SUFFIX) 'is (scheme-file-suffix)) (let* ((i (+ -1 5))) - (cond ((eq? (car features) (car slib:features))) + (cond ((eq? (car lfeatures) (car slib:features))) (else (report:print 'loaded 'SLIB:FEATURES ':) (display slib:tab))) (for-each (lambda (x) - (cond ((eq? (car features) x) - (if (not (eq? (car features) (car slib:features))) (newline)) + (cond ((eq? (car lfeatures) x) + (if (not (eq? (car lfeatures) (car slib:features))) (newline)) (report:print sit siv 'SLIB:FEATURES ':) (display slib:tab) (set! i (+ -1 5))) ((zero? i) (newline) (display slib:tab) (set! i (+ -1 5))) |