Commit | Line | Data |
---|---|---|
9ddacf86 KN |
1 | ;;; "pscheme.init" SLIB init file for Pocket Scheme -*-scheme-*- |
2 | ;;; Author: Ben Goetter <goetter@mazama.net> | |
3 | ;;; last revised for 1.1.0 on 16 October 2000 | |
4 | ;;; Initial work for 0.2.3 by Robert Goldman (goldman@htc.honeywell.com) | |
5 | ;;; SLIB orig Author: Aubrey Jaffer (jaffer@ai.mit.edu) | |
6 | ;;; | |
7 | ;;; This code is in the public domain. | |
8 | ||
9 | ; best fit for Windows CE? | |
10 | (define (software-type) 'MS-DOS) | |
11 | ||
12 | (define (scheme-implementation-type) 'Pocket-Scheme) | |
13 | (define (scheme-implementation-version) | |
14 | (let ((v (version))) | |
15 | (string-append | |
16 | (number->string (car v)) "." | |
17 | (number->string (cadr v)) "." | |
18 | (number->string (caddr v))))) | |
19 | (define (scheme-implementation-home-page) "http://www.mazama.net/scheme/pscheme.htm") | |
20 | ||
21 | ||
22 | (define in-vicinity string-append) | |
23 | ||
24 | (define (implementation-vicinity) "\\Program Files\\Pocket Scheme\\") | |
25 | (define (library-vicinity) (in-vicinity (implementation-vicinity) "slib\\")) | |
26 | (define (home-vicinity) "\\My Documents\\") | |
27 | ||
28 | ;(define (implementation-vicinity) "D:\\SRC\\PSCHEME\\BUILD\\TARGET\\X86\\NT\\DBG\\") | |
29 | ;(define (library-vicinity) "D:\\SRC\\SLIB\\") | |
30 | ;(define (home-vicinity) "D:\\SRC\\PSCHEME\\") | |
31 | ||
32 | (define *features* | |
33 | '(source | |
34 | rev4-report | |
35 | ieee-p1178 | |
36 | rev4-optional-procedures | |
37 | multiarg/and- | |
38 | multiarg-apply | |
39 | with-file | |
40 | char-ready? | |
41 | defmacro | |
42 | rationalize | |
43 | delay | |
44 | eval | |
45 | dynamic-wind | |
46 | full-continuation | |
47 | ; Undef this to get the SLIB TRACE macros | |
48 | ; trace | |
49 | system | |
50 | string-port | |
51 | )) | |
52 | ||
53 | ||
54 | ;;; (OUTPUT-PORT-WIDTH <port>) | |
55 | ;;; (OUTPUT-PORT-HEIGHT <port>) | |
56 | ;; $BUGBUG completely bogus values. | |
57 | (define (output-port-width . arg) 79) | |
58 | (define (output-port-height . arg) 12) | |
59 | ||
60 | ;;; (TMPNAM) makes a temporary file name. | |
61 | (define tmpnam (let ((cntr 100)) | |
62 | (lambda () (set! cntr (+ 1 cntr)) | |
63 | (string-append "slib_" (number->string cntr))))) | |
64 | ||
65 | ;;; (FILE-EXISTS? <string>) | |
66 | (define (file-exists? f) | |
67 | (with-handlers (((lambda (x) #t) (lambda (x) #f))) | |
68 | (close-input-port (open-input-file f)) | |
69 | #t)) | |
70 | ||
71 | ;; pscheme: current-error-port, delete-file, force-output already defined | |
72 | ||
73 | ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can | |
74 | ;;; be returned by CHAR->INTEGER. | |
75 | ;(define char-code-limit | |
76 | ; (with-handlers ( | |
77 | ; ((lambda (x) #t) (lambda (x) 256)) | |
78 | ; ) | |
79 | ; (integer->char 65535) | |
80 | ; 65536)) | |
81 | ;;; Currently there are only three clients of this symbol. | |
82 | ;;; Following observations relate to PScheme 0.3.5, JACAL 1a9, SLIB 2c5. | |
83 | ;;; JACAL: crashes when set to 65536. | |
84 | ;;; make-crc: extremely inefficient when set to 65536, spending forever in init | |
85 | ;;; precedence-parse: ignores any setting in excess of 256 | |
86 | ;;; So we patch it to 256. | |
87 | (define char-code-limit 256) | |
88 | ||
89 | ;;; MOST-POSITIVE-FIXNUM is used in modular.scm | |
90 | ;;; This is the most positive immediate-value fixnum in PScheme. | |
91 | (define most-positive-fixnum #x07FFFFFF) | |
92 | ||
93 | ;;; Return argument | |
94 | (define (identity x) x) | |
95 | ||
96 | ;;; SLIB:EVAL is single argument eval using the top-level (user) environment. | |
97 | (define slib:eval eval) | |
98 | ||
99 | ;;; If your implementation provides R4RS macros: | |
100 | ;(define macro:eval slib:eval) | |
101 | ;(define macro:load load) | |
102 | ||
103 | ; Define defmacro in terms of our define-macro | |
104 | (define-macro (defmacro name args . body) | |
105 | `(define-macro (,name ,@args) ,@body)) | |
106 | ||
107 | ; following defns removed in 0.6.3 while I rethink macro support | |
108 | ;(define defmacro? macro?) | |
109 | ;(define macroexpand expand-macro) | |
110 | ;(define macroexpand-1 expand-macro-1) | |
111 | ||
112 | (define gentemp gensym) | |
113 | ||
114 | (define base:eval slib:eval) | |
115 | (define defmacro:eval slib:eval) | |
116 | ||
117 | (define (slib:eval-load <pathname> evl) | |
118 | (if (not (file-exists? <pathname>)) | |
119 | (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) | |
120 | (call-with-input-file <pathname> | |
121 | (lambda (port) | |
122 | (let ((old-load-pathname *load-pathname*)) | |
123 | (set! *load-pathname* <pathname>) | |
124 | (do ((o (read port) (read port))) | |
125 | ((eof-object? o)) | |
126 | (evl o)) | |
127 | (set! *load-pathname* old-load-pathname))))) | |
128 | ||
129 | (define (defmacro:load <pathname>) | |
130 | (slib:eval-load <pathname> defmacro:eval)) | |
131 | ||
132 | (define slib:warn | |
133 | (lambda args | |
134 | (let ((port (current-error-port))) | |
135 | (display "Warn: " port) | |
136 | (for-each (lambda (x) (display x port)) args)))) | |
137 | ||
138 | ;;; Define an error procedure for the library | |
139 | (define slib:error error) | |
140 | ||
141 | ;;; As announced by feature string-port | |
142 | (define (call-with-output-string t) | |
143 | (let* ((p (open-output-string)) | |
144 | (r (t p)) | |
145 | (s (get-output-string p))) | |
146 | (close-output-port p) | |
147 | s)) | |
148 | ||
149 | (define (call-with-input-string s t) | |
150 | (let* ((p (open-input-string s)) | |
151 | (r (t p))) | |
152 | (close-input-port p) | |
153 | r)) | |
154 | ||
155 | ;;; define these as appropriate for your system. | |
156 | (define slib:tab (integer->char 9)) | |
157 | (define slib:form-feed (integer->char 12)) | |
158 | ||
159 | ;;; Support for older versions of Scheme. Not enough code for its own file. | |
160 | (define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) | |
161 | (define t #t) | |
162 | (define nil #f) | |
163 | ||
164 | ;;; Define these if your implementation's syntax can support it and if | |
165 | ;;; they are not already defined. | |
166 | ||
167 | (define (1+ n) (+ n 1)) | |
168 | (define (-1+ n) (+ n -1)) | |
169 | (define 1- -1+) | |
170 | ||
171 | ;;; Define SLIB:EXIT to be the implementation procedure to exit or | |
172 | ;;; return if exitting not supported. | |
173 | (define slib:exit exit) | |
174 | ||
175 | ;;; Here for backward compatability | |
176 | (define scheme-file-suffix | |
177 | (let ((suffix (case (software-type) | |
178 | ((NOSVE) "_scm") | |
179 | (else ".scm")))) | |
180 | (lambda () suffix))) | |
181 | ||
182 | ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever | |
183 | ;;; suffix all the module files in SLIB have. See feature 'SOURCE. | |
184 | ||
185 | (define (slib:load-source f) | |
186 | (if (not (file-exists? f)) | |
187 | (set! f (string-append f (scheme-file-suffix)))) | |
188 | (load f)) | |
189 | ||
190 | ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced | |
191 | ;;; by compiling "foo.scm" if this implementation can compile files. | |
192 | ;;; See feature 'COMPILED. | |
193 | ||
194 | (define slib:load-compiled load) | |
195 | ||
196 | ;;; At this point SLIB:LOAD must be able to load SLIB files. | |
197 | ||
198 | (define slib:load slib:load-source) | |
199 | ||
200 | ;;; Pscheme and SLIB both define REQUIRE, so dispatch on argument type. | |
201 | ;;; The SLIB REQUIRE does accept strings, though this facility seems never to be used. | |
202 | (define pscheme:require require) | |
203 | (slib:load (in-vicinity (library-vicinity) "require")) | |
204 | (define slib:require require) | |
205 | (define (require x) | |
206 | (if (string? x) (pscheme:require x) (slib:require x))) |