From 5145dd3aa0c02c9fc496d1432fc4410674206e1d Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:31 -0800 Subject: Import Upstream version 3a2 --- manifest.scm | 102 ++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 69 insertions(+), 33 deletions(-) (limited to 'manifest.scm') 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 -- cgit v1.2.3