diff options
author | Thomas Bushnell, BSG <tb@debian.org> | 2007-12-28 16:25:32 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:39 -0800 |
commit | d8ae23691ed6392b7f320f5fa7d4dd78ae52c10e (patch) | |
tree | b20b8bc02e854c4c86d39ee22a0638a8b06e01af /jscheme.init | |
parent | edd1ebef3ad774e7cbcc2f5918d555bfb0b44091 (diff) | |
parent | 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 (diff) | |
download | slib-d8ae23691ed6392b7f320f5fa7d4dd78ae52c10e.tar.gz slib-d8ae23691ed6392b7f320f5fa7d4dd78ae52c10e.zip |
Import Debian changes 3a5-1debian/3a5-1
slib (3a5-1) unstable; urgency=low
* New upstream release.
* slib.texi (Library Catalogs): Repeat change from 3a3-3.
* Makefile: Repeat $(htmldir)slib_toc.html changes from 3a2-1.
* guile.init: (library-vicinity): Repeat change from 3a4-2.
* debian/rules (binary-indep): Don't hide .init files in a separate
subdirectory, thus conforming better to the usual slib practice. Put a
symlink in place to ease transitions. (Closes: #407370).
Diffstat (limited to 'jscheme.init')
-rw-r--r-- | jscheme.init | 56 |
1 files changed, 52 insertions, 4 deletions
diff --git a/jscheme.init b/jscheme.init index 241a2d8..9e568b7 100644 --- a/jscheme.init +++ b/jscheme.init @@ -37,7 +37,7 @@ ;;@ (scheme-implementation-version) should return a string describing ;;; the version the scheme implementation loading this file. -(define (scheme-implementation-version) "6.2") +(define (scheme-implementation-version) "7.2") ;;@ (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxillary files to your Scheme @@ -235,6 +235,9 @@ )) +;;@ (FILE-POSITION <port> . <k>) +(define (file-position . args) #f) + ;;@ (OUTPUT-PORT-WIDTH <port>) (define (output-port-width . arg) 79) @@ -262,9 +265,9 @@ ;;@ FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. -(define (force-output . arg) - (.flush (if (pair? arg) (car args) - (current-output-port)))) +(define (force-output . args) + (.flush (if (pair? args) (car args) + (current-output-port)))) ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string ;;; port versions of CALL-WITH-*PUT-FILE. @@ -289,6 +292,51 @@ ;;@ SLIB:EVAL is single argument eval using the top-level (user) environment. (define slib:eval eval) +;;;; Fix numeric functions (per R5RS) + +(define gcd + (let ((gcd gcd)) + (lambda args (if (null? args) 0 (apply gcd args))))) + +(define lcm + (let ((lcm lcm)) + (lambda args (if (null? args) 1 (apply lcm args))))) + +(define round + (let ((round round)) + (lambda (x) (if (inexact? x) + (exact->inexact (round x)) + (round x))))) + +(define atan + (let ((atan atan)) + (lambda (z . y) + (if (null? y) + (atan z) + (atan (/ z (car y))))))) + +(define (integer-expt n k) + (if (= 1 (abs n)) + (if (even? k) (* n n) n) + (do ((x n (* x x)) + (j k (quotient j 2)) + (acc 1 (if (even? j) acc (* x acc)))) + ((<= j 1) + (case j + ((0) acc) + ((1) (* x acc)) + (else (slib:error 'integer-expt n k))))))) + +(define expt + (let ((expt expt)) + (lambda (z1 z2) + (cond ((and (exact? z2) + (exact? z1) + (not (and (zero? z1) (negative? z2)))) + (integer-expt z1 z2)) + ((zero? z2) (+ 1 (* z1 z2))) + (else (expt z1 z2)))))) + ;; If your implementation provides R4RS macros: ;(define macro:eval slib:eval) ;(define macro:load load) |