Import Upstream version 2d2upstream/2d2

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)