diff options
Diffstat (limited to 'bigloo.init')
| -rw-r--r-- | bigloo.init | 178 |
1 files changed, 108 insertions, 70 deletions
diff --git a/bigloo.init b/bigloo.init index 14b9c9e..41a4179 100644 --- a/bigloo.init +++ b/bigloo.init @@ -1,23 +1,7 @@ ;; "bigloo.init" Initialization 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. +;;; Author: Aubrey Jaffer +;;; +;;; This code is in the public domain. (define (software-type) 'UNIX) @@ -26,16 +10,16 @@ (define (scheme-implementation-type) 'Bigloo) -;;; (scheme-implementation-version) should return a string describing -;;; the version the scheme implementation loading this file. - -;;; (scheme-implementation-home-page) should return a (string) URL -;;; (Uniform Resource Locator) for this scheme implementation's home +;;; (scheme-implementation-home-page) should return a (string) URI +;;; (Uniform Resource Identifier) for this scheme implementation's home ;;; page; or false if there isn't one. (define (scheme-implementation-home-page) "http://kaolin.unice.fr/~serrano/bigloo/bigloo.html") +;;; (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 @@ -44,9 +28,9 @@ (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/unsup/lib/bigloo/") + ((UNIX) "/usr/local/lib/bigloo/") ((VMS) "scheme$src:") - ((MSDOS) "C:\\scheme\\"))) + ((MS-DOS) "C:\\scheme\\"))) ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. @@ -59,9 +43,9 @@ ;; 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/") + ((UNIX) "/usr/share/slib/") ((VMS) "lib$scheme:") - ((MSDOS) "C:\\SLIB\\") + ((MS-DOS) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -78,45 +62,82 @@ ;;; names. (define *features* - '( - source ;can load scheme source files + '( + 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 - )) +; compiled ;can load compiled files + ;(slib:load-compiled "filename") + + ;; Scheme report features + +; rev5-report ;conforms to + eval ;R5RS two-argument eval +; values ;R5RS multiple values +; dynamic-wind ;R5RS dynamic-wind +; macro ;R5RS high level macros + delay ;has DELAY and FORCE + multiarg-apply ;APPLY can take more than 2 args. +; char-ready? + rationalize + rev4-optional-procedures ;LIST-TAIL, STRING->LIST, + ;LIST->STRING, STRING-COPY, + ;STRING-FILL!, LIST->VECTOR, + ;VECTOR->LIST, and VECTOR-FILL! + + rev4-report ;conforms to + + ieee-p1178 ;conforms to + + rev3-report ;conforms to + +; rev2-procedures ;SUBSTRING-MOVE-LEFT!, + ;SUBSTRING-MOVE-RIGHT!, + ;SUBSTRING-FILL!, + ;STRING-NULL?, APPEND!, 1+, + ;-1+, <?, <=?, =?, >?, >=? + object-hash ;has OBJECT-HASH + + multiarg/and- ;/ and - can take more than 2 args. + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-FROM-FILE + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + ieee-floating-point ;conforms to IEEE Standard 754-1985 + ;IEEE Standard for Binary + ;Floating-Point Arithmetic. +;; full-continuation ;not without the -call/cc switch + + ;; Other common features + + srfi ;srfi-0, COND-EXPAND finds all srfi-* +; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. + defmacro ;has Common Lisp DEFMACRO +; record ;has user defined data structures + string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING +; sort + pretty-print + object->string +; format ;Common-lisp output formatting +; 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) +; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + + promise + string-case + )) (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 <port>) (define (output-port-width . arg) 79) @@ -149,20 +170,24 @@ (close-input-port insp) res)) +;;; "rationalize" adjunct procedures. +(define (find-ratio x e) + (let ((rat (rationalize x e))) + (list (numerator rat) (denominator rat)))) +(define (find-ratio-between x y) + (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) + ;;; 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 +;;; 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. +;;; SLIB:EVAL is single argument eval using the top-level (user) environment. (define slib:eval eval) (define-macro (defmacro name . forms) @@ -186,7 +211,17 @@ (evl o)) (set! *load-pathname* old-load-pathname))))) +(define slib:warn + (lambda args + (let ((cep (current-error-port))) + (if (provided? 'trace) (print-call-stack cep)) + (display "Warn: " cep) + (for-each (lambda (x) (display x cep)) args)))) + + +;;; define an error procedure for the library (define (slib:error . args) + (if (provided? 'trace) (print-call-stack (current-error-port))) (error 'slib:error "" args)) ;; define these as appropriate for your system. @@ -194,7 +229,7 @@ (define slib:form-feed (integer->char 12)) ;;; records -(defmacro define-record forms +(defmacro define-record forms (let* ((name (car forms)) (maker-name (symbol-append 'make- name))) `(begin @@ -205,9 +240,12 @@ (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 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+) (define in-vicinity string-append) |