diff options
Diffstat (limited to 'mitscheme.init')
| -rw-r--r-- | mitscheme.init | 254 |
1 files changed, 254 insertions, 0 deletions
diff --git a/mitscheme.init b/mitscheme.init new file mode 100644 index 0000000..a6f1c0e --- /dev/null +++ b/mitscheme.init @@ -0,0 +1,254 @@ +;;;"mitscheme.init" Initialization for SLIB for MITScheme -*-scheme-*- +;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer. +; +;Permission to copy this software, to redistribute it, 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. + +;;; Make this part of your ~/.scheme.init file. + +;;; (software-type) should be set to the generic operating system type. +(define (software-type) 'UNIX) + +;;; (scheme-implementation-type) should return the name of the scheme +;;; implementation loading this file. + +(define (scheme-implementation-type) 'MITScheme) + +;;; (scheme-implementation-version) should return a string describing +;;; the version the scheme implementation loading this file. + +(define (scheme-implementation-version) "7.3.0") + +;;; *features* should be set to a list of symbols describing features +;;; of this implementation. See Template.scm for the list of feature +;;; names. + +;the following may not be the Right Thing for this application, since +;it causes an error (rather than just returning nil) when the environment +;variable is not defined. +(define getenv get-environment-variable) + +;;; (implementation-vicinity) should be defined to be the pathname of +;;; the directory where any auxillary files to your Scheme +;;; implementation reside. + +(define (implementation-vicinity) + (case (software-type) + ((UNIX) "/usr/local/src/scheme/") + ((VMS) "scheme$src:"))) + +;;; (library-vicinity) should be defined to be the pathname of the +;;; directory where files of Scheme library functions reside. + +(define library-vicinity + (let ((library-path + (or (getenv "SCHEME_LIBRARY_PATH") + ;; Use this path if your scheme does not support GETENV. + (case (software-type) + ((UNIX) "/usr/local/lib/slib/") + ((VMS) "lib$scheme:") + ((MS-DOS) "C:\\SLIB\\") + (else ""))))) + (lambda () library-path))) + +(define *features* + '( + source ;can load scheme source files + ;(slib:load-source "filename") + compiled ;can load compiled files + ;(slib:load-compiled "filename") + rev4-report + ieee-p1178 + sicp + rev4-optional-procedures + rev3-procedures + rev2-procedures + multiarg/and- + multiarg-apply + rationalize + object-hash + delay + with-file + string-port + transcript + char-ready? + record + values + dynamic-wind + ieee-floating-point + full-continuation +; sort + queue + pretty-print + object->string + trace ;has macros: TRACE and UNTRACE + compiler + getenv + Xwindows + )) + +;;; (OUTPUT-PORT-WIDTH <port>) +(define output-port-width output-port/x-size) + +;;; (OUTPUT-PORT-HEIGHT <port>) +(define (output-port-height . arg) 24) + +;;; (CURRENT-ERROR-PORT) +(define current-error-port + (let ((port console-output-port)) + (lambda () port))) + +;;; (TMPNAM) makes a temporary file name. +(define tmpnam + (let ((cntr 100)) + (lambda () (set! cntr (+ 1 cntr)) + (let ((tmp (string-append "slib_" (number->string cntr)))) + (if (file-exists? tmp) (tmpnam) tmp))))) + +;;; FORCE-OUTPUT flushes any pending output on optional arg output port. +(define force-output flush-output) +;;; MITScheme 7.2 is missing flush-output. Use this instead +;(define (force-output . arg) #t) + +;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;; port versions of CALL-WITH-*PUT-FILE. +(define (call-with-output-string proc) + (let ((co (current-output-port))) + (with-output-to-string + (lambda () + (let ((port (current-output-port))) + (with-output-to-port co + (lambda () (proc port)))))))) + +(define (call-with-input-string string proc) + (let ((ci (current-input-port))) + (with-input-from-string string + (lambda () + (let ((port (current-input-port))) + (with-input-from-port ci + (lambda () (proc port)))))))) + +(define object->string write-to-string) + +;;; CHAR-CODE-LIMIT is one greater than the largest integer which can +;;; be returned by CHAR->INTEGER. It is defined by MITScheme. + +;;; MOST-POSITIVE-FIXNUM is used in modular.scm +(define most-positive-fixnum #x03FFFFFF) + +;;; Return argument +(define (identity x) x) + +;;; If your implementation provides eval, SLIB:EVAL is single argument +;;; eval using the top-level (user) environment. +;(define (slib:eval form) (eval form (repl/environment (nearest-repl)))) +(define (slib:eval form) (eval form user-initial-environment)) + +(define *macros* '(defmacro)) +(define (defmacro? m) (and (memq m *macros*) #t)) + +(syntax-table-define system-global-syntax-table 'defmacro + (macro defmacargs + (let ((macname (car defmacargs)) (macargs (cadr defmacargs)) + (macbdy (cddr defmacargs))) + `(begin + (set! *macros* (cons ',macname *macros*)) + (syntax-table-define system-global-syntax-table ',macname + (macro ,macargs ,@macbdy)))))) + +(define (macroexpand-1 e) + (if (pair? e) (let ((a (car e))) + (if (and (symbol? a) (defmacro? a)) + (apply (syntax-table-ref system-global-syntax-table a) + (cdr e)) + e)) + e)) + +(define (macroexpand e) + (if (pair? e) (let ((a (car e))) + (if (and (symbol? a) (defmacro? a)) + (macroexpand + (apply (syntax-table-ref system-global-syntax-table a) + (cdr e))) + e)) + e)) + +(define gentemp + (let ((*gensym-counter* -1)) + (lambda () + (set! *gensym-counter* (+ *gensym-counter* 1)) + (string->symbol + (string-append "slib:G" (number->string *gensym-counter*)))))) + +(define defmacro:eval slib:eval) +(define defmacro:load load) +;;; If your implementation provides R4RS macros: +;(define macro:eval slib:eval) +;(define macro:load load) + +(define (slib:eval-load <pathname> evl) + (if (not (file-exists? <pathname>)) + (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) + (call-with-input-file <pathname> + (lambda (port) + (let ((old-load-pathname *load-pathname*)) + (set! *load-pathname* <pathname>) + (do ((o (read port) (read port))) + ((eof-object? o)) + (evl o)) + (set! *load-pathname* old-load-pathname))))) + +(define record-modifier record-updater) ;some versions need this? + +;; define an error procedure for the library +(define (slib:error . args) + (apply error-procedure (append args (list (the-environment))))) + +;; define these as appropriate for your system. +(define slib:tab (integer->char 9)) +(define slib:form-feed (integer->char 12)) + +(define in-vicinity string-append) + +;;; Define SLIB:EXIT to be the implementation procedure to exit or +;;; return if exitting not supported. +(define slib:exit + (lambda args + (cond ((null? args) (exit)) + ((eqv? #t (car args)) (exit)) + ((and (number? (car args)) (integer? (car args))) (exit (car args))) + (else (exit 1))))) + +;;; Here for backward compatability + +(define (scheme-file-suffix) "") + +;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever +;;; suffix all the module files in SLIB have. See feature 'SOURCE. + +(define slib:load-source load) + +;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced +;;; by compiling "foo.scm" if this implementation can compile files. +;;; See feature 'COMPILED. + +(define slib:load-compiled load) + +;;; At this point SLIB:LOAD must be able to load SLIB files. + +(define slib:load slib:load-source) + +(slib:load (in-vicinity (library-vicinity) "require")) |