diff options
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) |