;*=====================================================================*/ ;* serrano/prgm/project/bigloo/contrib/slib.init ... */ ;* ------------------------------------------------------------- */ ;* Author : D. Love, A. Jaffer and R. Sanders */ ;* Creation : Tue Nov 8 12:51:10 1994 */ ;* Last change : Fri Apr 13 17:46:11 1999 (Gary Leavens) */ ;* ------------------------------------------------------------- */ ;* slib.init */ ;*=====================================================================*/ ;; SLIB is available from altdorf.ai.mit.edu:/archive/scm (beta ;; versions in /archive/jaffer) ;; "bigloo.init" Initialisation for SLIB for Bigloo -*-scheme-*- ;; Copyright 1994 Robert Sanders ;; Copyright 1991, 1992, 1993 Aubrey Jaffer ;; Copyright 1991 David Love ;; ;; 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. (define (software-type) 'UNIX) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. (define (scheme-implementation-type) 'Bigloo) ;;; (scheme-implementation-version) should return a string describing ;;; the version the scheme implementation loading this file. (define (scheme-implementation-version) "2.0c") ;;; (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/unsup/lib/bigloo/") ((VMS) "scheme$src:") ((MSDOS) "C:\\scheme\\"))) ;;; (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 ;; 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) "/home/bambam/leavens/unsup-src/scheme/scm/slib/") ((VMS) "lib$scheme:") ((MSDOS) "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))) ;;; *FEATURES* should be set to a list of symbols describing features ;;; of this implementation. See Template.scm for the list of feature ;;; names. (define *features* '( source ;can load scheme source files ;(slib:load-source "filename") rev4-report ;conforms to rev3-report ;conforms to ieee-p1178 ;conforms to rev4-optional-procedures rev3-procedures multiarg/and- multiarg-apply rationalize object-hash delay promise with-file transcript ieee-floating-point eval pretty-print object->string string-case string-port system getenv defmacro ; full-continuation ;not without the -call/cc switch )) (define pretty-print pp) (define (object->string x) (obj->string x)) ;;; 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+) ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) ;;; (OUTPUT-PORT-HEIGHT ) (define (output-port-height . arg) 24) ;;; (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 ;;; use this definition if your system doesn't have such a procedure. (define (force-output . args) (flush-output-port (if (pair? args) (car args) (current-output-port)))) ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string ;;; port versions of CALL-WITH-*PUT-FILE. (define (call-with-output-string f) (let ((outsp (open-output-string))) (f outsp) (close-output-port outsp))) (define (call-with-input-string s f) (let* ((insp (open-input-string s)) (res (f insp))) (close-input-port insp) res)) ;;; 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 536870911) ;;; Return argument (define (identity x) x) ;; define an error procedure for the library ;;; If your implementation provides eval, SLIB:EVAL is single argument ;;; eval using the top-level (user) environment. (define slib:eval eval) (define-macro (defmacro name . forms) `(define-macro (,name . ,(car forms)) ,@(cdr forms))) (define (defmacro? m) (get-eval-expander m)) (define (macroexpand-1 body) (expand-once body)) (define (macroexpand body) (expand body)) (define (gentemp) (gensym)) (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 (slib:error . args) (error 'slib:error "" args)) ;; define these as appropriate for your system. (define slib:tab (integer->char 9)) (define slib:form-feed (integer->char 12)) ;;; records (defmacro define-record forms (let* ((name (car forms)) (maker-name (symbol-append 'make- name))) `(begin (define-struct ,name ,@(cadr forms)) (define ,maker-name ,name)) )) (define (promise:force p) (force p)) ;;; (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxillary files to your Scheme ;;; implementation reside. (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 (exit 0))) ;;; Here for backward compatability (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) (loadq (string-append f (scheme-file-suffix)))) ;;; (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 loadq) ;;; At this point SLIB:LOAD must be able to load SLIB files. (define slib:load slib:load-source) (define defmacro:eval slib:eval) (define defmacro:load slib:load) ;;; If your implementation provides R4RS macros: ;(define macro:eval slib:eval) ;(define macro:load load) (slib:load (in-vicinity (library-vicinity) "require")) ; eof