Commit | Line | Data |
---|---|---|
bd5b51c2 KN |
1 | ;;; "guile.init" 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) 'Guile) | |
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) "http://www.gnu.org/software/guile/") | |
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 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 | (let ((path (string-append (%package-data-dir) "/"))) | |
33 | (lambda () path))) | |
34 | ||
35 | ;;; (library-vicinity) should be defined to be the pathname of the | |
36 | ;;; directory where files of Scheme library functions reside. | |
37 | ||
38 | (define library-vicinity | |
39 | (let ((library-path | |
40 | (or | |
41 | ;; Use this getenv if your implementation supports it. | |
42 | (getenv "SCHEME_LIBRARY_PATH") | |
43 | ;; Use this path if your scheme does not support GETENV | |
44 | ;; or if SCHEME_LIBRARY_PATH is not set. | |
45 | (let ((this-file (port-filename (current-load-port)))) | |
46 | (substring this-file 0 (- (string-length this-file) 10)))))) | |
47 | (lambda () library-path))) | |
48 | ||
49 | ;;; (home-vicinity) should return the vicinity of the user's HOME | |
50 | ;;; directory, the directory which typically contains files which | |
51 | ;;; customize a computer environment for a user. | |
52 | ||
53 | (define home-vicinity | |
54 | (let ((home-path (getenv "HOME"))) | |
55 | (lambda () home-path))) | |
56 | ||
57 | ;;; *FEATURES* should be set to a list of symbols describing features | |
58 | ;;; of this implementation. Suggestions for features are: | |
59 | ||
60 | (define *features* | |
61 | '( | |
62 | source ;can load scheme source files | |
63 | ;(slib:load-source "filename") | |
64 | compiled ;can load compiled files | |
65 | ;(slib:load-compiled "filename") | |
66 | rev4-report ;conforms to | |
67 | rev3-report ;conforms to | |
68 | ieee-p1178 ;conforms to | |
69 | ; sicp ;runs code from Structure and | |
70 | ;Interpretation of Computer | |
71 | ;Programs by Abelson and Sussman. | |
72 | rev4-optional-procedures ;LIST-TAIL, STRING->LIST, | |
73 | ;LIST->STRING, STRING-COPY, | |
74 | ;STRING-FILL!, LIST->VECTOR, | |
75 | ;VECTOR->LIST, and VECTOR-FILL! | |
76 | rev2-procedures ;SUBSTRING-MOVE-LEFT!, | |
77 | ;SUBSTRING-MOVE-RIGHT!, | |
78 | ;SUBSTRING-FILL!, | |
79 | ;STRING-NULL?, APPEND!, 1+, | |
80 | ;-1+, <?, <=?, =?, >?, >=? | |
81 | multiarg/and- ;/ and - can take more than 2 args. | |
82 | multiarg-apply ;APPLY can take more than 2 args. | |
83 | ; rationalize | |
84 | delay ;has DELAY and FORCE | |
85 | with-file ;has WITH-INPUT-FROM-FILE and | |
86 | ;WITH-OUTPUT-FROM-FILE | |
87 | string-port ;has CALL-WITH-INPUT-STRING and | |
88 | ;CALL-WITH-OUTPUT-STRING | |
89 | ; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF | |
90 | char-ready? | |
c7228382 KN |
91 | ; macro ;has R4RS high level macros |
92 | ; macro-by-example | |
bd5b51c2 KN |
93 | defmacro ;has Common Lisp DEFMACRO |
94 | eval ;R5RS two-argument eval | |
95 | record ;has user defined data structures | |
96 | values ;proposed multiple values | |
97 | dynamic-wind ;proposed dynamic-wind | |
98 | ieee-floating-point ;conforms to | |
99 | full-continuation ;can return multiple times | |
100 | ; object-hash ;has OBJECT-HASH | |
101 | ||
102 | sort | |
103 | ; queue ;queues | |
104 | ; pretty-print | |
105 | object->string | |
106 | ; format | |
107 | ; trace ;has macros: TRACE and UNTRACE | |
108 | ; compiler ;has (COMPILER) | |
109 | ; ed ;(ED) is editor | |
110 | system ;posix (system <string>) | |
111 | getenv ;posix (getenv <string>) | |
112 | program-arguments ;returns list of strings (argv) | |
113 | ; Xwindows ;X support | |
114 | ; curses ;screen management package | |
115 | ; termcap ;terminal description package | |
116 | ; terminfo ;sysV terminal description | |
117 | current-time ;returns time in seconds since 1/1/1970 | |
118 | ||
119 | abort | |
120 | array | |
121 | array-for-each | |
122 | random | |
123 | hash | |
124 | hash-table | |
125 | line-i/o | |
126 | logical | |
127 | promise | |
128 | string-case | |
c7228382 | 129 | ; syntax-case |
bd5b51c2 KN |
130 | )) |
131 | ||
132 | ;; time | |
133 | (define difftime -) | |
134 | (define offset-time +) | |
135 | ||
136 | ;; random | |
137 | (define (make-random-state . args) | |
138 | (let ((seed (if (null? args) *random-state* (car args)))) | |
139 | (cond ((string? seed)) | |
140 | ((number? seed) (set! seed (number->string seed))) | |
141 | (else (let () | |
142 | (require 'object->string) | |
143 | (set! seed (object->limited-string seed 50))))) | |
144 | (seed->random-state seed))) | |
145 | ||
146 | ;;; (OUTPUT-PORT-WIDTH <port>) | |
147 | (define (output-port-width . arg) 79) | |
148 | ||
149 | ;;; (OUTPUT-PORT-HEIGHT <port>) | |
150 | (define (output-port-height . arg) 24) | |
151 | ||
152 | ;;; "rationalize" adjunct procedures. | |
153 | ;;(define (find-ratio x e) | |
154 | ;; (let ((rat (rationalize x e))) | |
155 | ;; (list (numerator rat) (denominator rat)))) | |
156 | ;;(define (find-ratio-between x y) | |
157 | ;; (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) | |
158 | ||
159 | ;;; Return argument | |
160 | (define (identity x) x) | |
161 | ||
162 | ;;; SLIB:EVAL is single argument eval using the top-level (user) environment. | |
163 | (define (slib:eval x) | |
164 | (eval x (interaction-environment))) | |
165 | ||
166 | (define base:eval slib:eval) | |
167 | (define (defmacro:eval x) (base:eval (defmacro:expand* x))) | |
168 | (define (defmacro:expand* x) | |
169 | (require 'defmacroexpand) (apply defmacro:expand* x '())) | |
170 | ||
171 | (define (slib:eval-load <pathname> evl) | |
172 | (if (not (file-exists? <pathname>)) | |
173 | (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) | |
174 | (call-with-input-file <pathname> | |
175 | (lambda (port) | |
176 | (let ((old-load-pathname *load-pathname*)) | |
177 | (set! *load-pathname* <pathname>) | |
178 | (do ((o (read port) (read port))) | |
179 | ((eof-object? o)) | |
180 | (evl o)) | |
181 | (set! *load-pathname* old-load-pathname))))) | |
182 | ||
183 | (define (defmacro:load <pathname>) | |
184 | (slib:eval-load <pathname> defmacro:eval)) | |
185 | ||
186 | (define slib:warn | |
187 | (lambda args | |
188 | (let ((cep (current-error-port))) | |
189 | (if (provided? 'trace) (print-call-stack cep)) | |
190 | (display "Warn: " cep) | |
191 | (for-each (lambda (x) (display x cep)) args)))) | |
192 | ||
193 | ;;; define an error procedure for the library | |
194 | (define (slib:error . args) | |
195 | (if (provided? 'trace) (print-call-stack (current-error-port))) | |
196 | (apply error args)) | |
197 | ||
198 | ;;; define these as appropriate for your system. | |
199 | (define slib:tab (integer->char 9)) | |
200 | (define slib:form-feed (integer->char 12)) | |
201 | ||
202 | ;;; Support for older versions of Scheme. Not enough code for its own file. | |
203 | (define t #t) | |
204 | (define nil #f) | |
205 | ||
206 | ;;; Define SLIB:EXIT to be the implementation procedure to exit or | |
207 | ;;; return if exitting not supported. | |
208 | (define slib:exit quit) | |
209 | ||
210 | ;;; Here for backward compatability | |
211 | (define scheme-file-suffix | |
212 | (let ((suffix (case (software-type) | |
213 | ((NOSVE) "_scm") | |
214 | (else ".scm")))) | |
215 | (lambda () suffix))) | |
216 | ||
217 | ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever | |
218 | ;;; suffix all the module files in SLIB have. See feature 'SOURCE. | |
219 | ||
220 | (define (slib:load-source f) (load (string-append f (scheme-file-suffix)))) | |
221 | ||
222 | ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced | |
223 | ;;; by compiling "foo.scm" if this implementation can compile files. | |
224 | ;;; See feature 'COMPILED. | |
225 | ||
8f5cfc81 | 226 | (define (slib:load-compiled f) (load-compiled-file (string-append f ".go"))) |
bd5b51c2 KN |
227 | |
228 | ;;; At this point SLIB:LOAD must be able to load SLIB files. | |
229 | ||
8f5cfc81 | 230 | (define slib:load slib:load) |
bd5b51c2 KN |
231 | |
232 | (slib:load (in-vicinity (library-vicinity) "require")) |