diff options
Diffstat (limited to 'require.scm')
| -rw-r--r-- | require.scm | 46 |
1 files changed, 25 insertions, 21 deletions
diff --git a/require.scm b/require.scm index c8e8711..31d922d 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* "3a3") +(define *slib-version* "3a4") ;;;; MODULES ;@ @@ -76,7 +76,7 @@ (if (not *catalog*) (let ((slibcat (catalog:try-read (implementation-vicinity) "slibcat"))) (cond ((not (catalog/require-version-match? slibcat)) - (slib:load (in-vicinity (library-vicinity) "mklibcat")) + (slib:load-source (in-vicinity (library-vicinity) "mklibcat")) (set! slibcat (catalog:try-read (implementation-vicinity) "slibcat")))) (cond (slibcat @@ -84,8 +84,10 @@ (cadr (or (assq 'catalog:filter slibcat) '(#f identity)))) slibcat)))) - (set! *catalog* - (append (catalog:try-read (home-vicinity) "homecat") *catalog*)) + (and (home-vicinity) + (set! *catalog* + (append (catalog:try-read (home-vicinity) "homecat") + *catalog*))) (set! *catalog* (append (catalog:try-read (user-vicinity) "usercat") *catalog*)))) (and feature *catalog* (cdr (or (assq feature *catalog*) '(#f . #f))))) @@ -122,7 +124,7 @@ ;@ (define (provided? expression) (define feature-list (cons (scheme-implementation-type) - (cons (software-type) *features*))) + (cons (software-type) slib:features))) (define (provided? expression) (if (memq expression feature-list) #t (and *catalog* @@ -141,11 +143,11 @@ (slib:error 'slib:require 'unsupported 'feature feature)) ((symbol? path) (slib:provide feature) (slib:require path)) ((string? path) ;simple name - (and (not (eq? 'new-catalog feature)) (slib:provide feature)) + (if (not (eq? 'new-catalog feature)) (slib:provide feature)) (slib:load path)) (else ;dispatched loads - (slib:provide feature) (slib:require (car path)) + (if (not (eq? 'new-catalog feature)) (slib:provide feature)) (apply (case (car path) ((macro) macro:load) ((syntactic-closures) synclo:load) @@ -168,8 +170,8 @@ (if (slib:provided? feature?) (slib:require feature))) ;@ (define (provide feature) - (if (not (memq feature *features*)) - (set! *features* (cons feature *features*)))) + (if (not (memq feature slib:features)) + (set! slib:features (cons feature slib:features)))) ;@ (define slib:provide provide) @@ -181,11 +183,13 @@ (define require:provided? provided?) (define require:require require) -(if (and (string->number "0.0") (inexact? (string->number "0.0"))) - (slib:provide 'inexact)) +(let ((x (string->number "0.0"))) + (if (and x (inexact? x)) (slib:provide 'inexact))) (if (rational? (string->number "1/19")) (slib:provide 'rational)) -(if (real? (string->number "0.0")) (slib:provide 'real)) -(if (complex? (string->number "1+i")) (slib:provide 'complex)) +(let ((x (string->number "0.01"))) + (if (and (real? x) (not (integer? x))) (slib:provide 'real))) +(let ((z (string->number "0.01+i"))) + (if (and (complex? z) (not (real? z))) (slib:provide 'complex))) (let ((n (string->number "9999999999999999999999999999999"))) (if (and n (exact? n)) (slib:provide 'bignum))) @@ -224,7 +228,7 @@ (define report:print (lambda args - (for-each (lambda (x) (write x) (display #\ )) args) + (for-each (lambda (x) (write x) (display #\space)) args) (newline))) ;@ (define slib:report @@ -249,7 +253,7 @@ (scheme-implementation-version) 'on (software-type)))) (define slib:report-locations - (let ((features *features*)) + (let ((features slib:features)) (lambda args (define sit (scheme-implementation-type)) (define siv (string->symbol (scheme-implementation-version))) @@ -257,18 +261,18 @@ (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 *features*))) - (else (report:print 'loaded '*FEATURES* ':) (display slib:tab))) + (cond ((eq? (car features) (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 *features*))) (newline)) - (report:print sit siv '*FEATURES* ':) + (if (not (eq? (car features) (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))) - ((not (= (+ -1 5) i)) (display #\ ))) + ((not (= (+ -1 5) i)) (display #\space))) (write x) (set! i (+ -1 i))) - *features*)) + slib:features)) (newline) (report:print sit siv '*CATALOG* ':) (catalog:get #f) |