summaryrefslogtreecommitdiffstats
path: root/mkpltcat.scm
diff options
context:
space:
mode:
Diffstat (limited to 'mkpltcat.scm')
-rw-r--r--mkpltcat.scm54
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* ")")
+ )))