From 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:28 -0800
Subject: Import Upstream version 2d2

---
 gambit.init | 33 +++++++++++++++++++++------------
 1 file changed, 21 insertions(+), 12 deletions(-)

(limited to 'gambit.init')

diff --git a/gambit.init b/gambit.init
index 45dd4e2..538fb47 100644
--- a/gambit.init
+++ b/gambit.init
@@ -3,6 +3,9 @@
 ;;;
 ;;; This code is in the public domain.
 
+;;; Ignore case when reading symbols (per R5RS).
+(set-case-conversion! #t)
+
 ;;; Updated 1992 February 1 for Gambit v1.71 -- by Ken Dickey
 ;;; Date: Wed, 12 Jan 1994 15:03:12 -0500
 ;;; From: barnett@armadillo.urich.edu (Lewis Barnett)
@@ -14,8 +17,8 @@
 
 (define (scheme-implementation-type) 'gambit)
 
-;;; (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)
@@ -83,6 +86,7 @@
 	rev4-report			;conforms to
 ;	rev3-report			;conforms to
 	ieee-p1178			;conforms to
+;	srfi				;srfi-0, COND-EXPAND finds all srfi-*
 	sicp				;runs code from Structure and
 					;Interpretation of Computer
 					;Programs by Abelson and Sussman.
@@ -101,7 +105,7 @@
 	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
+	string-port			;has CALL-WITH-INPUT-STRING and
 					;CALL-WITH-OUTPUT-STRING
 	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 	char-ready?
@@ -115,7 +119,6 @@
 ;	object-hash			;has OBJECT-HASH
 
 ;	sort
-;	queue				;queues
 	pretty-print
 ;	object->string
 ;	format
@@ -125,10 +128,6 @@
 	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
     ))
 
@@ -164,6 +163,13 @@
 ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
 ;;; port versions of CALL-WITH-*PUT-FILE.
 
+;;; "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)
@@ -237,12 +243,15 @@
 
 (define slib:warn
   (lambda args
-    (let ((port (current-error-port)))
-      (display "Warn: " port)
-      (for-each (lambda (x) (display x port)) 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 error)
+(define (slib:error . args)
+  (if (provided? 'trace) (print-call-stack (current-error-port)))
+  (apply error args))
 
 ;; define these as appropriate for your system.
 (define slib:tab (integer->char 9))
-- 
cgit v1.2.3