summaryrefslogtreecommitdiffstats
path: root/manifest.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commit8466d8cfa486fb30d1755c4261b781135083787b (patch)
treec8c12c67246f543c3cc4f64d1c07e003cb1d45ae /manifest.scm
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz
slib-8466d8cfa486fb30d1755c4261b781135083787b.zip
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'manifest.scm')
-rw-r--r--manifest.scm350
1 files changed, 350 insertions, 0 deletions
diff --git a/manifest.scm b/manifest.scm
new file mode 100644
index 0000000..77d6f1b
--- /dev/null
+++ b/manifest.scm
@@ -0,0 +1,350 @@
+;"manifest.scm" List SLIB module requires and exports.
+;Copyright (C) 2003 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1. Any copy made of this software must include this copyright notice
+;in full.
+;
+;2. I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3. In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'line-i/o)
+
+;;@code{(require 'manifest)}
+;;@ftindex manifest
+
+;;@noindent
+;;In some of these examples, @var{slib:catalog} is the SLIB part of
+;;the catalog; it is free of compiled and implementation-specific
+;;entries. It would be defined by:
+;;
+;;@example
+;;(define slib:catalog (cdr (member (assq 'null *catalog*) *catalog*)))
+;;@end example
+
+;;@body
+;;Returns a list of the features @code{require}d by @1 assuming the
+;;predicate @2 and association-list @3.
+(define (file->requires file provided? catalog)
+ (call-with-input-file file
+ (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 (not (memq (cadr feature) requires))
+ (set! requires (cons (cadr feature) requires))))
+ (let loop ((sexp (read port)))
+ (cond ((or (eof-object? sexp) (not (pair? sexp)) (not (list? sexp)))
+ (reverse requires))
+ (else
+ (case (car sexp)
+ ((require)
+ (cond ((not (= 2 (length sexp)))
+ (slib:warn 'bad 'require sexp))
+ (else (add-require (cadr sexp))))
+ (loop (read port)))
+ ((require-if)
+ (cond ((not (= 3 (length sexp)))
+ (slib:warn 'bad 'require-if sexp))
+ ((not (and (pair? (cadr sexp))
+ (list? (cadr sexp))
+ (eq? 'quote (caadr sexp))))
+ (slib:warn
+ 'file->requires 'unquoted 'feature))
+ ((feature-eval
+ (cadadr sexp)
+ (lambda (expression)
+ (if (provided? expression) #t
+ (let ((path (cdr (or (assq expression catalog)
+ '(#f . #f)))))
+ (cond ((symbol? path) (provided? path))
+ (else #f))))))
+ (add-require (caddr sexp))))
+ (loop (read port)))
+ (else (reverse requires)))))))))
+;;@example
+;;(define (provided+? . features)
+;; (lambda (feature)
+;; (or (memq feature features) (provided? feature))))
+;;
+;;(file->requires "obj2str.scm" (provided+? 'compiling) '())
+;; @result{} (string-port generic-write)
+;;
+;;(file->requires "obj2str.scm" provided? '())
+;; @result{} (string-port)
+;;@end example
+
+;;@body
+;;Returns a list of the features @code{require}d by @1 assuming the
+;;predicate @2 and association-list @3.
+(define (feature->requires feature provided? catalog)
+ (define (f2r feature)
+ (define path (cdr (or (assq feature catalog) '(#f . #f))))
+ (define (return path)
+ (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))
+ (else (case (car path)
+ ((source defmacro macro-by-example macro macros-that-work
+ syntax-case syntactic-closures)
+ (return (if (pair? (cdr path))
+ (cadr path)
+ (cdr path))))
+ ((compiled) (list feature))
+ ((aggregate)
+ (apply append (map f2r (cdr path))))
+ (else (slib:error feature 'feature? path))))))
+ (f2r feature))
+;;@example
+;;(feature->requires 'batch (provided+? 'compiling) *catalog*)
+;; @result{} (tree line-i/o databases parameters string-port
+;; pretty-print common-list-functions posix-time)
+;;
+;;(feature->requires 'batch provided? *catalog*)
+;; @result{} (tree line-i/o databases parameters string-port
+;; pretty-print common-list-functions)
+;;
+;;(feature->requires 'batch provided? '((batch . "batch")))
+;; @result{} (tree line-i/o databases parameters string-port
+;; pretty-print common-list-functions)
+;;@end example
+
+;;@body
+;;Returns a list of strings naming existing files loaded (load
+;;slib:load slib:load-source macro:load defmacro:load syncase:load
+;;synclo:load macwork:load) by @1 or any of the files it loads.
+(define (file->loads file)
+ (define loads '())
+ (define (f2l file)
+ (call-with-input-file file
+ (lambda (port)
+ (define (sxp o)
+ (cond ((eof-object? o))
+ ((not (list? o)))
+ ((< (length o) 2))
+ ((memq (car o) '(load slib:load slib:load-source macro:load
+ defmacro:load syncase:load synclo:load
+ macwork:load))
+ (let ((path (load->path (cadr o))))
+ (cond ((not (member path loads))
+ (set! loads (cons path loads))
+ (f2l path)))
+ (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))))
+ (f2l file))
+;;@example
+;;(file->loads (in-vicinity (library-vicinity) "scainit.scm"))
+;; @result{} ("/usr/local/lib/slib/scaexpp.scm"
+;; "/usr/local/lib/slib/scaglob.scm"
+;; "/usr/local/lib/slib/scaoutp.scm")
+;;@end example
+
+;;@body
+;;Given a @code{(load '<expr>)}, where <expr> is a string or vicinity
+;;stuff), @code{(load->path <expr>)} figures a path to the file.
+;;@0 returns that path if it names an existing file; otherwise #f.
+(define (load->path exp)
+ (define (cwv vicproc exp)
+ (let ((a1 (cwp (cadr exp)))
+ (a2 (cwp (caddr exp))))
+ (if (and (string? a1) (string? a2)) (vicproc a1 a2) exp)))
+ (define (cwp exp)
+ (cond ((string? exp) exp)
+ ((not (pair? exp)) ;(slib:warn 'load->path 'strange 'feature exp)
+ exp)
+ (else (case (car exp)
+ ((program-vicinity) (program-vicinity))
+ ((library-vicinity) (library-vicinity))
+ ((implementation-vicinity) (implementation-vicinity))
+ ((user-vicinity) (user-vicinity))
+ ((in-vicinity) (cwv in-vicinity exp))
+ ((sub-vicinity) (cwv sub-vicinity exp))
+ (else (slib:eval exp))))))
+ (let ((ans (cwp exp)))
+ (if (and (string? ans) (file-exists? (string-append ans ".scm")))
+ (string-append ans ".scm")
+ ans)))
+;;@example
+;;(load->path '(in-vicinity (library-vicinity) "mklibcat"))
+;; @result{} "/usr/local/lib/slib/mklibcat.scm"
+;;@end example
+
+;;@body
+;;Returns a list of the identifier symbols defined by SLIB (or
+;;SLIB-style) file @1.
+(define (file->definitions file)
+ (call-with-input-file file
+ (lambda (port)
+ (define defs '())
+ (define (sxp o)
+ (cond ((eof-object? o))
+ ((not (list? o)))
+ ((< (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))))
+ ((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))))
+;;@example
+;;(file->definitions "random.scm")
+;; @result{} (*random-state* make-random-state
+;; seed->random-state copy-random-state random
+;; random:chunk)
+;;@end example
+
+;;@body
+;;Returns a list of the identifier symbols exported (advertised) by
+;;SLIB (or SLIB-style) file @1.
+(define (file->exports file)
+ (call-with-input-file file
+ (lambda (port)
+ (define exports '())
+ (define seen-at? #f)
+ (define (top)
+ (define c (peek-char port))
+ (cond ((eof-object? c))
+ ((char=? #\newline c)
+ (read-line port)
+ (set! seen-at? #f)
+ (top))
+ ((char-whitespace? c)
+ (read-char port)
+ (top))
+ ((char=? #\; c)
+ (read-char port)
+ (cmt))
+ (else (sxp (read port))
+ (if (char-whitespace? (peek-char port)) (read-char port))
+ (top))))
+ (define (cmt)
+ (define c (peek-char port))
+ (cond ((eof-object? c))
+ ((char=? #\; c)
+ (read-char port)
+ (cmt))
+ ((char=? #\@ c)
+ (set! seen-at? #t)
+ (read-line port)
+ (top))
+ (else
+ (read-line port)
+ (top))))
+ (define (sxp o)
+ (cond ((eof-object? o))
+ ((not seen-at?))
+ ((not (list? o)))
+ ((< (length o) 2))
+ ((eq? 'begin (car o)) (for-each sxp (cdr o)))
+ ((< (length o) 3))
+ ((not (memq (car o) '(define define-syntax defmacro))))
+ ((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))))
+;;@example
+;;(file->exports "random.scm")
+;; @result{} (make-random-state seed->random-state
+;; copy-random-state random)
+;;
+;;(file->exports "randinex.scm")
+;; @result{} (random:solid-sphere! random:hollow-sphere!
+;; random:normal-vector! random:normal
+;; random:exp random:uniform)
+;;@end example
+
+;;@body
+;;Returns a list of lists; each sublist holding the name of the file
+;;implementing @1, and the identifier symbols exported (advertised) by
+;;SLIB (or SLIB-style) feature @1, in @2.
+(define (feature->export-alist feature catalog)
+ (define (f2e feature)
+ (define path (cdr (or (assq feature catalog) '(#f . #f))))
+ (define (return path)
+ (define path.scm (string-append path (scheme-file-suffix)))
+ (cond ((file-exists? path.scm)
+ (cons path.scm (file->exports path.scm)))
+ (else (slib:warn 'feature->export-alist 'path? path.scm)
+ (list path))))
+ (cond ((not path) '())
+ ((symbol? path) (f2e path))
+ ((string? path) (list (return path)))
+ ((not (pair? path))
+ (slib:error 'feature->export-alist feature 'path? path))
+ (else (case (car path)
+ ((source defmacro macro-by-example macro macros-that-work
+ syntax-case syntactic-closures)
+ (list (return (if (pair? (cdr path))
+ (cadr path)
+ (cdr path)))))
+ ((compiled) (map list (cdr path)))
+ ((aggregate) (apply append (map f2e (cdr path))))
+ (else (slib:warn 'feature->export-alist feature 'feature? path)
+ '())))))
+ (f2e feature))
+;;@body
+;;Returns a list of all exports of @1.
+(define (feature->exports feature catalog)
+ (apply append (map cdr (feature->export-alist feature catalog))))
+;;@noindent
+;;In the case of @code{aggregate} features, more than one file may
+;;have export lists to report:
+;;
+;;@example
+;;(feature->export-alist 'r5rs slib:catalog))
+;; @result{} (("/usr/local/lib/slib/values.scm"
+;; call-with-values values)
+;; ("/usr/local/lib/slib/mbe.scm"
+;; define-syntax macro:expand
+;; macro:load macro:eval)
+;; ("/usr/local/lib/slib/eval.scm"
+;; eval scheme-report-environment
+;; null-environment interaction-environment))
+;;
+;;(feature->export-alist 'stdio *catalog*)
+;; @result{} (("/usr/local/lib/slib/scanf.scm"
+;; fscanf sscanf scanf scanf-read-list)
+;; ("/usr/local/lib/slib/printf.scm"
+;; sprintf printf fprintf)
+;; ("/usr/local/lib/slib/stdio.scm"
+;; stderr stdout stdin))
+;;
+;;(feature->exports 'stdio slib:catalog)
+;; @result{} (fscanf sscanf scanf scanf-read-list
+;; sprintf printf fprintf stderr stdout stdin)
+;;@end example