… | |
… | |
32 | ; but exact->inexact is not. |
32 | ; but exact->inexact is not. |
33 | (define exact? integer?) |
33 | (define exact? integer?) |
34 | (define exact-integer? integer?) |
34 | (define exact-integer? integer?) |
35 | (define (inexact? x) (and (real? x) (not (integer? x)))) |
35 | (define (inexact? x) (and (real? x) (not (integer? x)))) |
36 | (define (exact->inexact n) (* n 1.0)) |
36 | (define (exact->inexact n) (* n 1.0)) |
37 | (define exact inexact->exact) |
|
|
38 | (define inexact exact->inexact) |
|
|
39 | (define (even? n) (= (remainder n 2) 0)) |
37 | (define (even? n) (= (remainder n 2) 0)) |
40 | (define (odd? n) (not (= (remainder n 2) 0))) |
38 | (define (odd? n) (not (= (remainder n 2) 0))) |
41 | (define (zero? n) (= n 0)) |
39 | (define (zero? n) (= n 0)) |
42 | (define (positive? n) (> n 0)) |
40 | (define (positive? n) (> n 0)) |
43 | (define (negative? n) (< n 0)) |
41 | (define (negative? n) (< n 0)) |
… | |
… | |
747 | ((not) (if (not (null? (cddr condition))) |
745 | ((not) (if (not (null? (cddr condition))) |
748 | (error "cond-expand : 'not' takes 1 argument") |
746 | (error "cond-expand : 'not' takes 1 argument") |
749 | (not (cond-eval (cadr condition))))) |
747 | (not (cond-eval (cadr condition))))) |
750 | (else (error "cond-expand : unknown operator" (car condition))))))) |
748 | (else (error "cond-expand : unknown operator" (car condition))))))) |
751 | |
749 | |
752 | ; compatibility functions added by schmorp@schmorp.de |
750 | ; done late so that "when" is functional |
|
|
751 | (define exact ) (when (defined? 'inexact->exact) (set! exact inexact->exact)) |
|
|
752 | (define inexact) (when (defined? 'exact->inexact) (set! inexact exact->inexact)) |
|
|
753 | |
753 | (macro (defmacro dform) |
754 | (macro (defmacro dform) |
754 | (let ((name (cadr dform)) (formals (caddr dform)) (body (cdddr dform))) |
755 | (let ((name (cadr dform)) (formals (caddr dform)) (body (cdddr dform))) |
755 | `(define-macro (,name . ,formals) ,@body))) |
756 | `(define-macro (,name . ,formals) ,@body))) |
756 | |
757 | |
757 | ;; r7rs |
758 | ;; r7rs |