Import Upstream version 3a2upstream/3a2

1 files changed, 69 insertions, 33 deletions

diff --git a/manifest.scm b/manifest.scm
index 77d6f1b..be55ea7 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -39,15 +39,15 @@
     (lambda (port)
       (define requires '())
       (define (add-require feature)
-	(if (and (not (provided? (cadr feature)))
-		 (not (assq (cadr feature) catalog)))
-	    (slib:warn file 'unknown 'feature feature))
+;;; 	(if (and (not (provided? (cadr feature)))
+;;; 		 (not (assq (cadr feature) catalog)))
+;;; 	    (slib:warn file 'unknown 'feature feature))
 	(if (not (memq (cadr feature) requires))
 	    (set! requires (cons (cadr feature) requires))))
+      (if (eqv? #\# (peek-char port)) (read-line port))
       (let loop ((sexp (read port)))
-	(cond ((or (eof-object? sexp) (not (pair? sexp)) (not (list? sexp)))
-	       (reverse requires))
-	      (else
+	(cond ((eof-object? sexp) (reverse requires))
+	      ((pair? sexp)
 	       (case (car sexp)
 		 ((require)
 		  (cond ((not (= 2 (length sexp)))
@@ -72,7 +72,8 @@
 					(else #f))))))
 			 (add-require (caddr sexp))))
 		  (loop (read port)))
-		 (else (reverse requires)))))))))
+		 (else (reverse requires))))
+	      (else (loop (read port))))))))
 ;;@example
 ;;(define (provided+? . features)
 ;;  (lambda (feature)
@@ -95,10 +96,9 @@
       (file->requires (string-append path (scheme-file-suffix))
 		      provided? catalog))
     (cond ((not path) #f)
-	  ((string? path)
-	   (return path))
-	  ((not (pair? path))
-	   (slib:error feature 'path? path))
+	  ((string? path) (return path))
+	  ((symbol? path) (f2r path))
+	  ((not (pair? path)) (slib:error feature 'path? path))
 	  (else (case (car path)
 		  ((source defmacro macro-by-example macro macros-that-work
 			   syntax-case syntactic-closures)
@@ -124,6 +124,33 @@
 ;;                   pretty-print common-list-functions)
 ;;@end example
 
+(define (features->requires* features provided? catalog)
+  (and
+   features
+   (let loop ((new features)
+	      (done '()))
+     (cond
+      ((null? new) done)
+      ((memq (car new) done) (loop (cdr new) done))
+      (else
+       (loop (append (or (feature->requires (car new) provided? catalog) '())
+		     (cdr new))
+	     (cons (car new) done)))))))
+
+;;@body
+;;Returns a list of the features transitively @code{require}d by @1
+;;assuming the predicate @2 and association-list @3.
+(define (feature->requires* feature provided? catalog)
+  (features->requires* (or (feature->requires feature provided? catalog) '())
+		       provided? catalog))
+
+;;@body
+;;Returns a list of the features transitively @code{require}d by @1
+;;assuming the predicate @2 and association-list @3.
+(define (file->requires* file provided? catalog)
+  (features->requires* (file->requires file provided? catalog)
+		       provided? catalog))
+
 ;;@body
 ;;Returns a list of strings naming existing files loaded (load
 ;;slib:load slib:load-source macro:load defmacro:load syncase:load
@@ -147,11 +174,11 @@
 		   (sxp (read port))))
 		((eq? 'begin (car o)) (for-each sxp (cdr o)))
 		(else (sxp (read port)))))
-	(let ((old-load-pathname *load-pathname*))
-	  (set! *load-pathname* file)
-	  (sxp (read port))
-	  (set! *load-pathname* old-load-pathname)
-	  loads))))
+	(with-load-pathname file
+	  (lambda ()
+	    (if (eqv? #\# (peek-char port)) (read-line port))
+	    (sxp (read port))
+	    loads)))))
   (f2l file))
 ;;@example
 ;;(file->loads (in-vicinity (library-vicinity) "scainit.scm"))
@@ -192,8 +219,13 @@
 
 ;;@body
 ;;Returns a list of the identifier symbols defined by SLIB (or
-;;SLIB-style) file @1.
-(define (file->definitions file)
+;;SLIB-style) file @1.  The optional arguments @2 should be symbols
+;;signifying a defining form.  If none are supplied, then the symbols
+;;@code{define-operation}, @code{define}, @code{define-syntax}, and
+;;@code{defmacro} are captured.
+(define (file->definitions file . definers)
+  (if (null? definers)
+      (set! definers '(define-operation define define-syntax defmacro)))
   (call-with-input-file file
     (lambda (port)
       (define defs '())
@@ -203,19 +235,18 @@
 	      ((< (length o) 2))
 	      ((eq? 'begin (car o)) (for-each sxp (cdr o)))
 	      ((< (length o) 3))
-	      ((not (memq (car o)
-			  '(define-operation define define-syntax defmacro))))
+	      ((not (memq (car o) definers)))
 	      ((symbol? (cadr o)) (set! defs (cons (cadr o) defs)))
 	      ((not (pair? (cadr o))))
 	      ((not (symbol? (caadr o))))
 	      (else (set! defs (cons (caadr o) defs))))
 	(cond ((eof-object? o) defs)
 	      (else (sxp (read port)))))
-      (let ((old-load-pathname *load-pathname*))
-	(set! *load-pathname* file)
-	(sxp (read port))
-	(set! *load-pathname* old-load-pathname)
-	defs))))
+      (with-load-pathname file
+	(lambda ()
+	  (if (eqv? #\# (peek-char port)) (read-line port))
+	  (sxp (read port))
+	  defs)))))
 ;;@example
 ;;(file->definitions "random.scm")
 ;;        @result{} (*random-state* make-random-state
@@ -225,8 +256,13 @@
 
 ;;@body
 ;;Returns a list of the identifier symbols exported (advertised) by
-;;SLIB (or SLIB-style) file @1.
-(define (file->exports file)
+;;SLIB (or SLIB-style) file @1.  The optional arguments @2 should be
+;;symbols signifying a defining form.  If none are supplied, then the
+;;symbols @code{define-operation}, @code{define},
+;;@code{define-syntax}, and @code{defmacro} are captured.
+(define (file->exports file . definers)
+  (if (null? definers)
+      (set! definers '(define-operation define define-syntax defmacro)))
   (call-with-input-file file
     (lambda (port)
       (define exports '())
@@ -267,16 +303,16 @@
 	      ((< (length o) 2))
 	      ((eq? 'begin (car o)) (for-each sxp (cdr o)))
 	      ((< (length o) 3))
-	      ((not (memq (car o) '(define define-syntax defmacro))))
+	      ((not (memq (car o) definers)))
 	      ((symbol? (cadr o)) (set! exports (cons (cadr o) exports)))
 	      ((not (pair? (cadr o))))
 	      ((not (symbol? (caadr o))))
 	      (else (set! exports (cons (caadr o) exports)))))
-      (let ((old-load-pathname *load-pathname*))
-	(set! *load-pathname* file)
-	(top)
-	(set! *load-pathname* old-load-pathname)
-	exports))))
+      (with-load-pathname file
+	(lambda ()
+	  (if (eqv? #\# (peek-char port)) (read-line port))
+	  (top)
+	  exports)))))
 ;;@example
 ;;(file->exports "random.scm")
 ;;        @result{} (make-random-state seed->random-state