diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:36 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:36 -0800 |
commit | 5bea21e81ed516440e34e480f2c33ca41aa8c597 (patch) | |
tree | 653ace1b8fe0a9916d861d35ff8f611b46c80d37 /bigloo.init | |
parent | 237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (diff) | |
download | slib-5bea21e81ed516440e34e480f2c33ca41aa8c597.tar.gz slib-5bea21e81ed516440e34e480f2c33ca41aa8c597.zip |
Import Upstream version 3a4upstream/3a4
Diffstat (limited to 'bigloo.init')
-rw-r--r-- | bigloo.init | 44 |
1 files changed, 24 insertions, 20 deletions
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) |