Commit | Line | Data |
---|---|---|
9ddacf86 KN |
1 | ;;; "Template.scm" configuration template of *features* for Scheme -*-scheme-*- |
2 | ;;; Author: Aubrey Jaffer | |
3 | ;;; | |
4 | ;;; This code is in the public domain. | |
5 | ||
6 | ;;; (software-type) should be set to the generic operating system type. | |
7 | ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. | |
8 | ||
9 | (define (software-type) 'UNIX) | |
10 | ||
11 | ;;; (scheme-implementation-type) should return the name of the scheme | |
12 | ;;; implementation loading this file. | |
13 | ||
14 | (define (scheme-implementation-type) 'Template) | |
15 | ||
16 | ;;; (scheme-implementation-home-page) should return a (string) URI | |
17 | ;;; (Uniform Resource Identifier) for this scheme implementation's home | |
18 | ;;; page; or false if there isn't one. | |
19 | ||
20 | (define (scheme-implementation-home-page) #f) | |
21 | ||
22 | ;;; (scheme-implementation-version) should return a string describing | |
23 | ;;; the version the scheme implementation loading this file. | |
24 | ||
25 | (define (scheme-implementation-version) "?") | |
26 | ||
27 | ;;; (implementation-vicinity) should be defined to be the pathname of | |
28 | ;;; the directory where any auxillary files to your Scheme | |
29 | ;;; implementation reside. | |
30 | ||
31 | (define (implementation-vicinity) | |
32 | (case (software-type) | |
33 | ((UNIX) "/usr/local/src/scheme/") | |
34 | ((VMS) "scheme$src:") | |
35 | ((MS-DOS) "C:\\scheme\\"))) | |
36 | ||
37 | ;;; (library-vicinity) should be defined to be the pathname of the | |
38 | ;;; directory where files of Scheme library functions reside. | |
39 | ||
40 | (define library-vicinity | |
41 | (let ((library-path | |
42 | (or | |
43 | ;; Use this getenv if your implementation supports it. | |
44 | (getenv "SCHEME_LIBRARY_PATH") | |
45 | ;; Use this path if your scheme does not support GETENV | |
46 | ;; or if SCHEME_LIBRARY_PATH is not set. | |
47 | (case (software-type) | |
48 | ((UNIX) "/usr/local/lib/slib/") | |
49 | ((VMS) "lib$scheme:") | |
50 | ((MS-DOS) "C:\\SLIB\\") | |
51 | (else ""))))) | |
52 | (lambda () library-path))) | |
53 | ||
54 | ;;; (home-vicinity) should return the vicinity of the user's HOME | |
55 | ;;; directory, the directory which typically contains files which | |
56 | ;;; customize a computer environment for a user. | |
57 | ||
58 | (define home-vicinity | |
59 | (let ((home-path (getenv "HOME"))) | |
60 | (lambda () home-path))) | |
61 | ||
62 | ;;; *FEATURES* should be set to a list of symbols describing features | |
63 | ;;; of this implementation. Suggestions for features are: | |
64 | ||
65 | (define *features* | |
66 | '( | |
67 | source ;can load scheme source files | |
68 | ;(slib:load-source "filename") | |
69 | ; compiled ;can load compiled files | |
70 | ;(slib:load-compiled "filename") | |
71 | ; rev4-report ;conforms to | |
72 | ; rev3-report ;conforms to | |
73 | ; ieee-p1178 ;conforms to | |
74 | ; sicp ;runs code from Structure and | |
75 | ;Interpretation of Computer | |
76 | ;Programs by Abelson and Sussman. | |
77 | ; rev4-optional-procedures ;LIST-TAIL, STRING->LIST, | |
78 | ;LIST->STRING, STRING-COPY, | |
79 | ;STRING-FILL!, LIST->VECTOR, | |
80 | ;VECTOR->LIST, and VECTOR-FILL! | |
81 | ; rev2-procedures ;SUBSTRING-MOVE-LEFT!, | |
82 | ;SUBSTRING-MOVE-RIGHT!, | |
83 | ;SUBSTRING-FILL!, | |
84 | ;STRING-NULL?, APPEND!, 1+, | |
85 | ;-1+, <?, <=?, =?, >?, >=? | |
86 | ; multiarg/and- ;/ and - can take more than 2 args. | |
87 | ; multiarg-apply ;APPLY can take more than 2 args. | |
88 | ; rationalize | |
89 | ; delay ;has DELAY and FORCE | |
90 | ; with-file ;has WITH-INPUT-FROM-FILE and | |
91 | ;WITH-OUTPUT-FROM-FILE | |
92 | ; string-port ;has CALL-WITH-INPUT-STRING and | |
93 | ;CALL-WITH-OUTPUT-STRING | |
94 | ; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF | |
95 | ; char-ready? | |
96 | ; macro ;has R4RS high level macros | |
97 | ; defmacro ;has Common Lisp DEFMACRO | |
98 | ; eval ;R5RS two-argument eval | |
99 | ; record ;has user defined data structures | |
100 | ; values ;proposed multiple values | |
101 | ; dynamic-wind ;proposed dynamic-wind | |
102 | ; ieee-floating-point ;conforms to | |
103 | full-continuation ;can return multiple times | |
104 | ; object-hash ;has OBJECT-HASH | |
105 | ||
106 | ; sort | |
107 | ; queue ;queues | |
108 | ; pretty-print | |
109 | ; object->string | |
110 | ; format | |
111 | ; trace ;has macros: TRACE and UNTRACE | |
112 | ; compiler ;has (COMPILER) | |
113 | ; ed ;(ED) is editor | |
114 | ; system ;posix (system <string>) | |
115 | getenv ;posix (getenv <string>) | |
116 | ; program-arguments ;returns list of strings (argv) | |
117 | ; Xwindows ;X support | |
118 | ; curses ;screen management package | |
119 | ; termcap ;terminal description package | |
120 | ; terminfo ;sysV terminal description | |
121 | ; current-time ;returns time in seconds since 1/1/1970 | |
122 | )) | |
123 | ||
124 | ;;; (OUTPUT-PORT-WIDTH <port>) | |
125 | (define (output-port-width . arg) 79) | |
126 | ||
127 | ;;; (OUTPUT-PORT-HEIGHT <port>) | |
128 | (define (output-port-height . arg) 24) | |
129 | ||
130 | ;;; (CURRENT-ERROR-PORT) | |
131 | (define current-error-port | |
132 | (let ((port (current-output-port))) | |
133 | (lambda () port))) | |
134 | ||
135 | ;;; (TMPNAM) makes a temporary file name. | |
136 | (define tmpnam (let ((cntr 100)) | |
137 | (lambda () (set! cntr (+ 1 cntr)) | |
138 | (string-append "slib_" (number->string cntr))))) | |
139 | ||
140 | ;;; (FILE-EXISTS? <string>) | |
141 | (define (file-exists? f) #f) | |
142 | ||
143 | ;;; (DELETE-FILE <string>) | |
144 | (define (delete-file f) #f) | |
145 | ||
146 | ;;; FORCE-OUTPUT flushes any pending output on optional arg output port | |
147 | ;;; use this definition if your system doesn't have such a procedure. | |
148 | (define (force-output . arg) #t) | |
149 | ||
150 | ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string | |
151 | ;;; port versions of CALL-WITH-*PUT-FILE. | |
152 | ||
153 | ;;; "rationalize" adjunct procedures. | |
154 | ;;(define (find-ratio x e) | |
155 | ;; (let ((rat (rationalize x e))) | |
156 | ;; (list (numerator rat) (denominator rat)))) | |
157 | ;;(define (find-ratio-between x y) | |
158 | ;; (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) | |
159 | ||
160 | ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can | |
161 | ;;; be returned by CHAR->INTEGER. | |
162 | (define char-code-limit 256) | |
163 | ||
164 | ;;; MOST-POSITIVE-FIXNUM is used in modular.scm | |
165 | (define most-positive-fixnum #x0FFFFFFF) | |
166 | ||
167 | ;;; Return argument | |
168 | (define (identity x) x) | |
169 | ||
170 | ;;; SLIB:EVAL is single argument eval using the top-level (user) environment. | |
171 | (define slib:eval eval) | |
172 | ||
173 | ;;; If your implementation provides R4RS macros: | |
174 | ;(define macro:eval slib:eval) | |
175 | ;(define macro:load load) | |
176 | ||
177 | (define *defmacros* | |
178 | (list (cons 'defmacro | |
179 | (lambda (name parms . body) | |
180 | `(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body)) | |
181 | *defmacros*)))))) | |
182 | (define (defmacro? m) (and (assq m *defmacros*) #t)) | |
183 | ||
184 | (define (macroexpand-1 e) | |
185 | (if (pair? e) (let ((a (car e))) | |
186 | (cond ((symbol? a) (set! a (assq a *defmacros*)) | |
187 | (if a (apply (cdr a) (cdr e)) e)) | |
188 | (else e))) | |
189 | e)) | |
190 | ||
191 | (define (macroexpand e) | |
192 | (if (pair? e) (let ((a (car e))) | |
193 | (cond ((symbol? a) | |
194 | (set! a (assq a *defmacros*)) | |
195 | (if a (macroexpand (apply (cdr a) (cdr e))) e)) | |
196 | (else e))) | |
197 | e)) | |
198 | ||
199 | (define gentemp | |
200 | (let ((*gensym-counter* -1)) | |
201 | (lambda () | |
202 | (set! *gensym-counter* (+ *gensym-counter* 1)) | |
203 | (string->symbol | |
204 | (string-append "slib:G" (number->string *gensym-counter*)))))) | |
205 | ||
206 | (define base:eval slib:eval) | |
207 | (define (defmacro:eval x) (base:eval (defmacro:expand* x))) | |
208 | (define (defmacro:expand* x) | |
209 | (require 'defmacroexpand) (apply defmacro:expand* x '())) | |
210 | ||
211 | (define (slib:eval-load <pathname> evl) | |
212 | (if (not (file-exists? <pathname>)) | |
213 | (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) | |
214 | (call-with-input-file <pathname> | |
215 | (lambda (port) | |
216 | (let ((old-load-pathname *load-pathname*)) | |
217 | (set! *load-pathname* <pathname>) | |
218 | (do ((o (read port) (read port))) | |
219 | ((eof-object? o)) | |
220 | (evl o)) | |
221 | (set! *load-pathname* old-load-pathname))))) | |
222 | ||
223 | (define (defmacro:load <pathname>) | |
224 | (slib:eval-load <pathname> defmacro:eval)) | |
225 | ||
226 | (define slib:warn | |
227 | (lambda args | |
228 | (let ((cep (current-error-port))) | |
229 | (if (provided? 'trace) (print-call-stack cep)) | |
230 | (display "Warn: " cep) | |
231 | (for-each (lambda (x) (display x cep)) args)))) | |
232 | ||
233 | ;;; define an error procedure for the library | |
234 | (define (slib:error . args) | |
235 | (if (provided? 'trace) (print-call-stack (current-error-port))) | |
236 | (apply error args)) | |
237 | ||
238 | ;;; define these as appropriate for your system. | |
239 | (define slib:tab (integer->char 9)) | |
240 | (define slib:form-feed (integer->char 12)) | |
241 | ||
242 | ;;; Support for older versions of Scheme. Not enough code for its own file. | |
243 | (define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) | |
244 | (define t #t) | |
245 | (define nil #f) | |
246 | ||
247 | ;;; Define these if your implementation's syntax can support it and if | |
248 | ;;; they are not already defined. | |
249 | ||
250 | ;(define (1+ n) (+ n 1)) | |
251 | ;(define (-1+ n) (+ n -1)) | |
252 | ;(define 1- -1+) | |
253 | ||
254 | (define in-vicinity string-append) | |
255 | ||
256 | ;;; Define SLIB:EXIT to be the implementation procedure to exit or | |
257 | ;;; return if exitting not supported. | |
258 | (define slib:exit (lambda args #f)) | |
259 | ||
260 | ;;; Here for backward compatability | |
261 | (define scheme-file-suffix | |
262 | (let ((suffix (case (software-type) | |
263 | ((NOSVE) "_scm") | |
264 | (else ".scm")))) | |
265 | (lambda () suffix))) | |
266 | ||
267 | ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever | |
268 | ;;; suffix all the module files in SLIB have. See feature 'SOURCE. | |
269 | ||
270 | (define (slib:load-source f) (load (string-append f ".scm"))) | |
271 | ||
272 | ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced | |
273 | ;;; by compiling "foo.scm" if this implementation can compile files. | |
274 | ;;; See feature 'COMPILED. | |
275 | ||
276 | (define slib:load-compiled load) | |
277 | ||
278 | ;;; At this point SLIB:LOAD must be able to load SLIB files. | |
279 | ||
280 | (define slib:load slib:load-source) | |
281 | ||
282 | (slib:load (in-vicinity (library-vicinity) "require")) |