diff options
Diffstat (limited to 'gambit.init')
| -rw-r--r-- | gambit.init | 174 |
1 files changed, 124 insertions, 50 deletions
diff --git a/gambit.init b/gambit.init index 47717dc..752d9d0 100644 --- a/gambit.init +++ b/gambit.init @@ -1,5 +1,5 @@ ;;;"gambit.init" Initialisation for SLIB for Gambit -*-scheme-*- -;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer +;;; 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 @@ -21,27 +21,32 @@ ;;; Date: Wed, 12 Jan 1994 15:03:12 -0500 ;;; From: barnett@armadillo.urich.edu (Lewis Barnett) ;;; Relative pathnames for Slib in MacGambit +;;; Hacked yet again for Gambit v2.4, Jan 1997, by Mike Pope -(define (SOFTWARE-TYPE) 'UNIX) ; 'MACOS for MacGambit. +(define (software-type) 'UNIX) ; 'MACOS for MacGambit. (define (scheme-implementation-type) 'gambit) -(define (scheme-implementation-version) "?") - -(define SYSTEM ##unix-system) ; Comment out for 'MACOS +(define (scheme-implementation-version) "2.4") ;;; (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxillary files to your Scheme ;;; implementation reside. (define implementation-vicinity - (let ((arg0 (vector-ref ##argv 0))) - (let loop ((i (- (string-length arg0) 1))) - (cond ((negative? i) "") - ((char=? #\: (string-ref arg0 i)) - (lambda () - (substring arg0 0 (+ i 1)))) - (else (loop (- i 1))))))) + (case (software-type) + ((UNIX) (lambda () "/usr/local/src/scheme/")) + ((VMS) (lambda () "scheme$src:")) + ((MS-DOS) (lambda () "C:\\scheme\\")) + ((WINDOWS) (lambda () "c:/scheme/")) + ((MACOS) + (let ((arg0 (list-ref (argv) 0))) + (let loop ((i (- (string-length arg0) 1))) + (cond ((negative? i) "") + ((char=? #\: (string-ref arg0 i)) + (set! arg0 (substring arg0 0 (+ i 1))) + (lambda () arg0)) + (else (loop (- i 1))))))))) ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. @@ -56,39 +61,77 @@ ((MACOS) (string-append (implementation-vicinity) ":slib:")) ((AMIGA) "dh0:scm/Library/") ((VMS) "lib$scheme:") - ((MS-DOS) "C:\\SLIB\\") + ((WINDOWS MS-DOS) "C:\\SLIB\\") (else "")))) (lambda () library-path))) -;;; *features* should be set to a list of symbols describing features -;;; of this implementation. See Template.scm for the list of feature -;;; names. +;;; (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) #f) + +;;; *FEATURES* should be set to a list of symbols describing features +;;; of this implementation. Suggestions for features are: (define *features* - ((lambda (l) - (if (eq? (SOFTWARE-TYPE) 'MACOS) l (cons 'system l))) '( 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 - object-hash + rev4-report ;conforms to +; rev3-report ;conforms to + ieee-p1178 ;conforms to + sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. + rev4-optional-procedures ;LIST-TAIL, STRING->LIST, + ;LIST->STRING, STRING-COPY, + ;STRING-FILL!, LIST->VECTOR, + ;VECTOR->LIST, and VECTOR-FILL! +; rev2-procedures ;SUBSTRING-MOVE-LEFT!, + ;SUBSTRING-MOVE-RIGHT!, + ;SUBSTRING-FILL!, + ;STRING-NULL?, APPEND!, 1+, + ;-1+, <?, <=?, =?, >?, >=? + multiarg/and- ;/ and - can take more than 2 args. + multiarg-apply ;APPLY can take more than 2 args. rationalize - delay - with-file - transcript + delay ;has DELAY and FORCE + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-FROM-FILE +; string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF char-ready? - ieee-floating-point - full-continuation - ))) +; macro ;has R4RS high level macros + defmacro ;has Common Lisp DEFMACRO + eval ;SLIB:EVAL is single argument eval +; record ;has user defined data structures +; values ;proposed multiple values +; dynamic-wind ;proposed dynamic-wind + ieee-floating-point ;conforms to + full-continuation ;can return multiple times +; object-hash ;has OBJECT-HASH + +; sort +; queue ;queues + pretty-print +; object->string +; format + trace ;has macros: TRACE and UNTRACE +; compiler ;has (COMPILER) +; ed ;(ED) is editor + system ;posix (system <string>) +; getenv ;posix (getenv <string>) + program-arguments ;returns list of strings (argv) +; Xwindows ;X support +; curses ;screen management package +; termcap ;terminal description package +; terminfo ;sysV terminal description +; current-time ;returns time in seconds since 1/1/1970 + )) ;;; (OUTPUT-PORT-WIDTH <port>) (define (output-port-width . arg) 79) @@ -102,39 +145,56 @@ (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))))) +(define tmpnam (let ((cntr 100)) + (lambda () (set! cntr (+ 1 cntr)) + (string-append "slib_" (number->string cntr))))) + +;;; Gambit supports SYSTEM as an "Unstable Addition"; Watch for changes. +(define system ##shell-command) + +;;; (FILE-EXISTS? <string>) +;(define (file-exists? f) #f) + +;;; (DELETE-FILE <string>) +(define (delete-file f) #f) ;;; FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. -(define (force-output . arg) #t) +(define force-output flush-output) + +;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;; port versions of CALL-WITH-*PUT-FILE. ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can ;;; be returned by CHAR->INTEGER. (define char-code-limit 256) ;; MOST-POSITIVE-FIXNUM is used in modular.scm -(define most-positive-fixnum #x1FFFFFFF) ;; 3-bit tag for 68K +(define most-positive-fixnum #x1FFFFFFF) ; 3-bit tag for 68K ;;; Return argument (define (identity x) x) -;;; If your implementation provides eval, SLIB:EVAL is single argument +;;; If your implementation provides eval SLIB:EVAL is single argument ;;; eval using the top-level (user) environment. -(define SLIB:EVAL ##eval-global);; Gambit v1.71 +(define slib:eval eval) + +; Define program-arguments as argv +(define program-arguments argv) ;;; If your implementation provides R4RS macros: ;(define macro:eval slib:eval) ;(define macro:load load) +; Set up defmacro in terms of gambit's define-macro +(define-macro (defmacro name args . body) + `(define-macro (,name ,@args) ,@body)) + (define *defmacros* (list (cons 'defmacro (lambda (name parms . body) `(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body)) - *defmacros*)))))) + *defmacros*)))))) (define (defmacro? m) (and (assq m *defmacros*) #t)) (define (macroexpand-1 e) @@ -160,9 +220,7 @@ (string-append "slib:G" (number->string *gensym-counter*)))))) (define base:eval slib:eval) -(define (defmacro:eval x) (base:eval (defmacro:expand* x))) -(define (defmacro:expand* x) - (require 'defmacroexpand) (apply defmacro:expand* x '())) +(define defmacro:eval base:eval) (define (defmacro:load <pathname>) (slib:eval-load <pathname> defmacro:eval)) @@ -179,13 +237,27 @@ (evl o)) (set! *load-pathname* old-load-pathname))))) +(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 error) +(define slib:error error) ;; define these as appropriate for your system. (define slib:tab (integer->char 9)) (define slib:form-feed (integer->char 12)) +;;; Support for older versions of Scheme. Not enough code for its own file. +(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) +(define t #t) +(define nil #f) + +;;; Define these if your implementation's syntax can support it and if +;;; they are not already defined. + (define (1+ n) (+ n 1)) (define (-1+ n) (- n 1)) (define 1- -1+) @@ -197,8 +269,11 @@ (define slib:exit (lambda args (exit))) ;;; Here for backward compatability - -(define (scheme-file-suffix) ".scm") +(define scheme-file-suffix + (let ((suffix (case (software-type) + ((NOSVE) "_scm") + (else ".scm")))) + (lambda () suffix))) ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever ;;; suffix all the module files in SLIB have. See feature 'SOURCE. @@ -216,4 +291,3 @@ (define slib:load slib:load-source) (slib:load (in-vicinity (library-vicinity) "require")) -;;; --- E O F --- |