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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
;;;; "Bev2slib.scm" Build SLIB catalogs for Stephen Bevan's libraries.
;Copyright (C) 1998 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 warrantee 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.
;;; Put this file into the implementation-vicinity directory for your
;;; scheme implementation.
;;; Add the line
;;; (load (in-vicinity (implementation-vicinity) "Bev2slib.scm"))
;;; to "mkimpcat.scm"
;;; Delete "slibcat" in your implementation-vicinity.
;;; Bind `Bevan-dir' to the directory containing directories "bawk",
;;; "mawk", "pathname", etc. Bev2slib.scm will put entries into the
;;; catalog only for those directories and files which exist.
(let ((Bevan-dir (in-vicinity (library-vicinity) "../"));"/usr/local/lib/Bevan/"
(catname "sitecat"))
(call-with-output-file (in-vicinity (implementation-vicinity) catname)
(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))
(begin
(display* ";\"" catname "\" Site-specific SLIB catalog for "
(scheme-implementation-type) (scheme-implementation-version)
". -*-scheme-*-")
(display* ";")
(display* "; DO NOT EDIT THIS FILE")
(display* "; it is automagically generated by \"Bev2slib.scm\"")
(newline op)
)
;; Output association lists to file "sitecat"
(for-each
(lambda (dir)
(let* ((vic (in-vicinity Bevan-dir (string-append dir "/")))
(map-file (in-vicinity vic (string-append dir ".map"))))
(display* ";;; from " map-file)
(display* "(")
(and
(file-exists? map-file)
(call-with-input-file map-file
(lambda (ip)
(define files '())
(do ((feature (read ip) (read ip)))
((eof-object? feature))
(let* ((type (read ip))
(file (read ip))
(fsym (string->symbol (string-append "Req::" file))))
(and (not (assq fsym files))
(set! files (cons (cons fsym file) files)))
(add-alias feature fsym)))
(for-each
(lambda (pr) (add-alias (car pr) (in-vicinity vic (cdr pr))))
files)
)))
(display* ")")))
'("char-set" "conc-string" "string" "string-03"
"avl-tree" "avl-trie"
"bawk" "mawk" "pathname"))
(begin
(display* "(")
(add-alias 'btree (in-vicinity Bevan-dir "bawk/btree"))
(add-alias 'read-line 'line-i/o)
(display* ")")
))))
|
