summaryrefslogtreecommitdiffstats
path: root/mklibcat.scm
diff options
context:
space:
mode:
Diffstat (limited to 'mklibcat.scm')
-rw-r--r--mklibcat.scm401
1 files changed, 222 insertions, 179 deletions
diff --git a/mklibcat.scm b/mklibcat.scm
index 5b7d211..d41e2e6 100644
--- a/mklibcat.scm
+++ b/mklibcat.scm
@@ -1,5 +1,5 @@
;"mklibcat.scm" Build catalog for SLIB
-;Copyright (C) 1997 Aubrey Jaffer
+;Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 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
@@ -8,7 +8,7 @@
;1. Any copy made of this software must include this copyright notice
;in full.
;
-;2. I have made no warrantee or representation that the operation of
+;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.
;
@@ -17,185 +17,228 @@
;promotional, or sales literature without prior written consent in
;each case.
-(call-with-output-file (in-vicinity (implementation-vicinity) "slibcat")
- (lambda (op)
- (display ";\"slibcat\" SLIB catalog for " op)
- (display (scheme-implementation-type) op)
- (display (scheme-implementation-version) op)
- (display ". -*-scheme-*-" op) (newline op)
- (display ";" op) (newline op)
- (display "; DO NOT EDIT THIS FILE -- it is automagically generated" op)
- (newline op) (newline op)
+(let ((catpath (in-vicinity (implementation-vicinity) "slibcat")))
+ (and (file-exists? catpath) (delete-file catpath))
+ (call-with-output-file catpath
+ (lambda (op)
+ (define (display* . args)
+ (for-each (lambda (arg) (display arg op)) args)
+ (newline op))
+ (define (write* asp)
+ (display " " op) (write asp op) (newline op))
+ (display* ";\"slibcat\" SLIB catalog for "
+ (scheme-implementation-type) (scheme-implementation-version)
+ ". -*-scheme-*-")
+ (display* ";")
+ (display* "; DO NOT EDIT THIS FILE -- it is automagically generated")
+ (display*)
- (display "(" op) (newline op)
- (for-each
- (lambda (asp) (display " " op) (write asp op) (newline op))
- (append
- (list (cons 'schelog
- (in-vicinity (sub-vicinity (library-vicinity) "schelog")
- "schelog"))
- (cons 'portable-scheme-debugger
- (in-vicinity (sub-vicinity (library-vicinity) "psd")
- "psd-slib"))
- (cons 'jfilter
- (in-vicinity (sub-vicinity (library-vicinity) "jfilter")
- "jfilter")))
- (map (lambda (p)
- (if (symbol? (cdr p)) p
- (cons
- (car p)
- (if (pair? (cdr p))
- (cons
- (cadr p)
- (in-vicinity (library-vicinity) (cddr p)))
- (in-vicinity (library-vicinity) (cdr p))))))
- '(
- (rev4-optional-procedures . "sc4opt")
- (rev2-procedures . "sc2")
- (multiarg/and- . "mularg")
- (multiarg-apply . "mulapply")
- (rationalize . "ratize")
- (transcript . "trnscrpt")
- (with-file . "withfile")
- (dynamic-wind . "dynwind")
- (dynamic . "dynamic")
- (fluid-let defmacro . "fluidlet")
- (alist . "alist")
- (hash . "hash")
- (sierpinski . "sierpinski")
- (soundex . "soundex")
- (hash-table . "hashtab")
- (logical . "logical")
- (random . "random")
- (random-inexact . "randinex")
- (modular . "modular")
- (factor . "factor")
- (primes . factor)
- (charplot . "charplot")
- (sort . "sort")
- (tsort . topological-sort)
- (topological-sort . "tsort")
- (common-list-functions . "comlist")
- (tree . "tree")
- (coerce . "coerce")
- (format . "format")
- (generic-write . "genwrite")
- (pretty-print . "pp")
- (pprint-file . "ppfile")
- (object->string . "obj2str")
- (string-case . "strcase")
- (stdio . "stdio")
- (printf . "printf")
- (scanf . "scanf")
- (line-i/o . "lineio")
- (string-port . "strport")
- (getopt . "getopt")
- (debug . "debug")
- (qp . "qp")
- (break defmacro . "break")
- (trace defmacro . "trace")
- (eval . "eval")
- (record . "record")
- (promise . "promise")
- (synchk . "synchk")
- (defmacroexpand . "defmacex")
- (macro-by-example defmacro . "mbe")
- (syntax-case . "scainit")
- (syntactic-closures . "scmacro")
- (macros-that-work . "macwork")
- (macro . macro-by-example)
- (object . "object")
- (yasos macro . "yasyn")
- (oop . yasos)
- (collect macro . "collect")
- (structure syntax-case . "structure")
- (values . "values")
- (queue . "queue")
- (priority-queue . "priorque")
- (array . "array")
- (array-for-each . "arraymap")
- (repl . "repl")
- (process . "process")
- (chapter-order . "chap")
- (posix-time . "psxtime")
- (common-lisp-time . "cltime")
- (time-zone . "timezone")
- (relational-database . "rdms")
- (database-utilities . "dbutil")
- (database-browse . "dbrowse")
- (html-form . "htmlform")
- (alist-table . "alistab")
- (parameters . "paramlst")
- (getopt-parameters . "getparam")
- (read-command . "comparse")
- (batch . "batch")
- (glob . "glob")
- (filename . glob)
- (make-crc . "makcrc")
- (fft . "fft")
- (wt-tree . "wttree")
- (string-search . "strsrch")
- (root . "root")
- (minimize . "minimize")
- (precedence-parse . "prec")
- (parse . precedence-parse)
- (commutative-ring . "cring")
- (self-set . "selfset")
- (determinant . "determ")
- (byte . "byte")
- (tzfile . "tzfile")
- (schmooz . "schmooz")
- (net-clients . "nclients")
- (db->html . "db2html")
- (http . "http-cgi")
- (cgi . http)
- (uri . "uri")
- (uniform-resource-identifier . uri)
- (pnm . "pnm")
- (metric-units . "simetrix")
- (diff . "differ")
- (srfi-0 . srfi)
- (srfi defmacro . "srfi")
- (srfi-1 . "srfi-1")
- (new-catalog . "mklibcat")
- ))))
- (display " " op)
+ (display* "(")
+ (for-each
+ write*
+ (append
+ (list (cons 'schelog
+ (in-vicinity (sub-vicinity (library-vicinity) "schelog")
+ "schelog"))
+ (cons 'portable-scheme-debugger
+ (in-vicinity (sub-vicinity (library-vicinity) "psd")
+ "psd-slib"))
+ (cons 'jfilter
+ (in-vicinity (sub-vicinity (library-vicinity) "jfilter")
+ "jfilter")))
+ (catalog:resolve
+ (library-vicinity)
+ '(
+ ;; null is the start of SLIB associations.
+ (null "null")
+ (aggregate "null")
+ (r2rs aggregate rev3-procedures rev2-procedures)
+ (r3rs aggregate rev3-procedures)
+ (r4rs aggregate rev4-optional-procedures)
+ (r5rs aggregate values macro eval)
+ (rev4-optional-procedures "sc4opt")
+ (rev3-procedures "null")
+ (rev2-procedures "sc2")
+ (multiarg/and- "mularg")
+ (multiarg-apply "mulapply")
+ (rationalize "ratize")
+ (transcript "trnscrpt")
+ (with-file "withfile")
+ (dynamic-wind "dynwind")
+ (dynamic "dynamic")
+ (fluid-let defmacro "fluidlet")
+ (alist "alist")
+ (hash "hash")
+ (sierpinski "sierpinski")
+ (hilbert-fill "phil-spc")
+ (soundex "soundex")
+ (hash-table "hashtab")
+ (logical "logical")
+ (random "random")
+ (random-inexact "randinex")
+ (modular "modular")
+ (factor "factor")
+ (primes factor)
+ (eps-graph "grapheps")
+ (charplot "charplot")
+ (sort "sort")
+ (tsort topological-sort)
+ (topological-sort "tsort")
+ (common-list-functions "comlist")
+ (tree "tree")
+ (coerce "coerce")
+ (format "format")
+ (generic-write "genwrite")
+ (pretty-print "pp")
+ (pprint-file "ppfile")
+ (object->string "obj2str")
+ (string-case "strcase")
+ (line-i/o "lineio")
+ (string-port "strport")
+ (getopt "getopt")
+ (qp "qp")
+ (eval "eval")
+ (record "record")
+ (synchk "synchk")
+ (defmacroexpand "defmacex")
- (let* ((req (in-vicinity (library-vicinity)
- (string-append "require" (scheme-file-suffix)))))
- (write (cons '*SLIB-VERSION* (or (require:version req) *SLIB-VERSION*))
- op))
- (newline op)
- (display ")" op) (newline op)
+ (printf "printf")
+ (scanf defmacro "scanf")
+ (stdio-ports "stdio")
+ (stdio aggregate scanf printf stdio-ports)
- (let ((load-if-exists
- (lambda (path)
- (cond ((not (file-exists? path))
- (set! path (string-append path (scheme-file-suffix)))))
- (cond ((file-exists? path)
- (slib:load-source path))))))
- ;;(load-if-exists (in-vicinity (implementation-vicinity) "mksitcat"))
- (load-if-exists (in-vicinity (implementation-vicinity) "mkimpcat")))
+ (break defmacro "break")
+ (trace defmacro "trace")
+ (debugf "debug")
+ (debug aggregate trace break debugf)
- (let ((catcat
- (lambda (vicinity name specificity)
- (let ((path (in-vicinity vicinity name)))
- (and (file-exists? path)
- (call-with-input-file path
- (lambda (ip)
- (newline op)
- (display "; " op)
- (write path op)
- (display " SLIB " op)
- (display specificity op)
- (display "-specific catalog additions" op)
- (newline op) (newline op)
- (do ((c (read-char ip) (read-char ip)))
- ((eof-object? c))
- (write-char c op)))))))))
- (catcat (library-vicinity) "sitecat" "site")
- (catcat (implementation-vicinity) "implcat" "implementation")
- (catcat (implementation-vicinity) "sitecat" "site"))
- ))
+ (delay promise)
+ (promise macro "promise")
-(set! *catalog* #f)
+ (macro-by-example defmacro "mbe")
+
+ (syntax-case "scainit")
+ (syntactic-closures "scmacro")
+ (macros-that-work "macwork")
+ (macro macro-by-example)
+ (object "object")
+ (yasos macro "yasyn")
+ (oop yasos)
+ (collect "collectx")
+ (structure syntax-case "structure")
+ (values "values")
+ (queue "queue")
+ (priority-queue "priorque")
+ (array "array")
+ (subarray "subarray")
+ (array-for-each "arraymap")
+ (repl "repl")
+ (process "process")
+ (chapter-order "chap")
+ (posix-time "psxtime")
+ (common-lisp-time "cltime")
+ (time-zone defmacro "timezone")
+ (relational-database "rdms")
+ (databases "dbutil")
+ (database-utilities databases)
+ (database-commands "dbcom")
+ (database-browse "dbrowse")
+ (database-interpolate "dbinterp")
+ (within-database macro "dbsyn")
+ (html-form "htmlform")
+ (alist-table "alistab")
+ (parameters "paramlst")
+ (getopt-parameters "getparam")
+ (read-command "comparse")
+ (batch "batch")
+ (glob "glob")
+ (filename glob)
+ (crc "crc")
+ (fft "fft")
+ (wt-tree "wttree")
+ (string-search "strsrch")
+ (root "root")
+ (minimize "minimize")
+ (precedence-parse defmacro "prec")
+ (parse precedence-parse)
+ (commutative-ring "cring")
+ (self-set "selfset")
+ (determinant "determ")
+ (byte "byte")
+ (byte-number "bytenumb")
+ (tzfile "tzfile")
+ (schmooz "schmooz")
+ (transact defmacro "transact")
+ (net-clients transact)
+ (db->html "db2html")
+ (http defmacro "http-cgi")
+ (cgi http)
+ (uri defmacro "uri")
+ (uniform-resource-identifier uri)
+ (pnm "pnm")
+ (metric-units "simetrix")
+ (diff "differ")
+ (solid "solid")
+ (vrml97 solid)
+ (vrml vrml97)
+ (color defmacro "color")
+ (color-space "colorspc")
+ (cie color-space)
+ (color-names "colornam")
+ (color-database defmacro "mkclrnam")
+ (resene color-names "clrnamdb.scm")
+ (saturate color-names "clrnamdb.scm")
+ (daylight "daylight")
+ (matfile "matfile")
+ (mat-file matfile)
+ (spectral-tristimulus-values color-space)
+ (cie1964 spectral-tristimulus-values "cie1964.xyz")
+ (cie1931 spectral-tristimulus-values "cie1931.xyz")
+ (ciexyz cie1931)
+ (cvs defmacro "cvs")
+ (html-for-each defmacro "html4each")
+ (directory "dirs")
+ (ncbi-dna defmacro "ncbi-dna")
+ (manifest "manifest")
+ (top-refs "top-refs")
+ (vet "vet")
+ (srfi-0 srfi)
+ (srfi defmacro "srfi")
+ (srfi-1 "srfi-1")
+ (srfi-2 defmacro "srfi-2")
+ (srfi-8 macro "srfi-8")
+ (srfi-9 macro "srfi-9")
+ (new-catalog "mklibcat")
+ ))))
+ (let* ((req (in-vicinity (library-vicinity)
+ (string-append "require" (scheme-file-suffix)))))
+ (write* (cons '*SLIB-VERSION* (or (slib:version req) *SLIB-VERSION*))))
+ (display* ")")
+
+ (let ((load-if-exists
+ (lambda (path)
+ (cond ((not (file-exists? path))
+ (set! path (string-append path (scheme-file-suffix)))))
+ (cond ((file-exists? path)
+ (slib:load-source path))))))
+ ;;(load-if-exists (in-vicinity (implementation-vicinity) "mksitcat"))
+ (load-if-exists (in-vicinity (implementation-vicinity) "mkimpcat")))
+
+ (let ((catcat
+ (lambda (vicinity name specificity)
+ (let ((path (in-vicinity vicinity name)))
+ (and (file-exists? path)
+ (call-with-input-file path
+ (lambda (ip)
+ (display*)
+ (display* "; " "\"" path "\"" " SLIB "
+ specificity "-specific catalog additions")
+ (display*)
+ (do ((c (read-char ip) (read-char ip)))
+ ((eof-object? c))
+ (write-char c op)))))))))
+ (catcat (library-vicinity) "sitecat" "site")
+ (catcat (implementation-vicinity) "implcat" "implementation")
+ (catcat (implementation-vicinity) "sitecat" "site"))
+ ))
+ (set! *catalog* #f))