;;;"mitscheme.init" Initialization for SLIB for MITScheme -*-scheme-*- ;;; Copyright (C) 1991, 1992, 1993, 1994, 1997 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))) ;;; (home-vicinity) should return the vicinity of the user's HOME ;;; directory, the directory which typically contains files which ;;; customize a computer environment for a user. (define home-vicinity (let ((home-path (getenv "HOME"))) (lambda () home-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 current-time )) (define current-time current-file-time) (define difftime -) (define offset-time +) ;;; (OUTPUT-PORT-WIDTH ) (define output-port-width output-port/x-size) ;;; (OUTPUT-PORT-HEIGHT ) (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 evl) (if (not (file-exists? )) (set! (string-append (scheme-file-suffix)))) (call-with-input-file (lambda (port) (let ((old-load-pathname *load-pathname*)) (set! *load-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 slib:warn (lambda args (let ((port (current-error-port))) (display "Warn: " port) (for-each (lambda (x) (display x port)) args)))) ;; 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"))