summaryrefslogtreecommitdiffstats
path: root/require.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:36 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:36 -0800
commit5bea21e81ed516440e34e480f2c33ca41aa8c597 (patch)
tree653ace1b8fe0a9916d861d35ff8f611b46c80d37 /require.scm
parent237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (diff)
downloadslib-5bea21e81ed516440e34e480f2c33ca41aa8c597.tar.gz
slib-5bea21e81ed516440e34e480f2c33ca41aa8c597.zip
Import Upstream version 3a4upstream/3a4
Diffstat (limited to 'require.scm')
-rw-r--r--require.scm46
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)