From 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:38 -0800
Subject: Import Upstream version 3a5

---
 require.scm | 79 ++++++++++++++++++++++++++++---------------------------------
 1 file changed, 36 insertions(+), 43 deletions(-)

(limited to 'require.scm')

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)))
-- 
cgit v1.2.3