diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:28 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:28 -0800 |
commit | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (patch) | |
tree | 1eb4f87abd38bea56e08335d939e8171d5e7bfc7 /umbscheme.init | |
parent | bd9733926076885e3417b74de76e4c9c7bc56254 (diff) | |
download | slib-ef4190b262cc70a309d5b09b52c8093fb1b0ed40.tar.gz slib-ef4190b262cc70a309d5b09b52c8093fb1b0ed40.zip |
Import Upstream version 2d2upstream/2d2
Diffstat (limited to 'umbscheme.init')
-rw-r--r-- | umbscheme.init | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/umbscheme.init b/umbscheme.init index 4532735..87c1638 100644 --- a/umbscheme.init +++ b/umbscheme.init @@ -17,8 +17,8 @@ (define (scheme-implementation-type) 'umb-scheme) -;;; (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) @@ -74,6 +74,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. @@ -107,7 +108,6 @@ ; object-hash ;has OBJECT-HASH ; sort -; queue ;queues ; pretty-print ; object->string ; format @@ -117,10 +117,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 )) @@ -159,7 +155,7 @@ (zero? (system (string-append "rm " f))))) (else (lambda (f) #f)))) - + ;;; FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. @@ -168,6 +164,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) @@ -209,12 +212,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)) |