diff options
Diffstat (limited to 'chez.init')
| -rw-r--r-- | chez.init | 605 |
1 files changed, 300 insertions, 305 deletions
@@ -1,105 +1,55 @@ -;"chez.init" Initialization file for SLIB for Chez Scheme 5.0c -*-scheme-*- -; Copyright (C) 1993 dorai@cs.rice.edu (Dorai Sitaram) -; Copyright (C) 1991, 1992, 1993, 1994, 1997 Aubrey Jaffer. -; Adapted to version 5.0c by stone@math.grin.edu (John David Stone) 1997 -; -;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. - -;; The SOFTWARE-TYPE procedure returns a symbol indicating the generic -;; operating system type. UNIX, VMS, MACOS, AMIGA and MS-DOS are -;; supported. - -(define software-type - (lambda () 'unix)) - -;; The SCHEME-IMPLEMENTATION-TYPE procedure returns a symbol denoting the -;; Scheme implementation that loads this file. - -(define scheme-implementation-type - (lambda () 'chez)) - -;; The SCHEME-IMPLEMENTATION-VERSION procedure returns a string describing -;; the version of the Scheme implementation that loads this file. - -(define scheme-implementation-version - (lambda () "5.0c")) - -;; The IMPLEMENTATION-VICINITY procedure returns a string giving the -;; pathname of the directory that includes any auxiliary files used by this -;; Scheme implementation. +;;;"chez.init" Initialization file for SLIB for Chez Scheme 6.0a -*-scheme-*- +;;; Authors: dorai@cs.rice.edu (Dorai Sitaram) and Aubrey Jaffer. +;;; +;;; This code is in the public domain. + +;;; Adapted to version 5.0c by stone@math.grin.edu (John David Stone) 1997 +;;; Adapted to version 6.0a by Gary T. Leavens <leavens@cs.iastate.edu>, 1999 + +;;; (software-type) should be set to the generic operating system type. +;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. + +(define (software-type) 'UNIX) + +;;; (scheme-implementation-type) should return the name of the scheme +;;; implementation loading this file. + +(define (scheme-implementation-type) 'chez) + +;;; (scheme-implementation-home-page) should return a (string) URL +;;; (Uniform Resource Locator) for this scheme implementation's home +;;; page; or false if there isn't one. + +(define (scheme-implementation-home-page) + "http://www.cs.indiana.edu/chezscheme/") + +;;; (scheme-implementation-version) should return a string describing +;;; the version the scheme implementation loading this file. + +(define (scheme-implementation-version) "6.0a") + +;;; (implementation-vicinity) should be defined to be the pathname of +;;; the directory where any auxillary files to your Scheme +;;; implementation reside. (define implementation-vicinity - (lambda () "/usr/local/chez/5.0c/")) - -;; The GETENV returns the value of a shell environment variable. - -;; In some implementations of Chez Scheme, this can be done with foreign -;; procedures. However, I [JDS] am using the HP version, which does not -;; support them, so a different approach is needed. -;; -;; Here's the version that doesn't work on HPs: -;; -;; (provide-foreign-entries '("getenv")) -;; -;; (define getenv -;; (foreign-procedure "getenv" -;; (string) string)) -;; -;; And here's a version that parses the value out of the output of the -;; /bin/env command: - -(define getenv - (lambda (env-var) - (let ((env-port (car (process "exec /bin/env"))) - (read-line - (lambda (source) - (let ((next (peek-char source))) - (if (eof-object? next) - next - (let loop ((ch (read-char source)) - (so-far '())) - (if (or (eof-object? ch) - (char=? ch #\newline)) - (apply string (reverse so-far)) - (loop (read-char source) (cons ch so-far)))))))) - (position-of-copula - (lambda (str) - (let ((len (string-length str))) - (do ((position 0 (+ position 1))) - ((or (= position len) - (char=? (string-ref str position) #\=)) - position)))))) - (let loop ((equation (read-line env-port))) - (if (eof-object? equation) - #f - (let ((break (position-of-copula equation)) - (len (string-length equation))) - (if (string=? (substring equation 0 break) env-var) - (if (= break len) - "" - (substring equation (+ break 1) len)) - (loop (read-line env-port))))))))) - -;; The LIBRARY-VICINITY procedure returns the pathname of the directory -;; where Scheme library functions reside. + (lambda () "/usr/unsup/scheme/chez/")) + +;;; (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") - "/usr/local/lib/slib/"))) + (let ((library-path + (or + ;; Use this getenv if your implementation supports it. + (getenv "SCHEME_LIBRARY_PATH") + ;; Use this path if your scheme does not support GETENV + ;; or if SCHEME_LIBRARY_PATH is not set. + (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 @@ -110,88 +60,219 @@ (let ((home-path (getenv "HOME"))) (lambda () home-path))) -;; The OUTPUT-PORT-WIDTH procedure returns the number of graphic characters -;; that can reliably be displayed on one line of the standard output port. +;;; *FEATURES* should be set to a list of symbols describing features +;;; of this implementation. Suggestions for features are: + +(define *features* + '( + source ; Chez Scheme can load Scheme source files, with the + ; command (slib:load-source "filename") -- see below. + + compiled ; Chez Scheme can also load compiled Scheme files, with the + ; command (slib:load-compiled "filename") -- see below. + 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 ;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? + macro ;has R4RS high level macros +; defmacro ;has Common Lisp DEFMACRO + eval ;R5RS two-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 + fluid-let + random + rev3-procedures + )) + +;;; (OUTPUT-PORT-WIDTH <port>) returns the number of graphic characters +;;; that can reliably be displayed on one line of the standard output port. (define output-port-width (lambda arg (let ((env-width-string (getenv "COLUMNS"))) (if (and env-width-string - (let loop ((remaining (string-length env-width-string))) - (or (zero? remaining) - (let ((next (- remaining 1))) - (and (char-numeric? (string-ref env-width-string - next)) - (loop next)))))) - (- (string->number env-width-string) 1) - 79)))) - -;; The OUTPUT-PORT-HEIGHT procedure returns the number of lines of text -;; that can reliably be displayed simultaneously in the standard output -;; port. + (let loop ((remaining (string-length env-width-string))) + (or (zero? remaining) + (let ((next (- remaining 1))) + (and (char-numeric? (string-ref env-width-string + next)) + (loop next)))))) + (- (string->number env-width-string) 1) + 79)))) + +;;; (OUTPUT-PORT-HEIGHT <port>) returns the number of lines of text that +;;; can reliably be displayed simultaneously in the standard output port. (define output-port-height (lambda arg (let ((env-height-string (getenv "LINES"))) (if (and env-height-string - (let loop ((remaining (string-length env-height-string))) - (or (zero? remaining) - (let ((next (- remaining 1))) - (and (char-numeric? (string-ref env-height-string - next)) - (loop next)))))) - (string->number env-height-string) - 24)))) - -;; *FEATURES* is a list of symbols describing features of this -;; implementation; SLIB procedures sometimes consult this list to figure -;; out whether to attempt some incompletely standard operation. + (let loop ((remaining (string-length env-height-string))) + (or (zero? remaining) + (let ((next (- remaining 1))) + (and (char-numeric? (string-ref env-height-string + next)) + (loop next)))))) + (string->number env-height-string) + 24)))) + +;;; (CURRENT-ERROR-PORT) +(define current-error-port + (let ((port (console-output-port))) ; changed from current-output-port + (lambda () port))) -(define *features* - '(source ; Chez Scheme can load Scheme source files, with the - ; command (slib:load-source "filename") -- see below. +;;; (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))))) - compiled ; Chez Scheme can also load compiled Scheme files, with the - ; command (slib:load-compiled "filename") -- see below. +;;; (FILE-EXISTS? <string>) is built-in to Chez Scheme - char-ready? delay dynamic-wind fluid-let format - full-continuation getenv ieee-p1178 macro multiarg/and- - multiarg-apply pretty-print random random-inexact rationalize - rev3-procedures rev3-report rev4-optional-procedures rev4-report - sort string-port system transcript values with-file)) +;;; (DELETE-FILE <string>) is built-in to Chez Scheme -;; Version 5.0c has R4RS macros, but not defmacro. +;; The FORCE-OUTPUT requires buffered output that has been written to a +;; port to be transferred all the way out to its ultimate destination. +(define force-output flush-output-port) -(define *defmacros* - (list (cons 'defmacro - (lambda (name parms . body) - `(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body)) - *defmacros*)))))) -(define (defmacro? m) (and (assq m *defmacros*) #t)) +;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;; port versions of CALL-WITH-*PUT-FILE. -(define (macroexpand-1 e) - (if (pair? e) (let ((a (car e))) - (cond ((symbol? a) (set! a (assq a *defmacros*)) - (if a (apply (cdr a) (cdr e)) e)) - (else e))) - e)) +;;; CHAR-CODE-LIMIT is one greater than the largest integer which can +;;; be returned by CHAR->INTEGER. +(define char-code-limit 256) -(define (macroexpand e) - (if (pair? e) (let ((a (car e))) - (cond ((symbol? a) - (set! a (assq a *defmacros*)) - (if a (macroexpand (apply (cdr a) (cdr e))) e)) - (else e))) - e)) +;;; MOST-POSITIVE-FIXNUM is used in modular.scm +;; Chez's MOST-POSITIVE-FIXNUM is a thunk rather than a number. -(define base:eval eval) -(define (defmacro:eval x) (base:eval (defmacro:expand* x))) -(define (defmacro:expand* x) - (require 'defmacroexpand) (apply defmacro:expand* x '())) +(if (procedure? most-positive-fixnum) + (set! most-positive-fixnum (most-positive-fixnum))) + +;;; Return argument +(define (identity x) x) -;; Chez's sorting routines take parameters in the order opposite to SLIB's. -;; The following definitions override the predefined procedures with the -;; parameters-reversed versions. +;;; SLIB:EVAL is single argument eval using the top-level (user) environment. +(define slib:eval eval) + +;;; define an error procedure for the library +(define slib:error + (lambda args + (let ((port (current-error-port))) + (display "Error: " port) + (for-each (lambda (x) (display x port)) args) + (error #f "")))) + +;;; define these as appropriate for your system. +(define slib:tab #\tab) +(define slib:form-feed #\page) + +;;; Support for older versions of Scheme. Not enough code for its own file. +;;; last-pair is built-in to Chez Scheme +(define t #t) +(define nil #f) + +;;; Define these if your implementation's syntax can support it and if +;;; they are not already defined. +;;; 1+, -1+, and 1- are built-in to Chez Scheme +;(define (1+ n) (+ n 1)) +;(define (-1+ n) (+ n -1)) +;(define 1- -1+) + +;;; (IN-VICINITY <string>) is simply STRING-APPEND, conventionally used +;;; to attach a directory pathname to the name of a file that is expected to +;;; be in that directory. +(define in-vicinity string-append) + +;;; Define SLIB:EXIT to be the implementation procedure to exit or +;;; return if exitting not supported. +(define slib:chez:quit + (let ((arg (call-with-current-continuation identity))) + (cond ((procedure? arg) arg) + (arg (exit)) + (else (exit 1))))) + +(define slib:exit + (lambda args + (cond ((null? args) (slib:chez:quit #t)) + ((eqv? #t (car args)) (slib:chez:quit #t)) + ((eqv? #f (car args)) (slib:chez:quit #f)) + ((zero? (car args)) (slib:chez:quit #t)) + (else (slib:chez:quit #f))))) + +;;; For backward compatability, the SCHEME-FILE-SUFFIX procedure is defined +;;; to return the string ".scm". Note, however, that ".ss" is a common Chez +;;; file suffix. +(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. + +(define (slib:load-source f) (load (string-append f ".scm"))) + +;;; (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) + +;;; The following make procedures in Chez Scheme compatible with +;;; the assumptions of SLIB. + +;;; Chez's sorting routines take parameters in the order opposite to SLIB's. +;;; The following definitions override the predefined procedures with the +;;; parameters-reversed versions. See the SORT feature. (define chez:sort sort) (define chez:sort! sort!) @@ -211,7 +292,8 @@ (lambda (s1 s2 p) (chez:merge! p s1 s2))) -;; Chez's (FORMAT F . A) corresponds to SLIB's (FORMAT #F F . A) +;;; Chez's (FORMAT F . A) corresponds to SLIB's (FORMAT #F F . A) +;;; See the FORMAT feature. (define chez:format format) @@ -222,173 +304,86 @@ ((eq? where #t) (display str)) (else (display str where)))))) -;; Chez's NIL variable is bound to '(); SLIB's is bound to #F. - -(define nil #f) - -;; SLIB provides identifiers for the TAB (ASCII 9) and FORM-FEED (ASCII 12) -;; characters. - -(define slib:tab #\tab) -(define slib:form-feed #\page) - ;; The following definitions implement a few widely useful procedures that ;; Chez Scheme does not provide or provides under a different name. -;; The RENAME-FILE procedure constructs and executes a Unix mv command to -;; change the name of a file. - -(define rename-file - (lambda (src dst) - (system (string-append "mv " src " " dst)))) - -;; The CURRENT-ERROR-PORT procedure returns a port to which error -;; messages are to be displayed; this is the original standard output -;; port (even if the program subsequently changes the current output port -;; somehow). - -(define current-error-port - (let ((port (current-output-port))) - (lambda () port))) - -;; SLIB provides its own version of the ERROR procedure. - -(define slib:error - (lambda args - (let ((port (current-error-port))) - (display "Error: " port) - (for-each (lambda (x) (display x port)) args) - (error #f "")))) - -;; The TMPNAM procedure constructs and returns a temporary file name, -;; presumably unique and not a duplicate of one already existing. - -(define tmpnam - (let ((cntr 100)) - (lambda () - (set! cntr (+ 1 cntr)) - (let ((tmp (string-append "slib_" (number->string cntr)))) - (if (file-exists? tmp) (tmpnam) tmp))))) - -;; The FORCE-OUTPUT requires buffered output that has been written to a -;; port to be transferred all the way out to its ultimate destination. - -(define force-output flush-output) - -;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string -;; port versions of CALL-WITH-INPUT-FILE and CALL-WITH-OUTPUT-FILE. +;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;; port versions of CALL-WITH-INPUT-FILE and CALL-WITH-OUTPUT-FILE. +;;; See the STRING-PORT feature. (define call-with-output-string (lambda (f) (let ((outsp (open-output-string))) (f outsp) (let ((s (get-output-string outsp))) - (close-output-port outsp) - s)))) + (close-output-port outsp) + s)))) (define call-with-input-string (lambda (s f) (let* ((insp (open-input-string s)) - (res (f insp))) + (res (f insp))) (close-input-port insp) res))) -;; CHAR-CODE-LIMIT is the number of characters in the character set; only -;; non-negative integers less than CHAR-CODE-LIMIT are eligible as -;; arguments to INTEGER->CHAR. - -(define char-code-limit 256) - -;; Chez's MOST-POSITIVE-FIXNUM is a thunk rather than a number. - -(if (procedure? most-positive-fixnum) - (set! most-positive-fixnum (most-positive-fixnum))) - -;; The IDENTITY procedure returns its argument without change. - -(define identity - (lambda (x) x)) - -;; The GENTEMP procedure generates unused symbols and marks them as -;; belonging to the SLIB package. - -(define gentemp - (let ((*gensym-counter* -1)) - (lambda () - (set! *gensym-counter* (+ *gensym-counter* 1)) - (string->symbol - (string-append "slib:G" (number->string *gensym-counter*)))))) - -;; The IN-VICINITY procedure is simply STRING-APPEND, conventionally used -;; to attach a directory pathname to the name of a file that is expected to -;; be in that directory. - -(define in-vicinity string-append) - -;; For backward compatability, the SCHEME-FILE-SUFFIX procedure is defined -;; to return the string ".scm". Note, however, that ".ss" is a common Chez -;; file suffix. - -(define scheme-file-suffix - (lambda () ".scm")) - -;; SLIB appropriates Chez Scheme's EVAL procedure. - -(define slib:eval eval) +;;; If your implementation provides R4RS macros: (define macro:eval slib:eval) +;;; macro:load also needs the default suffix. +(define macro:load slib:load-source) -(define slib:eval-load - (lambda (<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)))))) - -;; SLIB:EXIT is the implementation procedure that exits, or returns -;; if exiting is not supported. - -(define slib:chez:quit - (let ((arg (call-with-current-continuation identity))) - (cond ((procedure? arg) arg) - (arg (exit)) - (else (exit 1))))) - -(define slib:exit - (lambda args - (cond ((null? args) (slib:chez:quit #t)) - ((eqv? #t (car args)) (slib:chez:quit #t)) - ((eqv? #f (car args)) (slib:chez:quit #f)) - ((zero? (car args)) (slib:chez:quit #t)) - (else (slib:chez:quit #f))))) - -;; The SLIB:LOAD-SOURCE procedure, given a string argument, should attach -;; the appropriate file suffix to the string and load the file named -;; by the resulting string. - -(define slib:load-source - (lambda (f) - (load (string-append f (scheme-file-suffix))))) - -;;; defmacro:load and macro:load also need the default suffix. +(define *defmacros* + (list (cons 'defmacro + (lambda (name parms . body) + `(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body)) + *defmacros*)))))) +(define (defmacro? m) (and (assq m *defmacros*) #t)) -(define macro:load slib:load-source) +(define (macroexpand-1 e) + (if (pair? e) (let ((a (car e))) + (cond ((symbol? a) (set! a (assq a *defmacros*)) + (if a (apply (cdr a) (cdr e)) e)) + (else e))) + e)) -;; The SLIB:LOAD-COMPILED procedure, given a string argument, finds and -;; loads the file, assumed to have been compiled. +(define (macroexpand e) + (if (pair? e) (let ((a (car e))) + (cond ((symbol? a) + (set! a (assq a *defmacros*)) + (if a (macroexpand (apply (cdr a) (cdr e))) e)) + (else e))) + e)) -(define slib:load-compiled load) +;;; According to Kent Dybvig, you can improve the Chez Scheme init +;;; file by defining gentemp to be gensym in Chez Scheme. +(define gentemp gensym) -;; SLIB:LOAD can now be defined to load SLIB files. +(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 slib:load slib:load-source) +(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 (defmacro:load <pathname>) + (slib:eval-load <pathname> defmacro:eval)) + +(define slib:warn + (lambda args + (let ((port (current-error-port))) + (display "Warn: " port) + (for-each (lambda (x) (display x port)) args)))) -;; Load the REQUIRE package. +;;; Load the REQUIRE package. (slib:load (in-vicinity (library-vicinity) "require")) |