blob: 80d44141c2afa5f28b4cda0ba82e814c5390f373 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
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* ")")
)))
|