From 5bea21e81ed516440e34e480f2c33ca41aa8c597 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:36 -0800
Subject: Import Upstream version 3a4

---
 bigloo.init | 44 ++++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

(limited to 'bigloo.init')

diff --git a/bigloo.init b/bigloo.init
index eb607bb..dfe8e2f 100644
--- a/bigloo.init
+++ b/bigloo.init
@@ -129,9 +129,9 @@
 	(exchange old)
 	val))))
 
-;;@ *FEATURES* is a list of symbols naming the (SLIB) features
+;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features
 ;;; initially supported by this implementation.
-(define *features*
+(define slib:features
       '(
 	source				;can load scheme source files
 					;(SLIB:LOAD-SOURCE "filename")
@@ -157,7 +157,7 @@
       ;; These four features are optional in both R4RS and R5RS
 
 	multiarg/and-			;/ and - can take more than 2 args.
-	rationalize
+;;;	rationalize
 	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 	with-file			;has WITH-INPUT-FROM-FILE and
 					;WITH-OUTPUT-TO-FILE
@@ -173,7 +173,7 @@
 					;SUBSTRING-FILL!,
 					;STRING-NULL?, APPEND!, 1+,
 					;-1+, <?, <=?, =?, >?, >=?
-	object-hash			;has OBJECT-HASH
+;;;	object-hash			;has OBJECT-HASH
 
 ;;	full-continuation		;not without the -call/cc switch
 	ieee-floating-point		;conforms to IEEE Standard 754-1985
@@ -192,7 +192,7 @@
 					;CALL-WITH-OUTPUT-STRING
 ;;;	sort
 	pretty-print
-	object->string
+;;;	object->string
 ;;;	format				;Common-lisp output formatting
 ;;;	trace				;has macros: TRACE and UNTRACE
 ;;;	compiler			;has (COMPILER)
@@ -205,12 +205,15 @@
 		  ;; Implementation Specific features
 
 	promise
-	string-case
+;;;	string-case			; missing StudlyCapsExpand
+					; symbol-append doesn't handle
+					; non-symbols.
 	))
 
 (define pretty-print pp)
 
-(define (object->string x) (obj->string x))
+;;; OBJ->STRING returns strings with control characters.
+;;(define (object->string x) (obj->string x))
 
 ;;@ (OUTPUT-PORT-WIDTH <port>)
 (define (output-port-width . arg) 79)
@@ -243,12 +246,12 @@
     (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)))
+;;;; "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.
@@ -291,12 +294,14 @@
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
+      (for-each (lambda (x) (display #\space cep) (write 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 slib:error
+  (let ((error error))
+    (lambda args
+      (if (provided? 'trace) (print-call-stack (current-error-port)))
+      (error 'slib:error "" args))))
 ;@
 (define (make-exchanger obj)
   (lambda (rep) (let ((old obj)) (set! obj rep) old)))
@@ -370,9 +375,8 @@
 
 ;;@ At this point SLIB:LOAD must be able to load SLIB files.
 (define (slib:load file)
-  (define file.scm (string-append file (scheme-file-suffix)))
-  (if (file-exists? file.scm)
-      (slib:load-source file.scm)
+  (if (file-exists? (string-append file (scheme-file-suffix)))
+      (slib:load-source file)
       (slib:load-compiled file)))
 ;@
 (define defmacro:load slib:load-source)
-- 
cgit v1.2.3