summaryrefslogtreecommitdiffstats
path: root/require.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:38 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:38 -0800
commit64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 (patch)
tree1b23b8e8005328194e2fb4bf653806c85050933f /require.scm
parent5bea21e81ed516440e34e480f2c33ca41aa8c597 (diff)
downloadslib-64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34.tar.gz
slib-64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34.zip
Import Upstream version 3a5upstream/3a5
Diffstat (limited to 'require.scm')
-rw-r--r--require.scm79
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)))