From 5bea21e81ed516440e34e480f2c33ca41aa8c597 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:36 -0800
Subject: Import Upstream version 3a4

---
 require.scm | 46 +++++++++++++++++++++++++---------------------
 1 file changed, 25 insertions(+), 21 deletions(-)

(limited to 'require.scm')

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