diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:40 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:40 -0800 |
commit | 4684239efa63dc1b2c1cbe37ef7d3062029f5532 (patch) | |
tree | 606a687e9279e9bf6048925878968df9875a4973 /mkpltcat.scm | |
parent | 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 (diff) | |
download | slib-4684239efa63dc1b2c1cbe37ef7d3062029f5532.tar.gz slib-4684239efa63dc1b2c1cbe37ef7d3062029f5532.zip |
Import Upstream version 3b1upstream/3b1
Diffstat (limited to 'mkpltcat.scm')
-rw-r--r-- | mkpltcat.scm | 54 |
1 files changed, 54 insertions, 0 deletions
diff --git a/mkpltcat.scm b/mkpltcat.scm new file mode 100644 index 0000000..80d4414 --- /dev/null +++ b/mkpltcat.scm @@ -0,0 +1,54 @@ +;;;; "mkimpcat.scm" Build mzscheme-specific catalog for SLIB. +;;; This code is in the public domain. +;;; Author: Aubrey Jaffer. + +(let ((catname "implcat")) + (define ivcatname (in-vicinity (implementation-vicinity) catname)) + (if (file-exists? ivcatname) (delete-file ivcatname)) + (call-with-output-file ivcatname + (lambda (op) + (define (display* . args) + (for-each (lambda (arg) (display arg op)) args) + (newline op)) + (define (add-alias from to) + (display " " op) + (write (cons from to) op) + (newline op)) + (define (add-srfi feature) + (let ((str (symbol->string feature))) + (define len (string-length str)) + (cond ((not (and (> len 5) + (string-ci= "srfi-" (substring str 0 5)))) + (error 'add-srfi 'bad 'srfi 'name feature))))) + + (display* ";\"" catname "\" Implementation-specific SLIB catalog for " + (scheme-implementation-type) (scheme-implementation-version) + ". -*-scheme-*-") + (display* ";") + (display* "; DO NOT EDIT THIS FILE") + (display* "; it is automagically generated by \"" + (current-load-relative-directory) + "mkimpcat.scm" + "\"") + (display*) + + ;;; Output association lists to file "implcat" + (display* "(") + (do ((kdx 0 (+ 1 kdx))) + ((>= kdx 150)) + (let ((kstr (number->string kdx))) + (cond ((file-exists? + (build-path (collection-path "srfi") + (string-append kstr ".ss"))) + (display " " op) + (write `(,(string->symbol (string-append "srfi-" kstr)) + compiled + (lib ,(string-append kstr ".ss") "srfi")) + op) + (newline op))))) + + (if (string>? (version) "370") + (add-alias 'array 'srfi-63)) + (add-alias 'logical 'srfi-60) + (display* ")") + ))) |