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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
;; Copyright (C) 1997 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE. If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way. To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.
;;;; "Bev2slib.scm" Build SLIB catalogs for Stephen Bevan's libraries.
;;; Author: Aubrey Jaffer.
;;; 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* ")")
))))
|
